Commit 5efb5056 authored by Dave Cooper's avatar Dave Cooper
Browse files

reverted cookie urls for now

parent cce1fd0b
;;;; -*- coding: utf-8 -*-
(asdf:defsystem
#:ta2
:description
"The Gendl™ (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140625"
:depends-on
(:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package")
(:file "source/parameters")
(:file "source/javascript")
(:file "source/action-object")
(:file "source/ajax")
(:file "source/assembly")
(:file "source/click-mode")
(:file "source/inspector")
(:file "source/object-tree")
(:file "source/part-type-form")
(:file "source/publish")
(:file "source/viewport")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:ta2 :description
"The Gendl\" (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140904" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
(:file "source/javascript") (:file "source/action-object")
(:file "source/ajax") (:file "source/assembly")
(:file "source/click-mode") (:file "source/inspector")
(:file "source/object-tree") (:file "source/part-type-form")
(:file "source/publish") (:file "source/viewport")))
This diff is collapsed.
;;;; -*- coding: utf-8 -*-
(asdf:defsystem
#:tasty
:description
"The Gendl™ Web-based Development Environment (tasty)"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140625"
:depends-on
(:tree :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package")
(:file "source/parameters")
(:file "source/assembly")
(:file "source/initialize")
(:file "source/inspector")
(:file "source/menu")
(:file "source/new-inspector")
(:file "source/newer-inspector")
(:file "source/part-type-form")
(:file "source/publish")
(:file "source/status-object")
(:file "source/test-part")
(:file "source/test-part2")
(:file "source/two-viewports")
(:file "source/viewport")
(:file "source/zzinit")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:tasty :description
"The Gendl\" Web-based Development Environment (tasty)" :author
"John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140904" :depends-on (:tree :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
(:file "source/assembly") (:file "source/initialize")
(:file "source/inspector") (:file "source/menu")
(:file "source/new-inspector") (:file "source/newer-inspector")
(:file "source/part-type-form") (:file "source/publish")
(:file "source/status-object") (:file "source/test-part")
(:file "source/test-part2") (:file "source/two-viewports")
(:file "source/viewport") (:file "source/zzinit")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem
#:translators
:description
"The Gendl™ Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140625"
:depends-on
(:gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "xml/source/package")
(:file "xml/source/genworks")
(:file "xml/source/definition-tree")
(:file "xml/source/gdl2xml")
(:file "xml/source/xml2gdl")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:translators :description
"The Gendl\" Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140904" :depends-on (:gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "xml/source/package") (:file "xml/source/genworks")
(:file "xml/source/definition-tree") (:file "xml/source/gdl2xml")
(:file "xml/source/xml2gdl")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem
#:tree
:description
"The Gendl™ Tree component used by Tasty and potentially as a UI component on its own"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140625"
:depends-on
(:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package")
(:file "source/parameters")
(:file "source/ajax")
(:file "source/assembly")
(:file "source/newertree")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:tree :description
"The Gendl\" Tree component used by Tasty and potentially as a UI component on its own"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140904" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
(:file "source/ajax") (:file "source/assembly")
(:file "source/newertree")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem
#:yadd
:description
"The Gendl™ Yet Another Definition Documenter (yadd)"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140625"
:depends-on
(:gwl-graphics #-allegro :cl-html-parse)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package")
(:file "source/genworks")
(:file "source/parameters")
(:file "source/mixins")
(:file "source/define-object-documentation")
(:file "source/assembly")
(:file "source/ass")
(:file "source/format-documentation")
(:file "source/function-documentation")
(:file "source/initialize")
(:file "source/publish")
(:file "source/test-part")
(:file "source/variable-documentation")
(:file "source/zzinit")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:yadd :description
"The Gendl\" Yet Another Definition Documenter (yadd)" :author
"John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140904" :depends-on
(:gwl-graphics #-allegro :cl-html-parse)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/genworks")
(:file "source/parameters") (:file "source/mixins")
(:file "source/define-object-documentation")
(:file "source/assembly") (:file "source/ass")
(:file "source/format-documentation")
(:file "source/function-documentation") (:file "source/initialize")
(:file "source/publish") (:file "source/test-part")
(:file "source/variable-documentation") (:file "source/zzinit")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem
#:base
:description
"The Gendl™ Base Core Kernel Engine"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20140625"
:depends-on
nil
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package")
(:file "source/genworks")
(:file "source/presets")
(:file "source/parameters")
(:file "source/metaclasses")
(:file "source/utilities")
(:file "source/start")
(:file "expanders/source/inputs")
(:file "expanders/source/computed-slots")
(:file "expanders/source/functions")
(:file "expanders/source/methods")
(:file "expanders/source/objects")
(:file "macros/source/reference")
(:file "macros/source/message-utils")
(:file "macros/source/define-object")
(:file "macros/source/defaulting")
(:file "macros/source/define-format")
(:file "rest/source/parameters")
(:file "rest/source/quantification")
(:file "rest/source/aggregate")
(:file "rest/source/utilities")
(:file "rest/source/null-part")
(:file "rest/source/vanilla-mixin")
(:file "rest/source/base-rule-object")
(:file "rest/source/bodies")
(:file "rest/source/ignore-errors-with-backtrace")
(:file "rest/source/init")
(:file "rest/source/make-part")
(:file "rest/source/sequence")
(:file "zzinit/source/initialize")
(:file "zzinit/source/zzinit")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:base :description
"The Gendl\" Base Core Kernel Engine" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20140904" :depends-on nil
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/genworks")
(:file "source/presets") (:file "source/parameters")
(:file "source/metaclasses") (:file "source/utilities")
(:file "source/start") (:file "expanders/source/inputs")
(:file "expanders/source/computed-slots")
(:file "expanders/source/functions")
(:file "expanders/source/methods")
(:file "expanders/source/objects")
(:file "macros/source/reference")
(:file "macros/source/message-utils")
(:file "macros/source/define-object")
(:file "macros/source/defaulting")
(:file "macros/source/define-format")
(:file "rest/source/parameters")
(:file "rest/source/quantification")
(:file "rest/source/aggregate") (:file "rest/source/utilities")
(:file "rest/source/null-part") (:file "rest/source/vanilla-mixin")
(:file "rest/source/base-rule-object") (:file "rest/source/bodies")
(:file "rest/source/ignore-errors-with-backtrace")
(:file "rest/source/init") (:file "rest/source/make-part")
(:file "rest/source/sequence") (:file "zzinit/source/initialize")
(:file "zzinit/source/zzinit")))
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl)
(defun not-handled (object message)
(if *error-on-not-handled?*
(not-handled-error object message)
'gdl-rule:%not-handled%))
(defun input-slots-generics (input-slots)
(let ((input-slot-syms (mapcar #'(lambda(input)
(glisp:intern (if (symbolp (first input))
(first input)
(second input)) :gdl-inputs)) input-slots)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
,@(append
(mapcar #'(lambda(input-sym)
`(unless (fboundp ',input-sym)
(defgeneric ,input-sym (,parent-arg ,val-arg ,self-arg)))) input-slot-syms)))))
(defun input-methods (name attr-sym keys expressions special-keys)
(let ((input (gensym)))
(let ((remove-defunct-expressions
(list
`(dolist (,input (set-difference (getf (child-inputs (find-class ',name)) ',attr-sym) ',keys))
(let ((method (find-method (symbol-function (glisp:intern (symbol-name ,input) :gdl-inputs)) nil
(list (find-class ',name)
(glisp:eql-specializer ',attr-sym)
(find-class t)) nil)))
(when method
(remove-method (symbol-function (glisp:intern (symbol-name ,input) :gdl-inputs)) method)
(format t "~%Removing object input ~a for object ~a of object definition ~s~%"
,input ',attr-sym ',name))))
`(setf (getf (child-inputs (find-class ',name)) ',attr-sym) (set-difference ',keys ',special-keys)))))
(append remove-defunct-expressions
(remove
nil
(mapcan
#'(lambda(input expr)
(when (not (member input special-keys))
(let ((input-sym (glisp:intern (symbol-name input) :gdl-acc)))
(list
`(defmethod ,(glisp:intern (symbol-name input-sym) :gdl-inputs)
((self ,name)
(,part-arg (eql ',attr-sym))
(child t))
(let ((*error-on-not-handled?* t)) ,expr))))))
keys expressions))))))
(defun input-slots-section (name input-slots)
(mapcan
#'(lambda(input)
(let* ((attr-sym (glisp:intern (symbol-name (if (symbolp input)
input
(message-symbol input))) :gdl-acc))
(attr-remarks (when (consp input) (message-strings input))))
(remove
nil
(list
(when (and *compile-documentation-database?* attr-remarks)
`(when *load-documentation-database?*
(let ((ht (or (message-documentation (find-class ',name))
(setf (message-documentation (find-class ',name)) (make-hash-table)))))
(setf (gethash (make-keyword ',attr-sym) ht) ,attr-remarks))))
(when (and *compile-for-dgdl?* (not (eql attr-sym 'gdl-acc::type)))
`(unless (find-method (symbol-function ',(glisp:intern attr-sym :gdl-inputs))
nil (list (find-class 'gdl-remote) t (find-class 'gdl-basis)) nil)
(defmethod ,(glisp:intern attr-sym :gdl-inputs) ((,parent-arg gdl-remote)
,part-arg
(,self-arg gdl-basis))
(the-object ,parent-arg (fetch-input ,(make-keyword attr-sym) ,part-arg ,self-arg)))))
`(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-slots) ((self ,name) &rest ,args-arg)
(declare (ignore ,args-arg))
(let ((*error-on-not-handled?* t))
(with-dependency-tracking (,attr-sym self)
(let ((,parent-arg (the-object self %parent%)))
(let ((,val-arg
(if ,parent-arg
(let (*error-on-not-handled?*)
(,(glisp:intern (symbol-name attr-sym) :gdl-inputs)
,parent-arg (the-object self %name%) self))
'gdl-rule:%not-handled%)))
(cond ((not (eql ,val-arg 'gdl-rule:%not-handled%)) ,val-arg)
((and ,parent-arg (fboundp ',(glisp:intern (symbol-name attr-sym) :gdl-trickle-downs)))
(if (member ,(make-keyword attr-sym) (the-object ,parent-arg :%trickle-down-slots%))
(,(glisp:intern (symbol-name attr-sym) :gdl-slots) ,parent-arg)
(funcall (symbol-function ',(glisp:intern (symbol-name attr-sym) :gdl-trickle-downs)) ,parent-arg)))
(t (not-handled self ,(make-keyword attr-sym))))))))))))) input-slots))
(defun optional-input-slots-section (name input-slots &optional (defaulted? nil))
(mapcan
#'(lambda(input)
(let ((attr-remarks (message-strings input))
(attr-sym (glisp:intern (symbol-name (message-symbol input)) :gdl-acc))
(attr-expr (message-source-code input)))
(remove
nil
(list
(when (and *compile-documentation-database?* attr-remarks)
`(when *load-documentation-database?*
;;
;; FLAG -- make the hash table the initform rather than this clumsy "or" conditional.
;;
(let ((ht (or (message-documentation (find-class ',name))
(setf (message-documentation (find-class ',name)) (make-hash-table)))))
(setf (gethash (make-keyword ',attr-sym) ht) ,attr-remarks))))
(when *compile-source-code-database?*
`(when *load-source-code-database?*
;;
;; FLAG -- make the hash table the initform rather than this clumsy "or" conditional.
;;
(let ((ht (or (message-source (find-class ',name))
(setf (message-source (find-class ',name)) (make-hash-table)))))
(setf (gethash (make-keyword ',attr-sym) ht) ',attr-expr))))
`(eval-when (:compile-toplevel :load-toplevel :execute) (glisp:begin-redefinitions-ok))
(when (and *compile-for-dgdl?* (not (string-equal (symbol-name name) "remote-object") ))
`(when (or (not (fboundp ',(glisp:intern attr-sym :gdl-slots)))
(not (find-method (symbol-function ',(glisp:intern attr-sym :gdl-slots))
nil (list (find-class 'gdl-remote)) nil)))
(defmethod ,(glisp:intern attr-sym :gdl-slots) ((self gdl-remote) &rest ,args-arg)
(the (send (:apply (cons ,(make-keyword (symbol-name attr-sym)) ,args-arg)))))))
(when *compile-for-dgdl?*
`(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-inputs) ((,parent-arg gdl-remote)
,part-arg
(,self-arg gdl-basis))
(the-object ,parent-arg (fetch-input ,(make-keyword attr-sym) ,part-arg ,self-arg))))
`(eval-when (:compile-toplevel :load-toplevel :execute) (glisp:end-redefinitions-ok))
`(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-slots) ((self ,name) &rest ,args-arg)
(declare (ignore ,args-arg))
(let ((*error-on-not-handled?* t))
(with-dependency-tracking (,attr-sym)
(let ((,parent-arg (the :%parent%)))
(let ((,val-arg
(if ,parent-arg
(let (*error-on-not-handled?*)
(,(glisp:intern (symbol-name attr-sym) :gdl-inputs)
,parent-arg (the :%name%) self))
'gdl-rule:%not-handled%)))
,(if defaulted?
`(if (eql ,val-arg 'gdl-rule:%not-handled%)
(let ((,val-arg (if ,parent-arg
(let (*error-on-not-handled?*)
(if (fboundp ',(glisp:intern (symbol-name attr-sym) :gdl-trickle-downs))
(,(glisp:intern (symbol-name attr-sym) :gdl-trickle-downs) self)
'gdl-rule:%not-handled%))
,val-arg)))
(if (eql ,val-arg 'gdl-rule:%not-handled%) ,attr-expr ,val-arg))
,val-arg)
`(if (eql ,val-arg 'gdl-rule:%not-handled%) ,attr-expr ,val-arg))))))))))) input-slots))
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl)
(defun not-handled (object message)
(if *error-on-not-handled?*
(not-handled-error object message)
'gdl-rule:%not-handled%))
(defun input-slots-generics (input-slots)
(let ((input-slot-syms (mapcar #'(lambda(input)
(glisp:intern (if (symbolp (first input))
(first input)
(second input)) :gdl-inputs)) input-slots)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
,@(append
(mapcar #'(lambda(input-sym)
`(unless (fboundp ',input-sym)
(defgeneric ,input-sym (,parent-arg ,val-arg ,self-arg)))) input-slot-syms)))))
(defun input-methods (name attr-sym keys expressions special-keys)
(let ((input (gensym)))
(let ((remove-defunct-expressions
(list
`(dolist (,input (set-difference (getf (child-inputs (find-class ',name)) ',attr-sym) ',keys))
(let ((method (find-method (symbol-function (glisp:intern (symbol-name ,input) :gdl-inputs)) nil
(list (find-class ',name)
(glisp:eql-specializer ',attr-sym)
(find-class t)) nil)))
(when method
(remove-method (symbol-function (glisp:intern (symbol-name ,input) :gdl-inputs)) method)
(format t "~%Removing object input ~a for object ~a of object definition ~s~%"
,input ',attr-sym ',name))))
`(setf (getf (child-inputs (find-class ',name)) ',attr-sym) (set-difference ',keys ',special-keys)))))
(append remove-defunct-expressions
(remove
nil
(mapcan
#'(lambda(input expr)
(when (not (member input special-keys))
(let ((input-sym (glisp:intern (symbol-name input) :gdl-acc)))
(list
`(defmethod ,(glisp:intern (symbol-name input-sym) :gdl-inputs)
((self ,name)
(,part-arg (eql ',attr-sym))
(child t))
(let ((*error-on-not-handled?* t)) ,expr))))))
keys expressions))))))
(defun input-slots-section (name input-slots)
(mapcan
#'(lambda(input)
(let* ((attr-sym (glisp:intern (symbol-name (if (symbolp input)
input
(message-symbol input))) :gdl-acc))
(attr-remarks (when (consp input) (message-strings input))))
(remove
nil
(list
(when (and *compile-documentation-database?* attr-remarks)
`(when *load-documentation-database?*
(let ((ht (or (message-documentation (find-class ',name))
(setf (message-documentation (find-class ',name)) (make-hash-table)))))
(setf (gethash (make-keyword ',attr-sym) ht) ,attr-remarks))))
(when (and *compile-for-dgdl?* (not (eql attr-sym 'gdl-acc::type)))
`(unless (find-method (symbol-function ',(glisp:intern attr-sym :gdl-inputs))
nil (list (find-class 'gdl-remote) t (find-class 'gdl-basis)) nil)
(defmethod ,(glisp:intern attr-sym :gdl-inputs) ((,parent-arg gdl-remote)
,part-arg
(,self-arg gdl-basis))
(the-object ,parent-arg (fetch-input ,