[rjain-utils-cvs] CVS formulate/src/clim-ui

[rjain]

Update of /project/rjain-utils/cvsroot/formulate/src/clim-ui
In directory cl-net:/tmp/cvs-serv899/src/clim-ui

Modified Files:
	application.lisp objects.lisp variables.lisp 
Log Message:
add remove from monitor command
simplify and fix other commands


--- /project/rjain-utils/cvsroot/formulate/src/clim-ui/application.lisp	2009/11/19 01:17:18	1.1
+++ /project/rjain-utils/cvsroot/formulate/src/clim-ui/application.lisp	2009/11/24 10:06:47	1.2
@@ -21,10 +21,13 @@
     (map nil (lambda (item) (display-monitored-value item))
          (monitored-values *application-frame*))))
 
-(defmethod display-monitored-value (item)
+(defmethod display-monitored-value :around (item)
   (updating-output (t :unique-id item)
     (call-next-method)))
 
+(defun remove-from-monitor (value *application-frame*)
+  (delete value (monitored-values *application-frame*)))
+
 (defvar *error-formulator* nil)
 
 (defmacro display-formula-value (location)
--- /project/rjain-utils/cvsroot/formulate/src/clim-ui/objects.lisp	2009/11/19 01:17:18	1.1
+++ /project/rjain-utils/cvsroot/formulate/src/clim-ui/objects.lisp	2009/11/24 10:06:47	1.2
@@ -28,13 +28,13 @@
   (vector-push-extend (make-instance class)
                       (monitored-values *application-frame*)))
 
+(define-presentation-type formulated-object ()
+  :inherit-from t)
+
 (defmethod display-monitored-value ((object standard-object))
   (fresh-line)
   (present object 'formulated-object))
 
-(define-presentation-type formulated-object ()
-  :inherit-from t)
-
 (define-presentation-type formulated-slot ()
   ;; 3 element list: (slot-value <object> <slot-name>)
   :inherit-from t)
@@ -71,20 +71,17 @@
   (format t "translating slot to expression")
   (values object 'expression t))
 
+(define-formulate-command (com-remove-object :name "Remove Object From Monitor")
+    ((object 'formulated-object :prompt "Object" :gesture :menu))
+  (remove-from-monitor object *application-frame*))
+
 (define-formulate-command (com-set-slot-value :name "Set Slot Value")
-    ((expression 'formulated-slot :prompt "Slot")
-     (new-value 'form :prompt "New value"))
+    ((expression 'formulated-slot :prompt "Slot" :gesture :select)
+     (new-value 'form :prompt "New value" :default *unsupplied-argument-marker*))
   (destructuring-bind (s-v object (q slot)) expression
     (declare (ignore s-v q))
     (setf (slot-value object slot) (eval new-value))))
 
-(define-presentation-to-command-translator set-slot-value
-    (formulated-slot com-set-slot-value formulate :gesture :select)
-    (object)
-  (list object
-        (accept 'form
-                :prompt (format nil "Set Slot Value (Slot) ~a (New value)" object))))
-
 (define-formulate-command (com-describe-slot :name "Describe Slot")
     ((expression 'formulated-slot :prompt "Slot" :gesture :describe))
   (destructuring-bind (s-v object (q slot)) expression
--- /project/rjain-utils/cvsroot/formulate/src/clim-ui/variables.lisp	2009/11/19 01:17:18	1.1
+++ /project/rjain-utils/cvsroot/formulate/src/clim-ui/variables.lisp	2009/11/24 10:06:47	1.2
@@ -14,27 +14,28 @@
     (let ((*standard-output* (get-frame-pane *application-frame* 'monitor)))
       (vector-push-extend name (monitored-values *application-frame*)))))
 
+(define-presentation-type formulated-variable ()
+  :inherit-from t)
+
 (defmethod display-monitored-value ((name symbol))
   (fresh-line)
-  (with-text-face (t :bold)
-    (present name 'symbol))
-  (write-string " = ")
-  (display-formula-value (eval name)))
+  (with-output-as-presentation (t name 'formulated-variable)
+    (with-text-face (t :bold)
+      (present name 'symbol))
+    (write-string " = ")
+    (display-formula-value (eval name))))
 
-(define-formulate-command (com-set-variable :name "Set Variable")
-    ((name 'symbol) (new-value 'form))
-  (eval `(setf ,name ',value)))
+(define-formulate-command (com-remove-variable :name "Remove Variable From Monitor")
+    ((name 'formulated-variable :prompt "Variable" :gesture :menu))
+  (remove-from-monitor name *application-frame*))
 
-(define-presentation-to-command-translator set-variable
-    (symbol com-set-variable formulate :gesture :select)
-    (name)
-  (list name
-        (let ((stream t))
-          (format stream "  Set Variable (Name) ~a (New value) " name)
-          (accept 'form :prompt nil :stream stream))))
+(define-formulate-command (com-set-variable :name "Set Variable")
+    ((name 'formulated-variable :gesture :select)
+     (new-value 'form))
+  (eval `(setf ,name ',new-value)))
 
 (define-formulate-command (com-describe-variable :name "Describe Variable")
-    ((name 'symbol :prompt "Name" :gesture :describe))
+    ((name 'formulated-variable :prompt "Name" :gesture :describe))
     (let ((formulator (let ((formulate::*get-formulator* t))
                         (eval name))))
       (format t "Variable ~A is computed by ~A~%using formula ~A"