Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv13084

Modified Files: bordered-output.lisp events.lisp frames.lisp gadgets.lisp graphics.lisp mcclim.asd menu-choose.lisp panes.lisp protocol-classes.lisp recording.lisp stream-output.lisp text-formatting.lisp Log Message:

Take out dependencies on case in symbol names. This makes McCLIM sort of work in ACL's so-called modern mode; there have been some CLX fixes recently that may get it all the way there.

Clean up events.lisp.

Add a callback-event, which will be used in ports that get high-level gadget notifications in the event process and need to deliver them to applications.

Changed the implementation of scroll bars. When the drag callback is called, just move the sheet; assume that the gadget itself has updated the value and the graphic representation. add a scroll-bar-values interface that gets and sets all scroll bar values and only updates the bar once. This will break the Beagle back end momentarily.

--- /project/mcclim/cvsroot/mcclim/bordered-output.lisp 2005/01/02 05:24:49 1.13 +++ /project/mcclim/cvsroot/mcclim/bordered-output.lisp 2006/03/29 10:43:36 1.14 @@ -101,11 +101,11 @@ :filled nil) (draw-rectangle* stream right-edge (+ top-edge offset) - (+ right-edge offset) bottom-edge :filled T) + (+ right-edge offset) bottom-edge :filled t) (draw-rectangle* stream (+ left-edge offset) bottom-edge (+ right-edge offset) (+ bottom-edge offset) - :filled T))) + :filled t)))

(define-border-type :underline (stream record) (labels ((fn (record) --- /project/mcclim/cvsroot/mcclim/events.lisp 2006/03/10 21:58:12 1.28 +++ /project/mcclim/cvsroot/mcclim/events.lisp 2006/03/29 10:43:36 1.29 @@ -59,7 +59,11 @@ (defclass standard-event (event) ((timestamp :initarg :timestamp :initform nil - :reader event-timestamp))) + :reader event-timestamp) + ;; This slot is pretty much required in order to call handle-event. Some + ;; events have something other than a sheet in this slot, which is gross. + (sheet :initarg :sheet + :reader event-sheet)))

(defmethod initialize-instance :after ((event standard-event) &rest initargs) (declare (ignore initargs)) @@ -79,11 +83,28 @@ ; (if (null position) ; :event ; (intern (subseq type 0 position) :keyword)))) +;;; Reintroduce something like that definition, with defmethod goodness. +;;; -- moore

-(defclass device-event (standard-event) - ((sheet :initarg :sheet - :reader event-sheet) - (modifier-state :initarg :modifier-state +(defmacro define-event-class (name supers slots &rest options) + (let* ((event-tag (string '#:-event)) + (name-string (string name)) + (pos (search event-tag name-string :from-end t))) + (when (or (null pos) + (not (eql (+ pos (length event-tag)) (length name-string)))) + (error "~S does not end in ~A and is not a valid event name for ~ + define-event-class." + name event-tag)) + (let ((type (intern (subseq name-string 0 pos) :keyword))) + `(progn + (defclass ,name ,supers + ,slots + ,@options) + (defmethod event-type ((event ,name)) + ',type))))) + +(define-event-class device-event (standard-event) + ((modifier-state :initarg :modifier-state :reader event-modifier-state) (x :initarg :x :reader device-event-native-x) @@ -94,21 +115,19 @@ (graft-y :initarg :graft-y :reader device-event-native-graft-y)))

-(defclass keyboard-event (device-event) +(define-event-class keyboard-event (device-event) ((key-name :initarg :key-name :reader keyboard-event-key-name) (key-character :initarg :key-character :reader keyboard-event-character :initform nil)))

-(defclass key-press-event (keyboard-event) - ( - )) - -(defclass key-release-event (keyboard-event) - ( - )) +(define-event-class key-press-event (keyboard-event) + ())

-(defclass pointer-event (device-event) +(define-event-class key-release-event (keyboard-event) + ()) + +(define-event-class pointer-event (device-event) ((pointer :initarg :pointer :reader pointer-event-pointer) (button :initarg :button @@ -149,33 +168,28 @@ (defmethod device-event-y ((event device-event)) (get-pointer-position ((event-sheet event) event) y))

-(defclass pointer-button-event (pointer-event) - ( - )) +(define-event-class pointer-button-event (pointer-event) + ())

-(defclass pointer-button-press-event (pointer-button-event) ()) +(define-event-class pointer-button-press-event (pointer-button-event) ())

-(defclass pointer-button-release-event (pointer-button-event) ()) +(define-event-class pointer-button-release-event (pointer-button-event) ())

-(defclass pointer-button-hold-event (pointer-button-event) ()) +(define-event-class pointer-button-hold-event (pointer-button-event) ())

-(defclass pointer-button-click-event (pointer-button-event) - ( - )) +(define-event-class pointer-button-click-event (pointer-button-event) + ())

-(defclass pointer-button-double-click-event (pointer-button-event) - ( - )) +(define-event-class pointer-button-double-click-event (pointer-button-event) + ())

-(defclass pointer-button-click-and-hold-event (pointer-button-event) - ( - )) +(define-event-class pointer-button-click-and-hold-event (pointer-button-event) + ())

-(defclass pointer-motion-event (pointer-event) - ( - )) +(define-event-class pointer-motion-event (pointer-event) + ())

(defclass motion-hint-mixin () () @@ -185,28 +199,22 @@ (defclass pointer-motion-hint-event (pointer-motion-event motion-hint-mixin) ())

-(defclass pointer-boundary-event (pointer-motion-event) - ( - )) +(define-event-class pointer-boundary-event (pointer-motion-event) + ())

-(defclass pointer-enter-event (pointer-boundary-event) - ( - )) +(define-event-class pointer-enter-event (pointer-boundary-event) + ())

-(defclass pointer-exit-event (pointer-boundary-event) - ( - )) +(define-event-class pointer-exit-event (pointer-boundary-event) + ())

-(defclass pointer-ungrab-event (pointer-exit-event) +(define-event-class pointer-ungrab-event (pointer-exit-event) ())

-(defclass window-event (standard-event) - ((sheet :initarg :sheet - :reader event-sheet) - (region :initarg :region - :reader window-event-native-region) - )) +(define-event-class window-event (standard-event) + ((region :initarg :region + :reader window-event-native-region)))

(defmethod window-event-region ((event window-event)) (untransform-region (sheet-native-transformation (event-sheet event)) @@ -215,7 +223,7 @@ (defmethod window-event-mirrored-sheet ((event window-event)) (sheet-mirror (event-sheet event)))

-(defclass window-configuration-event (window-event) +(define-event-class window-configuration-event (window-event) ((x :initarg :x :reader window-configuration-event-native-x) (y :initarg :y :reader window-configuration-event-native-y) (width :initarg :width :reader window-configuration-event-width) @@ -235,64 +243,27 @@ (defmethod window-configuration-event-y ((event window-configuration-event)) (get-window-position ((event-sheet event) event) y))

-(defclass window-unmap-event (window-event) +(define-event-class window-unmap-event (window-event) ())

-(defclass window-destroy-event (window-event) +(define-event-class window-destroy-event (window-event) ())

-(defclass window-repaint-event (window-event) - ( - )) +(define-event-class window-repaint-event (window-event) + ())

-(defclass window-manager-event (standard-event) ()) +(define-event-class window-manager-event (standard-event) ())

-(defclass window-manager-delete-event (window-manager-event) - ((sheet :initarg :sheet ; not required by the spec but we need - :reader event-sheet) ; to know which window to delete - mikemac - )) +(define-event-class window-manager-delete-event (window-manager-event) + ;; sheet (inherited from standard-event) is not required by the spec but we + ;; need to know which window to delete - mikemac + ())

-(defclass timer-event (standard-event) - ((sheet - :initarg :sheet - :reader event-sheet) - (token +(define-event-class timer-event (standard-event) + ((token :initarg :token :reader event-token)))

-(defmethod event-instance-slots ((self event)) - '(timestamp)) - -(defmethod event-instance-slots ((self device-event)) - '(timestamp modifier-state sheet)) - -(defmethod event-instance-slots ((self keyboard-event)) - '(timestamp modifier-state sheet key-name)) - -(defmethod event-instance-slots ((self pointer-event)) - '(timestamp modifier-state sheet pointer button x y root-x root-y)) - -(defmethod event-instance-slots ((self window-event)) - '(timestamp region)) - -;(defmethod print-object ((self event) sink) -; (print-object-with-slots self (event-instance-slots self) sink)) - -;(defmethod translate-event ((self pointer-event) dx dy) -; (apply #'make-instance (class-of self) -; :x (+ dx (pointer-event-x self)) -; :y (+ dy (pointer-event-y self)) -; (fetch-slots-as-kwlist self (event-instance-slots self)))) - -;(defmethod translate-event ((self window-event) dx dy) -; (apply #'make-instance (class-of self) -; :region (translate-region (window-event-region self) dx dy) -; (fetch-slots-as-kwlist self (event-instance-slots self)))) - -;(defmethod translate-event ((self event) dx dy) -; (declare (ignore dx dy)) -; self) - ;;; Constants dealing with events

(defconstant +pointer-left-button+ #x01) @@ -339,32 +310,6 @@ (check-modifier (,m) (not (zerop (logand ,m ,modifier-state))))) (and ,@(do-substitutes clauses))))))

-(defmethod event-type ((event device-event)) :device) -(defmethod event-type ((event keyboard-event)) :keyboard) -(defmethod event-type ((event key-press-event)) :key-press) -(defmethod event-type ((event key-release-event)) :key-release) -(defmethod event-type ((event pointer-event)) :pointer) -(defmethod event-type ((event pointer-button-event)) :pointer-button) -(defmethod event-type ((event pointer-button-press-event)) :pointer-button-press) -(defmethod event-type ((event pointer-button-release-event)) :pointer-button-release) -(defmethod event-type ((event pointer-button-hold-event)) :pointer-button-hold) -(defmethod event-type ((event pointer-motion-event)) :pointer-motion) -(defmethod event-type ((event pointer-boundary-event)) :pointer-boundary) -(defmethod event-type ((event pointer-enter-event)) :pointer-enter) -(defmethod event-type ((event pointer-exit-event)) :pointer-exit) -(defmethod event-type ((event window-event)) :window) -(defmethod event-type ((event window-configuration-event)) :window-configuration) -(defmethod event-type ((event window-repaint-event)) :window-repaint) -(defmethod event-type ((event window-manager-event)) :window-manager) -(defmethod event-type ((event window-manager-delete-event)) :window-manager-delete) -(defmethod event-type ((event timer-event)) :timer) - -;; keyboard-event-character keyboard-event -;; pointer-event-native-x pointer-event -;; pointer-event-native-y pointer-event -;; window-event-native-region window-event -;; window-event-mirrored-sheet window-event - ;; Key names are a symbol whose value is port-specific. Key names ;; corresponding to the set of standard characters (such as the ;; alphanumerics) will be a symbol in the keyword package. --- /project/mcclim/cvsroot/mcclim/frames.lisp 2006/03/15 15:38:39 1.117 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2006/03/29 10:43:37 1.118 @@ -581,7 +581,7 @@ #+NIL (read-command (frame-command-table frame) :use-keystrokes nil :stream stream) (read-command (frame-command-table frame) :use-keystrokes t :stream stream))

-(defclass execute-command-event (window-manager-event) +(define-event-class execute-command-event (window-manager-event) ((sheet :initarg :sheet :reader event-sheet) (command :initarg :command :reader execute-command-event-command)))

--- /project/mcclim/cvsroot/mcclim/gadgets.lisp 2006/03/27 10:46:11 1.97 +++ /project/mcclim/cvsroot/mcclim/gadgets.lisp 2006/03/29 10:43:37 1.98 @@ -115,11 +115,14 @@ ;; - make NIL a valid label, and take it into account when applying ;; spacing.

-;;;; ------------------------------------------------------------------------------------------ +;;;; -------------------------------------------------------------------------- ;;;; ;;;; 30.3 Basic Gadget Classes ;;;;

+;;; XXX I'm not sure that *application-frame* should be rebound like this. What +;;; about gadgets in accepting-values windows? An accepting-values window +;;; shouldn't be bound to *application-frame*. -- moore (defun invoke-callback (pane callback &rest more-arguments) (when callback (let ((*application-frame* (pane-frame pane))) @@ -1421,6 +1424,14 @@ (declare (ignore new-value invoke-callback)) (scroll-bar/update-display pane))

+(defmethod* (setf scroll-bar-values) + (min-value max-value thumb-size value (scroll-bar scroll-bar-pane)) + (setf (slot-value scroll-bar 'min-value) min-value + (slot-value scroll-bar 'max-value) max-value + (slot-value scroll-bar 'thumb-size) thumb-size + (slot-value scroll-bar 'value) value) + (scroll-bar/update-display scroll-bar)) + ;;;; geometry

(defparameter +minimum-thumb-size-in-pixels+ 30) @@ -2818,3 +2829,31 @@

(defmethod note-sheet-grafted ((sheet clim-extensions:box-adjuster-gadget)) (setf (sheet-pointer-cursor sheet) :rotate)) + +;;; Support for definition of callbacks and associated callback events. A +;;; callback event is used by a backend when a high-level notification of a +;;; gadget state change is delivered in the CLIM event process -- by a native +;;; gadget, for example -- and must be delivered in the application process. + +(define-event-class callback-event (standard-event) + ((sheet :initarg :gadget :reader event-gadget + :documentation "An alias for sheet, for readability") + (callback-function :initarg :callback-function :reader callback-function) + (client :initarg :client :reader event-client) + (client-id :initarg :client-id :reader event-client-id) + (other-args :initarg :other-args :reader event-other-args :initform nil))) + +(defun queue-callback (fn gadget client client-id &rest other-args) + (queue-event gadget (make-instance 'callback-event + :callback-function fn + :gadget gadget + :client client + :client-id client-id + :other-args other-args))) + +(defmethod handle-event ((gadget basic-gadget) (event callback-event)) + (apply (callback-function event) + (event-client event) + (event-client-id event) + (event-other-args event))) + --- /project/mcclim/cvsroot/mcclim/graphics.lisp 2005/09/10 11:53:15 1.51 +++ /project/mcclim/cvsroot/mcclim/graphics.lisp 2006/03/29 10:43:37 1.52 @@ -111,7 +111,7 @@ (if (null line-style) (setf line-style old-line-style)) (when (or line-unit line-thickness dashes-p line-joint-shape line-cap-shape) - (setf changed-line-style T) + (setf changed-line-style t) (setf line-style (make-line-style :unit (or line-unit (line-style-unit line-style)) @@ -130,7 +130,7 @@ (medium-merged-text-style medium))) (setf text-style (medium-merged-text-style medium))) (when (or text-family-p text-face-p text-size-p) - (setf changed-text-style T) + (setf changed-text-style t) (setf text-style (merge-text-styles (make-text-style text-family text-face text-size) --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/24 11:45:03 1.15 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/29 10:43:37 1.16 @@ -51,10 +51,11 @@ ;;; Make CLX asdf-loadable on Allegro 6.2 ;;; possibly this should be further refined to funciton properly for ;;; Allegro on Windows platforms. [2005/04/18:rpg] + #+allegro (progn (defclass requireable-system (asdf:system) - ()) + ()) (defmethod asdf:perform ((op asdf:load-op) (system requireable-system)) (require (intern (slot-value system 'asdf::name) :keyword))) (defmethod asdf::traverse ((op asdf:load-op) (system requireable-system)) @@ -62,7 +63,6 @@ (defsystem :clx :class requireable-system))

- (defmacro clim-defsystem ((module &key depends-on) &rest components) `(progn (asdf:defsystem ,module --- /project/mcclim/cvsroot/mcclim/menu-choose.lisp 2006/02/23 17:39:32 1.17 +++ /project/mcclim/cvsroot/mcclim/menu-choose.lisp 2006/03/29 10:43:37 1.18 @@ -43,7 +43,7 @@ ;;; + menu frame size ;;; + layout

-(in-package :CLIM-INTERNALS) +(in-package :clim-internals)

(defgeneric menu-choose (items --- /project/mcclim/cvsroot/mcclim/panes.lisp 2006/03/27 10:46:11 1.168 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2006/03/29 10:43:37 1.169 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA.

-;;; $Id: panes.lisp,v 1.168 2006/03/27 10:46:11 crhodes Exp $ +;;; $Id: panes.lisp,v 1.169 2006/03/29 10:43:37 tmoore Exp $

(in-package :clim-internals)

@@ -1515,7 +1515,7 @@ (space-requirement-major sr)))) srs))) #+nil - (format T "~&;; ~S: allot=~S, wanted=~S, excess=~S, qs=~S~%" + (format t "~&;; ~S: allot=~S, wanted=~S, excess=~S, qs=~S~%" 'allot-space-xically allot wanted excess qs) (let ((sum (reduce #'+ qs))) (cond ((zerop sum) @@ -1592,11 +1592,11 @@ (- width xs)))) #+nil (progn - (format T "~&;; row space requirements = ~S." rsrs) - (format T "~&;; col space requirements = ~S." csrs) - (format T "~&;; row allotment: needed = ~S result = ~S (sum ~S)." height rows (reduce #'+ rows)) - (format T "~&;; col allotment: needed = ~S result = ~S (sum ~S)." width cols (reduce #'+ cols)) - (format T "~&;; align-x = ~S, align-y ~S~%" + (format t "~&;; row space requirements = ~S." rsrs) + (format t "~&;; col space requirements = ~S." csrs) + (format t "~&;; row allotment: needed = ~S result = ~S (sum ~S)." height rows (reduce #'+ rows)) + (format t "~&;; col allotment: needed = ~S result = ~S (sum ~S)." width cols (reduce #'+ cols)) + (format t "~&;; align-x = ~S, align-y ~S~%" (pane-align-x pane) (pane-align-y pane))) ;; now finally layout each child @@ -1882,7 +1882,7 @@ ;; ;; One might argue that in case of no scroll-bars the ;; application programmer can just skip the scroller - ;; pane altogether. But I think that the then needed + ;; pane altogether. Bu I think that the then needed ;; special casing on having a scroller pane or a bare ;; viewport at hand is an extra burden, that can be ;; avoided. @@ -1899,6 +1899,12 @@ :x-spacing 4 :y-spacing 4))

+(defgeneric scroll-bar-values (scroll-bar) + (:documentation "Returns the min value, max value, thumb size, and value of a + scroll bar. When Setf-ed, updates the scroll bar graphics")) + +(defgeneric* (setf scroll-bar-values) (min-value max-value thumb-size value scroll-bar)) + (defmacro scrolling ((&rest options) &body contents) `(let ((viewport (make-pane 'viewport-pane :contents (list ,@contents)))) (make-pane 'scroller-pane ,@options :contents (list viewport)))) @@ -1973,11 +1979,7 @@ 0 (* (/ (gadget-value vscrollbar) (gadget-max-value vscrollbar)) max)))) - (setf (gadget-min-value vscrollbar) min - (gadget-max-value vscrollbar) max - (scroll-bar-thumb-size vscrollbar) ts - (gadget-value vscrollbar :invoke-callback nil) val))) - + (setf (scroll-bar-values vscrollbar) (values min max ts val)))) (when hscrollbar (let* ((scrollee (first (sheet-children viewport))) (min 0) @@ -1989,11 +1991,7 @@ 0 (* (/ (gadget-value hscrollbar) (gadget-max-value hscrollbar)) max)))) - (setf (gadget-min-value hscrollbar) min - (gadget-max-value hscrollbar) max - (scroll-bar-thumb-size hscrollbar) ts - (gadget-value hscrollbar :invoke-callback nil) val))) - + (setf (scroll-bar-values hscrollbar) (values min max ts val)))) (when viewport (setf (sheet-transformation viewport) (make-translation-transformation @@ -2009,17 +2007,24 @@ "Callback for the vertical scroll-bar of a scroller-pane." (with-slots (viewport hscrollbar vscrollbar) pane (let ((scrollee (first (sheet-children viewport)))) - (scroll-extent scrollee - (if hscrollbar (gadget-value hscrollbar) 0) - new-value)))) + (when (pane-viewport scrollee) + (move-sheet scrollee + (round (if hscrollbar + (- (gadget-value hscrollbar)) + 0)) + (round (- new-value)))))))

(defmethod scroller-pane/horizontal-drag-callback ((pane scroller-pane) new-value) "Callback for the horizontal scroll-bar of a scroller-pane." (with-slots (viewport hscrollbar vscrollbar) pane (let ((scrollee (first (sheet-children viewport)))) - (scroll-extent scrollee - new-value - (if vscrollbar (gadget-value vscrollbar) 0))))) + (when (pane-viewport scrollee) + (move-sheet scrollee + (round (- new-value)) + (round (if vscrollbar + (- (gadget-value vscrollbar)) + 0))))))) +

(defmethod scroller-pane/update-scroll-bars ((pane scroller-pane)) (with-slots (viewport hscrollbar vscrollbar) pane @@ -2028,24 +2033,27 @@ (viewport-sr (sheet-region viewport))) ;; (when hscrollbar - (setf (gadget-min-value hscrollbar) (bounding-rectangle-min-x scrollee-sr) - (gadget-max-value hscrollbar) (max (- (bounding-rectangle-max-x scrollee-sr) - (bounding-rectangle-width viewport-sr)) - (bounding-rectangle-min-x scrollee-sr)) - (scroll-bar-thumb-size hscrollbar) (bounding-rectangle-width viewport-sr) - (gadget-value hscrollbar :invoke-callback nil) - (- (nth-value 0 (transform-position (sheet-transformation scrollee) 0 0))) - )) + (setf (scroll-bar-values hscrollbar) + (values (bounding-rectangle-min-x scrollee-sr) + (max (- (bounding-rectangle-max-x scrollee-sr) + (bounding-rectangle-width viewport-sr)) + (bounding-rectangle-min-x scrollee-sr)) + (bounding-rectangle-width viewport-sr) + (- (nth-value 0 (transform-position + (sheet-transformation scrollee) 0 0)))))) ;; (when vscrollbar - (setf (gadget-min-value vscrollbar) (bounding-rectangle-min-y scrollee-sr) - (gadget-max-value vscrollbar) (max (- (bounding-rectangle-max-y scrollee-sr) - (bounding-rectangle-height viewport-sr)) - (bounding-rectangle-min-y scrollee-sr)) - (scroll-bar-thumb-size vscrollbar) (bounding-rectangle-height viewport-sr) - (gadget-value vscrollbar :invoke-callback nil) - (- (nth-value 1 (transform-position (sheet-transformation scrollee) 0 0))) - ))))) + (setf (scroll-bar-values vscrollbar) + (values (bounding-rectangle-min-y scrollee-sr) + (max (- (bounding-rectangle-max-y scrollee-sr) + (bounding-rectangle-height viewport-sr)) + (bounding-rectangle-min-y scrollee-sr)) + (bounding-rectangle-height viewport-sr) + (- (nth-value 1 (transform-position + (sheet-transformation scrollee) + 0 + 0))))))))) +

(defmethod initialize-instance :after ((pane scroller-pane) &key contents &allow-other-keys) (sheet-adopt-child pane (first contents)) --- /project/mcclim/cvsroot/mcclim/protocol-classes.lisp 2006/03/10 21:58:13 1.1 +++ /project/mcclim/cvsroot/mcclim/protocol-classes.lisp 2006/03/29 10:43:37 1.2 @@ -22,10 +22,15 @@ (in-package :clim-internals)

(defmacro define-protocol-class (name super-classes &optional slots &rest options) - (let ((protocol-predicate - (intern (concatenate 'string (symbol-name name) (if (find #- (symbol-name name)) "-" "") "P"))) - (predicate-docstring - (concatenate 'string "Protocol predicate checking for class " (symbol-name name)))) + (let* ((sym-name (symbol-name name)) + (protocol-predicate + (intern (concatenate 'string + sym-name + (if (find #- sym-name) "-" "") + (symbol-name '#:p)))) + (predicate-docstring + (concatenate 'string + "Protocol predicate checking for class " sym-name))) `(progn (defclass ,name ,super-classes ,slots ,@options)

--- /project/mcclim/cvsroot/mcclim/recording.lisp 2006/03/10 21:58:13 1.124 +++ /project/mcclim/cvsroot/mcclim/recording.lisp 2006/03/29 10:43:37 1.125 @@ -844,7 +844,7 @@ (>= cx2 old-max-x) (>= cy2 old-max-y)) (values (min cx1 ox1) (min cy1 oy1) (max cx2 ox2) (max cy2 oy2))) - (T (%tree-recompute-extent* record))) + (t (%tree-recompute-extent* record))) ;; XXX banish x, y (with-slots (x y) record @@ -2337,7 +2337,7 @@ (bounding-rectangle region)))) (with-bounding-rectangle* (x1 y1 x2 y2) region (with-output-recording-options (stream :record nil) - (draw-rectangle* stream x1 y1 x2 y2 :filled T :ink +background-ink+))) + (draw-rectangle* stream x1 y1 x2 y2 :filled t :ink +background-ink+))) (stream-replay stream region)))))

(defmethod handle-repaint ((stream output-recording-stream) region) --- /project/mcclim/cvsroot/mcclim/stream-output.lisp 2006/03/10 21:58:13 1.58 +++ /project/mcclim/cvsroot/mcclim/stream-output.lisp 2006/03/29 10:43:37 1.59 @@ -107,8 +107,8 @@ (defun decode-cursor-visibility (visibility) "Given :on, :off, or nil, returns the needed active and state attributes for the cursor." (ecase visibility - ((:on T) (values T T)) - (:off (values T nil)) + ((:on t) (values t t)) + (:off (values t nil)) ((nil) (values nil nil))))

(defmethod cursor-visibility ((cursor cursor-mixin)) @@ -116,7 +116,7 @@ (s (cursor-state cursor))) (cond ((and a s) :on) ((and a (not s)) :off) - (T nil)))) + (t nil))))

(defmethod (setf cursor-visibility) (nv (cursor cursor-mixin)) (multiple-value-bind (active state) --- /project/mcclim/cvsroot/mcclim/text-formatting.lisp 2003/11/10 21:40:34 1.8 +++ /project/mcclim/cvsroot/mcclim/text-formatting.lisp 2006/03/29 10:43:37 1.9 @@ -143,8 +143,8 @@ (setq seg-start (1+ i)))) (foo seg-start end))))) -(defmacro indenting-output ((stream indent &key (move-cursor T)) &body body) - (when (eq stream T) +(defmacro indenting-output ((stream indent &key (move-cursor t)) &body body) + (when (eq stream t) (setq stream '*standard-output*)) (with-gensyms (old-x old-y) `(multiple-value-bind (,old-x ,old-y)