Commit 01d32a0e authored by Dave Cooper's avatar Dave Cooper
Browse files

tentative implementation of detached-tasty

parent 95fd97be
......@@ -62,6 +62,14 @@ o allow input of required input-slots.
(uri-style-sheet (when (the use-jquery?) (string-append (the uri-static-gwl-styles) "tasty-layout.css")))
(format t "~%~%At 1~%~%")
(the root-object update!)
(mapsend (list (the tree) (the inspector) (the viewport)) :update!)))
(the (set-slot! :root-object (the root-object)))
......@@ -168,8 +176,12 @@ o allow input of required input-slots.
(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))
: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.
(the root-object update!)
(the tree update!)
(the refresh-tasty-panes!)
;;(the root-object update!)
;;(the tree update!)
(mapsend (list (the tree) (the inspector) (the viewport)) :update!))
(the (set-slot! :root-object-type
(let ((*package* (find-package (the package-default))))
(read-safe-string 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))))
(when (typep object 'base-html-sheet)
......@@ -314,8 +345,19 @@ o allow input of required input-slots.
(the (set-slot! :root-object (the root-object-object)))))
(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))
(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)))
......@@ -344,6 +386,11 @@ The error was: ~a
;;(:uh (the viewport (set-sheet-object! object)))
(print-variables (the inspector node-root-path)
(the inspector node))
......@@ -143,6 +143,7 @@
(declare (ignore definition))
(error "Sorry! This is supposed to do 'lisp-find-definition' in emacs, but not working yet... Please send email to"))
......@@ -151,6 +152,7 @@
#+allegro (lep::eval-in-emacs emacs-lisp-command)))
(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)
......@@ -306,8 +308,12 @@
:onclick (case (the value-type)
(the (gdl-ajax-call
:bashee (the tatu-root)
:function-key :perform-action!
:arguments (list value))))
(list nil
:tasty-root (the tatu-root)
:root-object-rootpath (the value root-path)))))
(when (the clickable?)
......@@ -451,6 +457,9 @@
(the node (set-slot-if-needed!
(the-child keyword) value :infer-types? nil))
(the tatu-root refresh-tasty-panes!)
......@@ -212,8 +212,7 @@ Converting to a string to avoid error."
(the child-nodes)))))))))
(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)
......@@ -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))
......@@ -111,10 +114,13 @@
(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|)))
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