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

tentative implementation of detached-tasty

parent 95fd97be
Loading
Loading
Loading
Loading
+76 −29
Original line number Diff line number Diff line
@@ -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")))
   

   #+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)))
@@ -168,8 +176,12 @@ o allow input of required input-slots.
    :onclick-function 
    #'(lambda(object)
        (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)
             :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.
   (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,8 +345,19 @@ 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))

    (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))
      
      ))))


+13 −4
Original line number Diff line number Diff line
@@ -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 support@genworks.com"))

   
   #+nil
   (visit-definition-in-emacs
    (definition)
@@ -151,6 +152,7 @@
      #+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)
@@ -306,8 +308,12 @@
                 :onclick (case (the value-type)
                            (:gdl-atom
                             (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))

                                ;;
+1 −2
Original line number Diff line number Diff line
@@ -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!))
   
+1 −1
Original line number Diff line number Diff line
@@ -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)
+7 −1
Original line number Diff line number Diff line
@@ -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|)))