Commit cc3a7433 authored by Dave Cooper's avatar Dave Cooper
Browse files

Merge branch 'release/1587p008'

parents 968487e6 7d7ffae2
##Gendl® ##Gendl®
Pre-built Distributions available here:
http://gendl.com
Gendl® is a Generative Programming and Knowledge Based Engineering Gendl® is a Generative Programming and Knowledge Based Engineering
framework, implementing concepts which date back to the 1980s and framework, implementing concepts which date back to the 1980s and
which cutting-edge companies have been quietly using to gain which cutting-edge companies have been quietly using to gain
......
...@@ -45,7 +45,7 @@ ...@@ -45,7 +45,7 @@
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(object (the root-object (follow-root-path (object (the root-object (follow-root-path
(read-safe-string (read-safe-string
(base64-decode-safe (getf plist :rootPath))))))) (base64-decode-safe (getf plist :|rootPath|)))))))
(the (perform-action! object)) (the (perform-action! object))
...@@ -63,7 +63,7 @@ ...@@ -63,7 +63,7 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query))) (plist (gwl::assoc-list-to-plist query)))
(let ((root-path (getf plist :rootPath))) (let ((root-path (getf plist :|rootPath|)))
(setq root-path (base64-decode-safe root-path)) (setq root-path (base64-decode-safe root-path))
(when *debug?* (print-variables self root-path)) (when *debug?* (print-variables self root-path))
...@@ -85,8 +85,8 @@ ...@@ -85,8 +85,8 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(message (make-keyword (base64-decode-safe (getf plist :message))))) (message (make-keyword (base64-decode-safe (getf plist :|message|)))))
(print-variables plist message)
(with-http-response (req ent :content-type "text/xml") (with-http-response (req ent :content-type "text/xml")
(with-http-body (req ent) (with-http-body (req ent)
(with-html-output(*html-stream* nil ) (with-html-output(*html-stream* nil )
...@@ -106,9 +106,10 @@ ...@@ -106,9 +106,10 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(slot (make-keyword (getf plist :control))) (slot (make-keyword (getf plist :|control|)))
(value (getf plist :value))) (value (getf plist :|value|)))
(if (eql (read-safe-string value) 'gdl::restore-default) (if (eql (read-safe-string value) 'gdl::restore-default)
(the click-mode (restore-slot-default! slot)) (the click-mode (restore-slot-default! slot))
(the click-mode (set-slot-if-needed! slot value))) (the click-mode (set-slot-if-needed! slot value)))
...@@ -126,13 +127,13 @@ ...@@ -126,13 +127,13 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(root-path (base64-decode-list (getf plist :rootPath))) (root-path (base64-decode-list (getf plist :|rootPath|)))
(object (the root-object (follow-root-path root-path))) (object (the root-object (follow-root-path root-path)))
(plist (remove-plist-key (remove-plist-key plist :iid) :rootPath))) (plist (remove-plist-key (remove-plist-key plist :|iid|) :|rootPath|)))
(let ((keys (read-safe-string (getf plist :keys))) (let ((keys (read-safe-string (getf plist :|keys|)))
(values (base64-decode-list (getf plist :values)))) (values (base64-decode-list (getf plist :|values|))))
(mapc #'(lambda(key value) (mapc #'(lambda(key value)
(the-object object (set-slot-if-needed! key value :infer-types? nil))) keys values)) (the-object object (set-slot-if-needed! key value :infer-types? nil))) keys values))
...@@ -156,10 +157,10 @@ ...@@ -156,10 +157,10 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(root-path (read-safe-string (getf plist :rootPath))) (root-path (read-safe-string (getf plist :|rootPath|)))
(object (the (follow-root-path root-path))) (object (the (follow-root-path root-path)))
(slot (read-safe-string (getf plist :control))) (slot (read-safe-string (getf plist :|control|)))
(value (getf plist :value))) (value (getf plist :|value|)))
(if (eql (read-safe-string value) 'gdl::restore-default) (if (eql (read-safe-string value) 'gdl::restore-default)
...@@ -185,7 +186,7 @@ ...@@ -185,7 +186,7 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(mode (make-keyword (getf plist :mode)))) (mode (make-keyword (getf plist :|mode|))))
(the tree (set-slot! :expand-mode mode)) (the tree (set-slot! :expand-mode mode))
...@@ -203,7 +204,7 @@ ...@@ -203,7 +204,7 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(mode (getf plist :mode))) (mode (getf plist :|mode|)))
(setq self (the click-mode)) (setq self (the click-mode))
...@@ -275,14 +276,15 @@ ...@@ -275,14 +276,15 @@
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*))) (self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
(self (reset-self self)) (self (reset-self self))
(plist (gwl::assoc-list-to-plist query)) (plist (gwl::assoc-list-to-plist query))
(self (the (follow-root-path (read-safe-string (getf plist :rootPath)))))) (self (the (follow-root-path (read-safe-string (getf plist :|rootPath|))))))
;; ;;
;; FLAG -- this is internal stuff, should be handled by a simple function on the self object. ;; FLAG -- this is internal stuff, should be handled by a simple function on the self object.
;; ;;
(let ((local-point (make-point (- (parse-integer (getf plist :x)) (half (the view-object width))) (let ((local-point (make-point (- (parse-integer (getf plist :|x|))
(let ((y (- (the view-object length) (parse-integer (getf plist :y))))) (half (the view-object width)))
(let ((y (- (the view-object length) (parse-integer (getf plist :|y|)))))
(- y (half (the view-object length))))))) (- y (half (the view-object length)))))))
(let ((digitized-point (let ((digitized-point
(add-vectors (the view-object user-center) (add-vectors (the view-object user-center)
......
...@@ -177,17 +177,17 @@ ...@@ -177,17 +177,17 @@
((:img :border nil :src (format nil "/images/gwl/~a" image-file)))))))) ((:img :border nil :src (format nil "/images/gwl/~a" image-file))))))))
(:td (:td
((:table :border 0 :cellpadding 0 :cellspacing 0) ((:table :border 0 :cellpadding 0 :cellspacing 0)
(mapc #'(lambda(selector image) (:tr
(html (mapc #'(lambda(selector image)
(:tr (html
(:td (:td
((:span :style "cursor: pointer;" ((:span :style "cursor: pointer;"
:title "Set Line Thickness" :title "Set Line Thickness"
:onclick (format nil "return ta2setcontrol('~a', '~s', '~a');" :onclick (format nil "return ta2setcontrol('~a', '~s', '~a');"
(the instance-id) :line-thickness (the-object selector line-thickness))) (the instance-id) :line-thickness (the-object selector line-thickness)))
((:img :border 0 :src (format nil "/images/gwl/~a" image)))))))) ((:img :border 0 :src (format nil "/images/gwl/~a" image)))))))
(list-elements (the line-thickness-selectors)) (list-elements (the line-thickness-selectors))
(list "line-1.gif" "line-1.gif" "line-2.gif" "line-3.gif" "line-4.gif")))) (list "line-1.gif" "line-1.gif" "line-2.gif" "line-3.gif" "line-4.gif")))))
(:td (:td
......
...@@ -23,7 +23,6 @@ ...@@ -23,7 +23,6 @@
(gwl:define-package :ta2 (gwl:define-package :ta2
(:documentation #.(glisp:system-description :ta2))
(:export #:assembly)) (:export #:assembly))
#+nil #+nil
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
"The Gendl\" (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)" "The Gendl\" (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author "John McCarthy" :license :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t "Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140615" :depends-on (:gwl-graphics) :version "20140916" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8 #+asdf-encodings :encoding #+asdf-encodings :utf-8
:components :components
......
1. Why do some slots and the tree get unevaluated when doing a refresh and/or update?
2. Make inspector values which are GDL objects be selectable.
3. Make slot values which are sequences be selectable, and replace
with scrolling area with elements from sequence.
4. Make each area easily resizeable.
5. Make the areas reconfigurable/rearrangeable.
6. In general: add professional design look to ta2.
7. Trap errors in geometry display-list.
8. Wrap names in inspector column (shrink its width somehow).
9. Handle updates after an object is removed from the tree.
to replicate:
1. add a new child to the tree
2. update and draw the leaves
3. remove the object in the code
4. update the ta2/tatu browser
10. More robust error message for non-expanding nodes in tree, which
work in IE.
11. Add the measure-distance capability in a friendly way.
...@@ -75,6 +75,8 @@ o allow input of required input-slots. ...@@ -75,6 +75,8 @@ o allow input of required input-slots.
:computed-slots :computed-slots
( (
(use-cookie? nil)
(fixed-url-prefix nil)
(ui-specific-layout-js (when (the use-jquery?) "/static/gwl/js/tasty-initlayout-3.js")) (ui-specific-layout-js (when (the use-jquery?) "/static/gwl/js/tasty-initlayout-3.js"))
......
This diff is collapsed.
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
"The Gendl\" Web-based Development Environment (tasty)" :author "The Gendl\" Web-based Development Environment (tasty)" :author
"John McCarthy" :license "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t "Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140615" :depends-on (:tree :gwl-graphics) :version "20140916" :depends-on (:tree :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8 #+asdf-encodings :encoding #+asdf-encodings :utf-8
:components :components
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
"The Gendl\" Translators to/from XML and potentially other high-level KBE and Knowledge formats" "The Gendl\" Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author "John McCarthy" :license :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t "Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140615" :depends-on (:gwl) :version "20140916" :depends-on (:gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8 #+asdf-encodings :encoding #+asdf-encodings :utf-8
:components :components
......
...@@ -76,8 +76,13 @@ ...@@ -76,8 +76,13 @@
(or (ignore-errors (the target-object line-thickness)) 1))) (or (ignore-errors (the target-object line-thickness)) 1)))
#+nil
(local-display-controls (gethash (the target-object) (the display-controls-hash))) (local-display-controls (gethash (the target-object) (the display-controls-hash)))
(local-display-controls
(or (gethash (the target-object) (the display-controls-hash))
(when (typep (the parent) 'newertree) (the parent local-display-controls))))
(kids-error (when (typep (the safe-children) 'error) (the safe-children))) (kids-error (when (typep (the safe-children) 'error) (the safe-children)))
(safe-children (append (if *trap-errors?* (safe-children (append (if *trap-errors?*
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
"The Gendl\" Tree component used by Tasty and potentially as a UI component on its own" "The Gendl\" Tree component used by Tasty and potentially as a UI component on its own"
:author "John McCarthy" :license :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t "Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140615" :depends-on (:gwl-graphics) :version "20140916" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8 #+asdf-encodings :encoding #+asdf-encodings :utf-8
:components :components
......
...@@ -797,7 +797,9 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied.")) ...@@ -797,7 +797,9 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied."))
(pretty-definition (pretty-definition
() ()
(let ((*package* (find-package (the part-package)))) (let ((*package* (find-package (the part-package)))
;;(*print-case* :downcase)
)
(html-stream *stream* (html-stream *stream*
(:pre (:pre
((:div :class "gdl-object-def") ((:div :class "gdl-object-def")
...@@ -841,7 +843,8 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied.")) ...@@ -841,7 +843,8 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied."))
(:princ (if (and (the first?) (the parent first?)) (:princ (if (and (the first?) (the parent first?))
"" " ")) "" " "))
(:princ (if (member (the section category) (list :required-input-slots)) "" "(")) (:princ (if (member (the section category) (list :required-input-slots)) "" "("))
((:span :class "gdl-message-name") (:princ (the message-name)))) ((:span :class "gdl-message-name")
(:princ (the message-name))))
(if (the objects?) (if (the objects?)
......
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
"The Gendl\" Yet Another Definition Documenter (yadd)" :author "The Gendl\" Yet Another Definition Documenter (yadd)" :author
"John McCarthy" :license "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t "Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20140615" :depends-on :version "20140916" :depends-on
(:gwl-graphics #-allegro :cl-html-parse) (:gwl-graphics #-allegro :cl-html-parse)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8 #+asdf-encodings :encoding #+asdf-encodings :utf-8
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
(asdf:defsystem #:base :description (asdf:defsystem #:base :description
"The Gendl\" Base Core Kernel Engine" :author "John McCarthy" "The Gendl\" Base Core Kernel Engine" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)" :license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20140615" :depends-on nil :serial t :version "20140916" :depends-on nil
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8 #+asdf-encodings :encoding #+asdf-encodings :utf-8
:components :components
......
;; ;;
;; Copyright 2002-2011 Genworks International ;; Copyright 2002-2011 Genworks International
;; ;;
;; This source file is part of the General-purpose Declarative ;; This source file is part of the General-purpose Declarative
;; Language project (GDL). ;; Language project (GDL).
;; ;;
;; This source file contains free software: you can redistribute it ;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public ;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either ;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version. ;; 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, ;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details. ;; Affero General Public License for more details.
;; ;;
;; You should have received a copy of the GNU Affero General Public ;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see ;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>. ;; <http://www.gnu.org/licenses/>.
;; ;;
(in-package :gdl) (in-package :gdl)
(defun not-handled (object message) (defun not-handled (object message)
(if *error-on-not-handled?* (if *error-on-not-handled?*
(not-handled-error object message) (not-handled-error object message)
'gdl-rule:%not-handled%)) 'gdl-rule:%not-handled%))
(defun input-slots-generics (input-slots) (defun input-slots-generics (input-slots)
(let ((input-slot-syms (mapcar #'(lambda(input) (let ((input-slot-syms (mapcar #'(lambda(input)
(glisp:intern (if (symbolp (first input)) (glisp:intern (if (symbolp (first input))
(first input) (first input)
(second input)) :gdl-inputs)) input-slots))) (second input)) :gdl-inputs)) input-slots)))
`(eval-when (:compile-toplevel :load-toplevel :execute) `(eval-when (:compile-toplevel :load-toplevel :execute)
,@(append ,@(append
(mapcar #'(lambda(input-sym) (mapcar #'(lambda(input-sym)
`(unless (fboundp ',input-sym) `(unless (fboundp ',input-sym)
(defgeneric ,input-sym (,parent-arg ,val-arg ,self-arg)))) input-slot-syms))))) (defgeneric ,input-sym (,parent-arg ,val-arg ,self-arg)))) input-slot-syms)))))
(defun input-methods (name attr-sym keys expressions special-keys) (defun input-methods (name attr-sym keys expressions special-keys)
(let ((input (gensym))) (let ((input (gensym)))
(let ((remove-defunct-expressions (let ((remove-defunct-expressions
(list (list
`(dolist (,input (set-difference (getf (child-inputs (find-class ',name)) ',attr-sym) ',keys)) `(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 (let ((method (find-method (symbol-function (glisp:intern (symbol-name ,input) :gdl-inputs)) nil
(list (find-class ',name) (list (find-class ',name)
(glisp:eql-specializer ',attr-sym) (glisp:eql-specializer ',attr-sym)
(find-class t)) nil))) (find-class t)) nil)))
(when method (when method
(remove-method (symbol-function (glisp:intern (symbol-name ,input) :gdl-inputs)) 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~%" (format t "~%Removing object input ~a for object ~a of object definition ~s~%"
,input ',attr-sym ',name)))) ,input ',attr-sym ',name))))
`(setf (getf (child-inputs (find-class ',name)) ',attr-sym) (set-difference ',keys ',special-keys))))) `(setf (getf (child-inputs (find-class ',name)) ',attr-sym) (set-difference ',keys ',special-keys)))))
(append remove-defunct-expressions (append remove-defunct-expressions
(remove (remove
nil nil
(mapcan (mapcan
#'(lambda(input expr) #'(lambda(input expr)
(when (not (member input special-keys)) (when (not (member input special-keys))
(let ((input-sym (glisp:intern (symbol-name input) :gdl-acc))) (let ((input-sym (glisp:intern (symbol-name input) :gdl-acc)))
(list (list
`(defmethod ,(glisp:intern (symbol-name input-sym) :gdl-inputs) `(defmethod ,(glisp:intern (symbol-name input-sym) :gdl-inputs)
((self ,name) ((self ,name)
(,part-arg (eql ',attr-sym)) (,part-arg (eql ',attr-sym))
(child t)) (child t))
(let ((*error-on-not-handled?* t)) ,expr)))))) (let ((*error-on-not-handled?* t)) ,expr))))))
keys expressions)))))) keys expressions))))))
(defun input-slots-section (name input-slots) (defun input-slots-section (name input-slots)
(mapcan (mapcan
#'(lambda(input) #'(lambda(input)
(let* ((attr-sym (glisp:intern (symbol-name (if (symbolp input) (let* ((attr-sym (glisp:intern (symbol-name (if (symbolp input)
input input
(message-symbol input))) :gdl-acc)) (message-symbol input))) :gdl-acc))
(attr-remarks (when (consp input) (message-strings input)))) (attr-remarks (when (consp input) (message-strings input))))
(remove (remove
nil nil
(list (list
(when (and *compile-documentation-database?* attr-remarks) (when (and *compile-documentation-database?* attr-remarks)
`(when *load-documentation-database?* `(when *load-documentation-database?*
(let ((ht (or (message-documentation (find-class ',name)) (let ((ht (or (message-documentation (find-class ',name))
(setf (message-documentation (find-class ',name)) (make-hash-table))))) (setf (message-documentation (find-class ',name)) (make-hash-table)))))
(setf (gethash (make-keyword ',attr-sym) ht) ,attr-remarks)))) (setf (gethash (make-keyword ',attr-sym) ht) ,attr-remarks))))
(when (and *compile-for-dgdl?* (not (eql attr-sym 'gdl-acc::type))) (when (and *compile-for-dgdl?* (not (eql attr-sym 'gdl-acc::type)))
`(unless (find-method (symbol-function ',(glisp:intern attr-sym :gdl-inputs)) `(unless (find-method (symbol-function ',(glisp:intern attr-sym :gdl-inputs))
nil (list (find-class 'gdl-remote) t (find-class 'gdl-basis)) nil) nil (list (find-class 'gdl-remote) t (find-class 'gdl-basis)) nil)
(defmethod ,(glisp:intern attr-sym :gdl-inputs) ((,parent-arg gdl-remote) (defmethod ,(glisp:intern attr-sym :gdl-inputs) ((,parent-arg gdl-remote)
,part-arg ,part-arg
(,self-arg gdl-basis)) (,self-arg gdl-basis))
(the-object ,parent-arg (fetch-input ,(make-keyword attr-sym) ,part-arg ,self-arg))))) (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) `(defmethod ,(glisp:intern (symbol-name attr-sym) :gdl-slots) ((self ,name) &rest ,args-arg)
(declare (ignore ,args-arg)) (declare (ignore ,args-arg))
(let ((*error-on-not-handled?* t)) (let ((*error-on-not-handled?* t))
(with-dependency-tracking (,attr-sym self)