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"