[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp

Robert Strandh rstrandh at common-lisp.net
Sat Jan 29 15:57:28 UTC 2005


Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector
In directory common-lisp.net:/tmp/cvs-serv784

Modified Files:
	inspector.lisp 
Log Message:
Slots are now presentations.  Selecting a slot makes it possible
to alter its value.

Date: Sat Jan 29 07:57:28 2005
Author: rstrandh

Index: mcclim/Apps/Inspector/inspector.lisp
diff -u mcclim/Apps/Inspector/inspector.lisp:1.5 mcclim/Apps/Inspector/inspector.lisp:1.6
--- mcclim/Apps/Inspector/inspector.lisp:1.5	Sat Jan 29 07:27:36 2005
+++ mcclim/Apps/Inspector/inspector.lisp	Sat Jan 29 07:57:28 2005
@@ -110,6 +110,16 @@
   #+openmcl (ccl:method-generic-function method)
   #-(or sbcl openmcl) (error "no MOP"))
 
+(define-presentation-type settable-slot ()
+  :inherit-from t)
+
+(define-presentation-method present (object (type settable-slot) 
+				     stream
+				     (view textual-view)
+				     &key acceptably for-context-type)
+  (declare (ignore acceptably for-context-type))
+  (format stream "~s" (cdr object)))
+
 (defmethod inspect-object ((object standard-object) pane)
   (let ((class (class-of object)))
     (with-output-as-presentation
@@ -127,7 +137,7 @@
 			 (formatting-row (pane)
 			   (formatting-cell (pane :align-x :right)
 			     (with-output-as-presentation
-				 (pane slot (present-type-of slot))
+				 (pane (cons object slot-name) 'settable-slot)
 			       (format pane "~a:" slot-name)))
 			   (formatting-cell (pane)
 			     (inspect-object (slot-value object slot-name) pane))))))))))))
@@ -221,3 +231,8 @@
 (define-inspector-command (com-remove-method :name t)
     ((obj 'method :gesture :delete :prompt "Remove method"))
   (remove-method (method-generic-function obj) obj))
+
+(define-inspector-command (com-set-slot :name t)
+    ((slot 'settable-slot :gesture :select :prompt "Set slot"))
+  (setf (slot-value (car slot) (cdr slot))
+	(accept t :prompt "New slot value")))




More information about the Mcclim-cvs mailing list