Commit ddc1a872 authored by Dave Cooper's avatar Dave Cooper

merged detached-tasty branch

parents f5310f66 ea2a5a01
......@@ -61,7 +61,15 @@ o allow input of required input-slots.
(uri-style-sheet (when (the use-jquery?) (string-append (the uri-static-gwl-styles) "tasty-layout.css")))
#+nil
(tatu-update-function
#'(lambda()
(format t "~%~%At 1~%~%")
(the root-object update!)
(mapsend (list (the tree) (the inspector) (the viewport)) :update!)))
#+nil
(tatu-update-function
#'(lambda()
(the (set-slot! :root-object (the root-object)))
......@@ -167,9 +175,13 @@ o allow input of required input-slots.
;;:show-onmouseover-buttons? nil
:onclick-function
#'(lambda(object)
(the (gdl-ajax-call
(the (gdl-ajax-call
;;:bashee (list :%rp% '(:root-object))
:function-key :perform-action!
:arguments (list object)))))
:arguments (list nil
:tasty-root self
:root-object-rootpath (the-object object root-path))))))
(viewport :type 'viewport
......@@ -180,12 +192,14 @@ o allow input of required input-slots.
:length (getf (the viewport-dimensions)
:length (getf (the viewport-dimensions) :height))
:width (getf (the viewport-dimensions) :width)
:onclick-function #'(lambda(object)
(the (gdl-ajax-call
:function-key :perform-action!
:arguments (list object)
:null-event? (member (the-child image-format) (list :x3d :x3dom))
)))
:onclick-function
#'(lambda(object)
(the (gdl-ajax-call
:function-key :perform-action!
:arguments (list nil
:tasty-root self
:root-object-rootpath (the-object object root-path))
:null-event? (member (the-child image-format) (list :x3d :x3dom)))))
:tatu-root self)
(inspector :type 'inspector
......@@ -270,15 +284,32 @@ o allow input of required input-slots.
(update-root-object!
()
(the root-object update!)
(the tree update!)
(the refresh-tasty-panes!)
;;(the root-object update!)
;;(the tree update!)
)
(refresh-tasty-panes!
()
(mapsend (list (the tree) (the inspector) (the viewport)) :update!))
#+nil
(make-root-instance
(type)
(the (set-slot! :root-object-type
(let ((*package* (find-package (the package-default))))
(read-safe-string type)))))
(make-root-instance
(type)
(let* ((type (let ((*package* (find-package (the package-default))))
(read-safe-string type)))
(object (make-object type :strings-for-display (format nil "~s" type))))
(the (set-root! object))))
(set-root!
(object)
(when (typep object 'base-html-sheet)
......@@ -314,35 +345,51 @@ o allow input of required input-slots.
(the (set-slot! :root-object (the root-object-object)))))
(perform-action!
(object &key kids-error (click-mode (the click-mode value)))
(&optional object &key tasty-root root-object-rootpath
kids-error (click-mode (the click-mode value)))
(when *debug?* (print-variables (the-object object root-path) click-mode))
(ecase click-mode
(:inspect (the inspector (set-object! object)))
(:reset-root (the (reset-root! object)))
(:set-root (the (set-root! object)))
(:update-node (the (update-node! object)))
(:draw-leaves (the viewport (draw-leaves! object)))
(:draw-node (the viewport (draw-node! object)))
(:add-leaves (the viewport (add-leaves! object)))
(:add-leaves* (the viewport (add-leaves*! object)))
(:delete-leaves (the viewport (delete-leaves! object)))
(:add-node (the viewport (add-node! object)))
(let ((object (or object
(the-object tasty-root root-object
(follow-root-path root-object-rootpath)))))
(print-variables object click-mode)
(print-variables (the inspector node-root-path)
(the inspector node))
(ecase click-mode
(:inspect (the inspector (set-object! object)))
(:reset-root (the (reset-root! object)))
(:set-root (the (set-root! object)))
(:update-node (the (update-node! object)))
(:draw-leaves (the viewport (draw-leaves! object)))
(:draw-node (the viewport (draw-node! object)))
(:add-leaves (the viewport (add-leaves! object)))
(:add-leaves* (the viewport (add-leaves*! object)))
(:delete-leaves (the viewport (delete-leaves! object)))
(:add-node (the viewport (add-node! object)))
(:break
(set-self object)
(let ((*package* (symbol-package (the-object object root type))))
(:break
(set-self object)
(let ((*package* (symbol-package (the-object object root type))))
(format t "~&
(format t "~&
~aSelf is now set to to ~s, you may use command-line interaction....~%~%"
(if kids-error
(format nil "~&
(if kids-error
(format nil "~&
NOTE: Children cannot expand -- evaluate (the children) to reproduce the error.
The error was: ~a
"
kids-error) "") object)))
kids-error) "") object)))
;;(:uh (the viewport (set-sheet-object! object)))
;;(:uh (the viewport (set-sheet-object! object)))
)
(print-variables (the inspector node-root-path)
(the inspector node))
))))
......
......@@ -142,6 +142,7 @@
(definition)
(declare (ignore definition))
(error "Sorry! This is supposed to do 'lisp-find-definition' in emacs, but not working yet... Please send email to support@genworks.com"))
#+nil
(visit-definition-in-emacs
......@@ -150,7 +151,8 @@
(print-variables emacs-lisp-command)
#+allegro (lep::eval-in-emacs emacs-lisp-command)))
#+nil
(perform-action!
(object)
(the tatu-root (perform-action! object)))
......@@ -262,7 +264,7 @@
(typecase (the value)
(list (when (consp (the value)) :list))
(gdl::quantification :gdl-sequence)
(gdl::gdl-basis :gdl-atom))))
(gdl::gdl-basis (when (eql (the value root) (the node root)) :gdl-atom)))))
(value-cardinality (case (the value-type)
......@@ -305,9 +307,13 @@
(if (the clickable?) "cursor: pointer;" ""))
:onclick (case (the value-type)
(:gdl-atom
(the (gdl-ajax-call
(the (gdl-ajax-call
:bashee (the tatu-root)
:function-key :perform-action!
:arguments (list value))))
:arguments
(list nil
:tasty-root (the tatu-root)
:root-object-rootpath (the value root-path)))))
(:gdl-3d-point
(when (the clickable?)
......@@ -451,6 +457,9 @@
(progn
(the node (set-slot-if-needed!
(the-child keyword) value :infer-types? nil))
(the tatu-root refresh-tasty-panes!)
t))
;;
......
......@@ -212,8 +212,7 @@ Converting to a string to avoid error."
(the child-nodes)))))))))
:functions
(
(toggle-state! ()
((toggle-state! ()
(the (set-slot! :closed? (not (the closed?))))
(the propogate-toggle!))
......
......@@ -48,7 +48,7 @@ to the src/ directory distributed with GDL.
(torso-type 'box :settable)
(height 10 :settable)
(head-angle 0 :settable)
(body-angle 0 :settable)
(body-angle 20 :settable)
(arm-angle-right 0 :settable)
(arm-angle-left 0 :settable)
(pincer-distance-right (number-round (* .15 3/5 (the width)) 3) :settable)
......
......@@ -381,7 +381,7 @@ needs to be polished a bit more before loading it by default.
You can load Glime at any time with:
(load (merge-pathnames "emacs/glime.lisp" (glisp:*gdl-home*)))
(load (merge-pathnames "emacs/glime.lisp" glisp:*gdl-home*))
[glime needs to be loaded only on the Lisp (Swank) side, not on the
Emacs (Slime) side].
......
......@@ -23,6 +23,8 @@
(defparameter *ajax-snap-restore?* nil)
(defparameter *self* nil)
(defun quick-save (self &key (snap-folder (glisp:snap-folder)))
(when *ajax-snap-restore?*
(let ((snap-file
......@@ -100,6 +102,7 @@
(self (or self (restore-from-snap iid)))
(plist-raw plist)
(plist (decode-from-ajax plist self))
(bashee (getf plist :|bashee|))
(respondent (progn (when *debug?* (print-variables plist))
......@@ -110,11 +113,14 @@
(arguments (getf plist :|arguments|)))
(setq *self* self)
(when *debug?*
(let ((bashee-root (the-object bashee root-path))
(respondent-root (the-object respondent root-path)))
(print-variables raw-fields bashee-root respondent-root fields function)))
(print-variables plist-raw plist raw-fields bashee-root respondent-root fields function)
))
(let ((*clicked-x* (let ((string (getf query-plist :|x|)))
......
("Make the respondent default to the bashee for base-html-sheet, same as for base-ajax-sheet."
"Fix restore-slot-default to blank out version information at the true root
......@@ -42,10 +39,10 @@ default for merged-solid."
add-notify-cons call (which should not normally happen --- internal
error reported with user code explicitly calling (the aggregate)"
"Implement random back-off strategy for gwl:start-gwl, for when
"Implement random back-off strategy for gwl:start-gwl, for when
default port 9000 and subsequent ports are busy."
"Prevent ht (hashtable) information from variable sequences from
"Prevent ht (hashtable) information from variable sequences from
showing up superfluously in snapshot files."
)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment