mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS update: mcclim/Examples/calculator.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv24691 Modified Files: calculator.lisp Log Message: Minor revisions to calculator example - use grid-pane rather than table-pane to equalize button sizes, adjust default text style. Date: Mon Jan 31 19:11:40 2005 Author: ahefner Index: mcclim/Examples/calculator.lisp diff -u mcclim/Examples/calculator.lisp:1.17 mcclim/Examples/calculator.lisp:1.18 --- mcclim/Examples/calculator.lisp:1.17 Fri Mar 21 13:37:00 2003 +++ mcclim/Examples/calculator.lisp Mon Jan 31 19:11:39 2005 @@ -22,7 +22,11 @@ (in-package :clim-demo) +(defparameter *calculator-text-style* + (make-text-style :sans-serif :roman :large)) + (defun calculator () + #+nil (progn (loop for port in climi::*all-ports* do (destroy-port port)) @@ -88,6 +92,7 @@ (make-pane 'push-button-pane :label label :activate-callback operator + :text-style *calculator-text-style* :width width :height height :max-width max-width :min-width min-width :max-height max-height :min-height min-height)) @@ -111,7 +116,7 @@ (eight (make-button "8" (queue-number 8))) (nine (make-button "9" (queue-number 9))) (zero (make-button "0" (queue-number 0))) - (screen :text-field :value "0") + (screen :text-field :value "0" :text-style *calculator-text-style*) (ac (make-button "AC" #'initac)) (ce (make-button "CE" #'initce))) @@ -121,7 +126,7 @@ (vertically (:width 150 :max-width 500) (setf text-field screen) (horizontally (:height 50) ac ce) - (tabling () + (tabling (:grid t) (list one two plus) (list three four dash) (list five six multiply)

1 0

[mcclim-cvs] CVS update: mcclim/panes.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv24645 Modified Files: panes.lisp Log Message: Attempt to remedy bit rot in grid-pane. Date: Mon Jan 31 19:08:28 2005 Author: ahefner Index: mcclim/panes.lisp diff -u mcclim/panes.lisp:1.148 mcclim/panes.lisp:1.149 --- mcclim/panes.lisp:1.148 Fri Jan 21 03:01:37 2005 +++ mcclim/panes.lisp Mon Jan 31 19:08:27 2005 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.148 2005/01/21 11:01:37 ahefner Exp $ +;;; $Id: panes.lisp,v 1.149 2005/02/01 03:08:27 ahefner Exp $ (in-package :clim-internals) @@ -1371,7 +1371,7 @@ (with-slots (array) pane (setf array (make-array (list nrows ncols) :initial-element nil)) - (loop for row in contents + (loop for row in contents for i from 0 do (loop for cell in row for j from 0 do @@ -1542,39 +1542,43 @@ (defmethod compose-space ((grid grid-pane) &key width height) (declare (ignore width height)) (mapc #'compose-space (sheet-children grid)) - (loop with nb-children-pl = (table-pane-number grid) - with nb-children-pc = (/ (length (sheet-children grid)) nb-children-pl) - for child in (sheet-children grid) - and width = 0 then (max width (sr-width child)) - and height = 0 then (max height (sr-height child)) - and max-width = 5000000 then (min max-width (sr-min-width child)) - and max-height = 5000000 then (min max-height (sr-max-height child)) - and min-width = 0 then (max min-width (sr-min-width child)) - and min-height = 0 then (max min-height (sr-min-height child)) - finally (return - (make-space-requirement - :width (* width nb-children-pl) - :height (* height nb-children-pc) - :max-width (* width nb-children-pl) - :max-height (* max-height nb-children-pc) - :min-width (* min-width nb-children-pl) - :min-height (* min-height nb-children-pc))))) + (with-slots (array) grid + (loop with nb-children-pl = (array-dimension array 1) ;(table-pane-number grid) + with nb-children-pc = (array-dimension array 0) ;(/ (length (sheet-children grid)) nb-children-pl) + for child in (sheet-children grid) + and width = 0 then (max width (sr-width child)) + and height = 0 then (max height (sr-height child)) + and max-width = 5000000 then (min max-width (sr-min-width child)) + and max-height = 5000000 then (min max-height (sr-max-height child)) + and min-width = 0 then (max min-width (sr-min-width child)) + and min-height = 0 then (max min-height (sr-min-height child)) + finally (return + (make-space-requirement + :width (* width nb-children-pl) + :height (* height nb-children-pc) + :max-width (* width nb-children-pl) + :max-height (* max-height nb-children-pc) + :min-width (* min-width nb-children-pl) + :min-height (* min-height nb-children-pc)))))) (defmethod allocate-space ((grid grid-pane) width height) - (loop with nb-kids-p-l = (table-pane-number grid) - with nb-kids-p-c = (/ (length (sheet-children grid)) nb-kids-p-l) - for children in (format-children grid) - for c from nb-kids-p-c downto 1 - for tmp-height = height then (decf tmp-height new-height) - for new-height = (/ tmp-height c) - for y = 0 then (+ y new-height) - do (loop for child in children - for l from nb-kids-p-l downto 1 - for tmp-width = width then (decf tmp-width new-width) - for new-width = (/ tmp-width l) - for x = 0 then (+ x new-width) - do (move-sheet child x y) - (allocate-space child (round new-width) (round new-height))))) + (with-slots (array) grid + (loop with nb-kids-p-l = (array-dimension array 1) ;(table-pane-number grid) + with nb-kids-p-c = (array-dimension array 0) ;(/ (length (sheet-children grid)) nb-kids-p-l) + for c from nb-kids-p-c downto 1 + for row-index from 0 by 1 + for tmp-height = height then (decf tmp-height new-height) + for new-height = (/ tmp-height c) + for y = 0 then (+ y new-height) + do (loop + for col-index from 0 by 1 + for l from nb-kids-p-l downto 1 + for child = (aref array row-index col-index) + for tmp-width = width then (decf tmp-width new-width) + for new-width = (/ tmp-width l) + for x = 0 then (+ x new-width) + do (move-sheet child x y) + (allocate-space child (round new-width) (round new-height)))))) ;;; SPACING PANE @@ -2557,7 +2561,7 @@ (eq (frame-state frame) :shrunk)) (enable-frame frame)) ;; Start a new thread to run the event loop, if necessary. - #+CLIM-MP + #+clim-mp (unless input-buffer (clim-sys:make-process (lambda () (let ((*application-frame* frame)) (standalone-event-loop)))))

1 0

[mcclim-cvs] CVS update: mcclim/Examples/stream-test.lisp
by ahefner＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv20492 Modified Files: stream-test.lisp Log Message: Change run-test to not destroy all active ports before running the demo. Date: Mon Jan 31 17:47:36 2005 Author: ahefner Index: mcclim/Examples/stream-test.lisp diff -u mcclim/Examples/stream-test.lisp:1.3 mcclim/Examples/stream-test.lisp:1.4 --- mcclim/Examples/stream-test.lisp:1.3 Sat Jul 26 10:37:57 2003 +++ mcclim/Examples/stream-test.lisp Mon Jan 31 17:47:36 2005 @@ -58,9 +58,9 @@ (default (vertically () tester)))) (defun run-test (name) - (loop for port in climi::*all-ports* - do (destroy-port port)) - (setq climi::*all-ports* nil) +; (loop for port in climi::*all-ports* +; do (destroy-port port)) +; (setq climi::*all-ports* nil) (when name (run-frame-top-level (make-application-frame name))))

1 0

[mcclim-cvs] CVS update: mcclim/system.lisp
by ahefner＠common-lisp.net 31 Jan '05

31 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv23128 Modified Files: system.lisp Log Message: Add method-browser to clim-examples system. Date: Sun Jan 30 22:24:58 2005 Author: ahefner Index: mcclim/system.lisp diff -u mcclim/system.lisp:1.109 mcclim/system.lisp:1.110 --- mcclim/system.lisp:1.109 Tue Jan 18 04:20:15 2005 +++ mcclim/system.lisp Sun Jan 30 22:24:58 2005 @@ -210,6 +210,7 @@ "Examples/stream-test" "Examples/presentation-test" #+clx "Examples/gadget-test" + "Examples/method-browser" "Goatee/goatee-test" "Examples/accepting-values")

1 0

[mcclim-cvs] CVS update: mcclim/Examples/method-browser.lisp
by ahefner＠common-lisp.net 31 Jan '05

31 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv23100 Added Files: method-browser.lisp Log Message: Added method-browser app to examples. Date: Sun Jan 30 22:24:24 2005 Author: ahefner

1 0

[mcclim-cvs] CVS update: mcclim/gadgets.lisp
by ahefner＠common-lisp.net 31 Jan '05

31 Jan '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv22327 Modified Files: gadgets.lisp Log Message: Add standard-sheet-input-mixin to superclasses of generic-list-pane in order to make it work within the popup menu of the option-pane in unithreaded SBCL (and presumably other non-MP lisps). This feels like a hack. Date: Sun Jan 30 22:09:55 2005 Author: ahefner Index: mcclim/gadgets.lisp diff -u mcclim/gadgets.lisp:1.86 mcclim/gadgets.lisp:1.87 --- mcclim/gadgets.lisp:1.86 Sat Jan 1 21:25:38 2005 +++ mcclim/gadgets.lisp Sun Jan 30 22:09:55 2005 @@ -100,8 +100,6 @@ ;; - the slider needs a total overhaul -;; - OPTION-PANE needs an implmentation - ;; - TEXT-FILED, TEXT-AREA dito ;; - GADGET-COLOR-MIXIN is currently kind of dangling, we should reuse @@ -1984,6 +1982,7 @@ :documentation "A function to compare two items for equality."))) (defclass generic-list-pane (list-pane meta-list-pane + standard-sheet-input-mixin ;; Hmm.. value-changed-repaint-mixin mouse-wheel-scroll-mixin) ((highlight-ink :initform +royalblue4+ @@ -2405,22 +2404,25 @@ (multiple-value-bind (x0 y0 x1 y1) (multiple-value-call #'values (transform-position (sheet-delta-transformation parent nil) cx0 cy0) - (transform-position (sheet-delta-transformation parent nil) cx1 cy1)) - (let* ((topmost-pane (if scroll-p + (transform-position (sheet-delta-transformation parent nil) cx1 cy1)) + ;; Note: This :suggested-width/height business is really a silly hack + ;; which I could have easily worked around without adding kludges + ;; to the scroller-pane.. + (let* ((topmost-pane (if scroll-p ;list-pane (scrolling (:scroll-bar :vertical :suggest-height height ;; Doesn't appear to be working.. :suggest-width (if scroll-p (+ 30 (bounding-rectangle-width list-pane)))) list-pane) list-pane)) - (topmost-pane (outlining (:thickness 1) topmost-pane)) + (topmost-pane (outlining (:thickness 1) topmost-pane)) (composed-height (space-requirement-height (compose-space topmost-pane :width (- x1 x0) :height height))) - (menu-frame (make-menu-frame topmost-pane - :min-width (bounding-rectangle-width parent) - :left x0 - :top (if (eq position :below) - y1 - (- y0 composed-height 1))))) + (menu-frame (make-menu-frame topmost-pane + :min-width (bounding-rectangle-width parent) + :left x0 + :top (if (eq position :below) + y1 + (- y0 composed-height 1))))) (values list-pane topmost-pane menu-frame))))))) (defun popup-list-box (parent)

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by rstrandh＠common-lisp.net 30 Jan '05

30 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv12131 Modified Files: inspector.lisp Log Message: Many improvements, both to functionality and to the structure of the code. (thanks to Vincent Arkesteijn) Date: Sat Jan 29 22:02:56 2005 Author: rstrandh Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.6 mcclim/Apps/Inspector/inspector.lisp:1.7 --- mcclim/Apps/Inspector/inspector.lisp:1.6 Sat Jan 29 07:57:28 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Jan 29 22:02:56 2005 @@ -25,7 +25,7 @@ (in-package :inspector) (define-application-frame inspector () - ((dico :initform (make-hash-table :test #'eq) :reader dico) + ((dico :initform (make-hash-table) :reader dico) (obj :initarg :obj :reader obj)) (:pointer-documentation t) (:panes @@ -41,6 +41,14 @@ (declare (ignore args)) (setf (gethash (obj frame) (dico frame)) t)) +(defmethod redisplay-frame-pane :after ((frame inspector) + (pane application-pane) + &key force-p) + (declare (ignore force-p)) + (change-space-requirements + pane + :height (bounding-rectangle-height (stream-output-history pane)))) + (defun inspector (obj) (let ((*print-length* 10) (*print-level* 10)) @@ -49,31 +57,24 @@ (defparameter *inspected-objects* '()) -(defun currently-viewable (obj) - (multiple-value-bind (value present) - (gethash obj (dico *application-frame*)) - (if present - value - (setf (gethash obj - (dico *application-frame*)) - (or (symbolp obj) - (numberp obj) - (stringp obj)))))) - +(defgeneric inspect-object-briefly (object pane)) (defgeneric inspect-object (object pane)) (defmethod inspect-object :around (object pane) - (cond ((not (currently-viewable object)) - (with-output-as-presentation - (pane object (presentation-type-of object)) - (princ "..."))) - ((member object *inspected-objects*) - (with-output-as-presentation - (pane object (presentation-type-of object)) - (princ "==="))) - (t - (let ((*inspected-objects* (cons object *inspected-objects*))) - (call-next-method))))) + (cond ((member object *inspected-objects*) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (princ "==="))) + ((not (gethash object (dico *application-frame*))) + (inspect-object-briefly object pane)) + (t + (let ((*inspected-objects* (cons object *inspected-objects*))) + (call-next-method))))) + +(defmethod inspect-object-briefly (object pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (princ "..."))) (defmethod inspect-object (object pane) (with-output-as-presentation @@ -120,27 +121,40 @@ (declare (ignore acceptably for-context-type)) (format stream "~s" (cdr object))) +(defmacro inspector-table (header &body body) + `(with-output-as-presentation + (pane object (presentation-type-of object)) + (formatting-table (pane) + (formatting-column (pane) + (formatting-cell (pane) + (surrounding-output-with-border (pane) + ,header)) + (formatting-cell (pane) + (formatting-table (pane) + ,@body)))))) + +(defmacro inspector-table-row (left right) + `(formatting-row (pane) + (formatting-cell (pane :align-x :right) + ,left) + (formatting-cell (pane) + ,right))) + +(defmethod inspect-object-briefly ((object standard-object) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (format pane "instance of ~S" (class-name (class-of object))))) (defmethod inspect-object ((object standard-object) pane) (let ((class (class-of object))) - (with-output-as-presentation - (pane object (presentation-type-of object)) - (formatting-table (pane) - (formatting-row (pane) - (formatting-cell (pane) - (surrounding-output-with-border (pane) - (print (class-name class) pane)))) - (formatting-row (pane) - (formatting-cell (pane) - (formatting-table (pane) - (loop for slot in (reverse (class-slots class)) - do (let ((slot-name (slot-definition-name slot))) - (formatting-row (pane) - (formatting-cell (pane :align-x :right) - (with-output-as-presentation - (pane (cons object slot-name) 'settable-slot) - (format pane "~a:" slot-name))) - (formatting-cell (pane) - (inspect-object (slot-value object slot-name) pane)))))))))))) + (inspector-table + (print (class-name class) pane) + (loop for slot in (reverse (class-slots class)) + do (let ((slot-name (slot-definition-name slot))) + (inspector-table-row + (with-output-as-presentation + (pane (cons object slot-name) 'settable-slot) + (format pane "~a:" slot-name)) + (inspect-object (slot-value object slot-name) pane))))))) (defmethod inspect-object ((object cons) pane) (if (null (cdr object)) @@ -172,44 +186,135 @@ (formatting-cell (pane) (inspect-object (cdr object) pane)))))) +(defmethod inspect-object-briefly ((object hash-table) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (princ 'hash-table pane))) (defmethod inspect-object ((object hash-table) pane) + (inspector-table + (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) + (loop for key being the hash-keys of object + do (inspector-table-row + (formatting-cell (pane) + (inspect-object key pane) + (princ "=" pane)) + (inspect-object (gethash key object) pane))))) + +(defmethod inspect-object ((object generic-function) pane) + (inspector-table + (format pane "Generic Function: ~s" (generic-function-name object)) + (loop for method in (generic-function-methods object) + do (with-output-as-presentation + (pane method (presentation-type-of method)) + (formatting-row (pane) + (formatting-cell (pane) + (print (method-qualifiers method))) + (loop for specializer in (method-specializers method) + do (formatting-cell (pane) + (format pane "~s " (class-name specializer))))))))) + +(defmethod inspect-object-briefly ((object package) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (format pane "Package: ~S" (package-name object)))) +(defmethod inspect-object ((object package) pane) + (inspector-table + (format pane "Package: ~S" (package-name object)) + (inspector-table-row + (princ "Name:" pane) + (inspect-object (package-name object) pane)) + (inspector-table-row + (princ "Nicknames:" pane) + (dolist (nick (package-nicknames object)) + (inspect-object nick pane))) + (inspector-table-row + (princ "Used by:") + (dolist (used-by (package-used-by-list object)) + (inspect-object used-by pane))) + (inspector-table-row + (princ "Uses:") + (dolist (uses (package-use-list object)) + (inspect-object uses pane))))) + +(defmethod inspect-object ((object vector) pane) (with-output-as-presentation (pane object (presentation-type-of object)) (formatting-table (pane) - (formatting-column (pane) + (formatting-row (pane) (formatting-cell (pane) - (surrounding-output-with-border (pane) - (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)))) + (princ "#(" pane)) + (dotimes (i (length object)) + (formatting-cell (pane) + (inspect-object (aref object i) pane))) (formatting-cell (pane) - (formatting-table (pane) - (loop for key being the hash-keys of object - do (formatting-row (pane) - (formatting-cell (pane :align-x :right) - (inspect-object key pane) - (princ "=" pane)) - (formatting-cell (pane) - (inspect-object (gethash key object) pane)))))))))) + (princ ")" pane)))))) -(defmethod inspect-object ((object generic-function) pane) +(defmethod inspect-object-briefly ((object string) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (print object))) + +(defmethod inspect-object-briefly ((object number) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (print object))) + +(defmethod inspect-object ((object complex) pane) (with-output-as-presentation (pane object (presentation-type-of object)) (formatting-table (pane) (formatting-row (pane) - (formatting-cell (pane) - (surrounding-output-with-border (pane) - (format pane "Generic Function: ~s" (generic-function-name object))))) - (formatting-row (pane) - (formatting-cell (pane) - (formatting-table (pane) - (loop for method in (generic-function-methods object) - do (with-output-as-presentation - (pane method (presentation-type-of method)) - (formatting-row (pane) - (formatting-cell (pane) - (print (method-qualifiers method))) - (loop for specializer in (method-specializers method) - do (formatting-cell (pane) - (format pane "~s " (class-name specializer))))))))))))) + (formatting-cell (pane) + (princ "#C(" pane)) + (formatting-cell (pane) + (inspect-object (realpart object) pane)) + (formatting-cell (pane) + (inspect-object (imagpart object) pane)) + (formatting-cell (pane) + (princ ")" pane)))))) + +(defmethod inspect-object ((object float) pane) + (inspector-table + (format pane "float ~S" object) + (multiple-value-bind (significand exponent sign) + (decode-float object) + (inspector-table-row + (princ "sign:") + (inspect-object sign pane)) + (inspector-table-row + (princ "significand:") + (inspect-object significand pane)) + (inspector-table-row + (princ "exponent:") + (inspect-object exponent pane))) + (inspector-table-row + (princ "radix:") + (inspect-object (float-radix object) pane)))) + +(defmethod inspect-object-briefly ((object symbol) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (print object))) +(defmethod inspect-object ((object symbol) pane) + (inspector-table + (format pane "Symbol ~S" (symbol-name object)) + (inspector-table-row + (princ "value:") + (if (boundp object) + (inspect-object (symbol-value object) pane) + (princ "unbound"))) + (inspector-table-row + (princ "function:") + (if (fboundp object) + (inspect-object (symbol-function object) pane) + (princ "unbound"))) + (inspector-table-row + (princ "package:") + (inspect-object (symbol-package object) pane)) + (inspector-table-row + (princ "propery list:") + (dolist (property (symbol-plist object)) + (inspect-object property pane))))) (defun display-app (frame pane) (inspect-object (obj frame) pane))

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by rstrandh＠common-lisp.net 29 Jan '05

29 Jan '05

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

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by rstrandh＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv31723 Modified Files: inspector.lisp Log Message: slots are now presentations in preparation for a command for assigning slot values. Date: Sat Jan 29 07:27:37 2005 Author: rstrandh Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.4 mcclim/Apps/Inspector/inspector.lisp:1.5 --- mcclim/Apps/Inspector/inspector.lisp:1.4 Sat Jan 29 07:02:57 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Jan 29 07:27:36 2005 @@ -126,7 +126,9 @@ do (let ((slot-name (slot-definition-name slot))) (formatting-row (pane) (formatting-cell (pane :align-x :right) - (format pane "~a:" slot-name)) + (with-output-as-presentation + (pane slot (present-type-of slot)) + (format pane "~a:" slot-name))) (formatting-cell (pane) (inspect-object (slot-value object slot-name) pane))))))))))))

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by rstrandh＠common-lisp.net 29 Jan '05

29 Jan '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv30908 Modified Files: inspector.lisp Log Message: Fixed some typos. Thanks to Vincent Arkesteijn. Date: Sat Jan 29 07:02:57 2005 Author: rstrandh Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.3 mcclim/Apps/Inspector/inspector.lisp:1.4 --- mcclim/Apps/Inspector/inspector.lisp:1.3 Sat Jan 29 06:58:29 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Jan 29 07:02:57 2005 @@ -3,7 +3,7 @@ ;;; (c) copyright 2005 by ;;; Robert Strandh (strandh(a)labri.fr) ;;; (c) copyright 2005 by -;;; Vincent Arkesteij +;;; Vincent Arkesteijn ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public @@ -92,22 +92,22 @@ (defun generic-function-name (generic-function) #+sbcl (sb-mop:generic-function-name generic-function) - #+openmcl (ccl:generic-function-name slot) + #+openmcl (ccl:generic-function-name generic-function) #-(or sbcl openmcl) (error "no MOP")) (defun generic-function-methods (generic-function) #+sbcl (sb-mop:generic-function-methods generic-function) - #+openmcl (ccl:generic-function-methods slot) + #+openmcl (ccl:generic-function-methods generic-function) #-(or sbcl openmcl) (error "no MOP")) (defun method-specializers (method) #+sbcl (sb-mop:method-specializers method) - #+openmcl (ccl:method-specializers slot) + #+openmcl (ccl:method-specializers method) #-(or sbcl openmcl) (error "no MOP")) (defun method-generic-function (method) #+sbcl (sb-mop:method-generic-function method) - #+openmcl (ccl:method-generic-function slot) + #+openmcl (ccl:method-generic-function method) #-(or sbcl openmcl) (error "no MOP")) (defmethod inspect-object ((object standard-object) pane)

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs