[graphic-forms-cvs] r188 - in trunk: docs/manual src/demos/textedit src/demos/unblocked src/tests/uitoolkit src/uitoolkit/widgets

Author: junrue Date: Sun Jul 9 12:03:27 2006 New Revision: 188

Modified: trunk/docs/manual/api.texinfo trunk/src/demos/textedit/textedit-window.lisp trunk/src/demos/unblocked/unblocked-window.lisp trunk/src/tests/uitoolkit/drawing-tester.lisp trunk/src/tests/uitoolkit/event-tester.lisp trunk/src/tests/uitoolkit/hello-world.lisp trunk/src/tests/uitoolkit/image-tester.lisp trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/widgets/event-generics.lisp trunk/src/uitoolkit/widgets/event-source.lisp trunk/src/uitoolkit/widgets/event.lisp Log: removed rectangle argument from event-select and generated callbacks

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Sun Jul 9 12:03:27 2006 @@ -1084,7 +1084,7 @@ @end deffn

@anchor{event-select} -@deffn GenericFunction event-select dispatcher widget rect +@deffn GenericFunction event-select dispatcher widget Implement this method to handle notification that @var{widget} (or some @ref{item} within @var{widget}) has been clicked on by the user in order to invoke some action. @@ -1092,8 +1092,6 @@ @event-dispatcher-arg @item widget The @ref{widget} (or item) that was selected. -@item rect -The @ref{rectangle} bounding the selection inside @var{widget}. @end table @end deffn

Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Sun Jul 9 12:03:27 2006 @@ -44,15 +44,15 @@ (declare (ignore disp)) (gfw:enable (elt (gfw:items menu) 2) (gfw:text-modified-p *textedit-control*)))

-(defun textedit-file-new (disp item rect) - (declare (ignore disp item rect)) +(defun textedit-file-new (disp item) + (declare (ignore disp item)) (when *textedit-control* (setf (gfw:text *textedit-control*) "") (setf (gfw:text-modified-p *textedit-control*) nil) (setf (file-path *textedit-model*) nil)))

-(defun textedit-file-open (disp item rect) - (declare (ignore disp item rect)) +(defun textedit-file-open (disp item) + (declare (ignore disp item)) (gfw:with-file-dialog (*textedit-win* '(:open :add-to-recent :path-must-exist) paths @@ -61,14 +61,14 @@ (load-textedit-doc (first paths)) (setf (file-path *textedit-model*) (namestring (first paths))))))

-(defun textedit-file-save (disp item rect) +(defun textedit-file-save (disp item) (if (file-path *textedit-model*) (save-textedit-doc (file-path *textedit-model*) (gfw:text *textedit-control*)) - (textedit-file-save-as disp item rect)) + (textedit-file-save-as disp item)) (setf (gfw:text-modified-p *textedit-control*) nil))

-(defun textedit-file-save-as (disp item rect) - (declare (ignore disp item rect)) +(defun textedit-file-save-as (disp item) + (declare (ignore disp item)) (gfw:with-file-dialog (*textedit-win* '(:save :add-to-recent) paths @@ -79,15 +79,15 @@ (setf (file-path *textedit-model*) (namestring (first paths))) (setf (gfw:text-modified-p *textedit-control*) nil))))

-(defun textedit-file-quit (disp item rect) - (declare (ignore disp item rect)) +(defun textedit-file-quit (disp item) + (declare (ignore disp item)) (setf *textedit-control* nil) (gfs:dispose *textedit-win*) (setf *textedit-win* nil) (gfw:shutdown 0))

-(defun textedit-font (disp item rect) - (declare (ignore disp item rect)) +(defun textedit-font (disp item) + (declare (ignore disp item)) (gfw:with-graphics-context (gc *textedit-control*) (gfw:with-font-dialog (*textedit-win* '(:no-effects) font color :gc gc :initial-font (gfg:font *textedit-control*)) (if font @@ -102,7 +102,7 @@

(defmethod gfw:event-close ((disp textedit-win-events) window) (declare (ignore window)) - (textedit-file-quit disp nil nil)) + (textedit-file-quit disp nil))

(defclass textedit-about-dialog-events (gfw:event-dispatcher) ())

@@ -110,8 +110,8 @@ (call-next-method) (gfs:dispose dlg))

-(defun about-textedit (disp item rect) - (declare (ignore disp item rect)) +(defun about-textedit (disp item) + (declare (ignore disp item)) (let* ((image (make-instance 'gfg:image :file (merge-pathnames "src/demos/textedit/about.bmp" *textedit-startup-dir*))) (dlg (make-instance 'gfw:dialog :owner *textedit-win* :dispatcher (make-instance 'textedit-about-dialog-events) @@ -152,8 +152,8 @@ :spacing 0 :style '(:vertical :normalize)))) (close-btn (make-instance 'gfw:button - :callback (lambda (disp btn rect) - (declare (ignore disp btn rect)) + :callback (lambda (disp btn) + (declare (ignore disp btn)) (gfs:dispose dlg)) :style '(:cancel-button) :text "Close"

Modified: trunk/src/demos/unblocked/unblocked-window.lisp ============================================================================== --- trunk/src/demos/unblocked/unblocked-window.lisp (original) +++ trunk/src/demos/unblocked/unblocked-window.lisp Sun Jul 9 12:03:27 2006 @@ -52,14 +52,14 @@ (defun get-scoreboard-panel () *scoreboard-panel*)

-(defun new-unblocked (disp item rect) - (declare (ignore disp item rect)) +(defun new-unblocked (disp item) + (declare (ignore disp item)) (new-game) (update-panel *scoreboard-panel*) (update-panel *tiles-panel*))

-(defun restart-unblocked (disp item rect) - (declare (ignore disp item rect)) +(defun restart-unblocked (disp item) + (declare (ignore disp item)) (restart-game) (update-panel *scoreboard-panel*) (update-panel *tiles-panel*)) @@ -69,8 +69,8 @@ (kind (shape-kind shape))) (and (> size 1) (/= kind 0) (/= kind +max-tile-kinds+))))

-(defun reveal-unblocked (disp item rect) - (declare (ignore disp item rect)) +(defun reveal-unblocked (disp item) + (declare (ignore disp item)) (let ((shape (find-shape (game-tiles) #'accept-shape-p))) (when shape (let ((shape-pnts (shape-tile-points shape)) @@ -80,8 +80,8 @@ (draw-tiles-directly *tiles-panel* shape-pnts +max-tile-kinds+) (gfw:enable timer t)))))

-(defun quit-unblocked (disp item rect) - (declare (ignore disp item rect)) +(defun quit-unblocked (disp item) + (declare (ignore disp item)) (setf *scoreboard-panel* nil) (setf *tiles-panel* nil) (gfs:dispose *unblocked-win*) @@ -92,7 +92,7 @@

(defmethod gfw:event-close ((disp unblocked-win-events) window) (declare (ignore window)) - (quit-unblocked disp nil nil)) + (quit-unblocked disp nil))

(defmethod gfw:event-timer ((disp unblocked-win-events) timer) (declare (ignore timer)) @@ -104,8 +104,8 @@ (call-next-method) (gfs:dispose dlg))

-(defun about-unblocked (disp item rect) - (declare (ignore disp item rect)) +(defun about-unblocked (disp item) + (declare (ignore disp item)) (let* ((image (make-instance 'gfg:image :file (merge-pathnames "src/demos/unblocked/about.bmp" *unblocked-startup-dir*))) (dlg (make-instance 'gfw:dialog :owner *unblocked-win* :dispatcher (make-instance 'unblocked-about-dialog-events) @@ -146,8 +146,8 @@ :spacing 0 :style '(:vertical :normalize)))) (close-btn (make-instance 'gfw:button - :callback (lambda (disp btn rect) - (declare (ignore disp btn rect)) + :callback (lambda (disp btn) + (declare (ignore disp btn)) (gfs:dispose dlg)) :style '(:cancel-button) :text "Close" @@ -203,7 +203,7 @@ (setf (gfw:minimum-size *unblocked-win*) size) (setf (gfw:maximum-size *unblocked-win*) size))

- (new-unblocked nil nil nil) + (new-unblocked nil nil) (gfw:show *unblocked-win* t)))

(defun unblocked ()

Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/drawing-tester.lisp (original) +++ trunk/src/tests/uitoolkit/drawing-tester.lisp Sun Jul 9 12:03:27 2006 @@ -50,8 +50,8 @@ (setf *last-checked-drawing-item* item) (return)))))

-(defun drawing-exit-fn (disp item rect) - (declare (ignore disp item rect)) +(defun drawing-exit-fn (disp item) + (declare (ignore disp item)) (gfs:dispose *drawing-win*) (setf *drawing-win* nil) (gfw:shutdown 0)) @@ -63,7 +63,7 @@

(defmethod gfw:event-close ((self drawing-win-events) window) (declare (ignore window)) - (drawing-exit-fn self nil nil)) + (drawing-exit-fn self nil))

(defmethod gfw:event-paint ((self drawing-win-events) window gc rect) (declare (ignore rect)) @@ -162,8 +162,8 @@ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size)) (draw-rect-start-end gc rect (clone-point start-pnt) (clone-point end-pnt) delta-x #'gfg:draw-arc nil)))

-(defun select-arcs (disp item rect) - (declare (ignore disp rect)) +(defun select-arcs (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-arcs) (gfw:redraw *drawing-win*)) @@ -185,8 +185,8 @@ (setf (gfg:pen-style gc) '(:dot :square-endcap)) (gfg:draw-poly-bezier gc (gfs:make-point :x 10 :y 110) poly-pnts))))

-(defun select-beziers (disp item rect) - (declare (ignore disp rect)) +(defun select-beziers (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-beziers) (gfw:redraw *drawing-win*)) @@ -202,8 +202,8 @@ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size)) (draw-rectangular gc rect nil delta-x #'gfg:draw-ellipse nil)))

-(defun select-ellipses (disp item rect) - (declare (ignore disp rect)) +(defun select-ellipses (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-ellipses) (gfw:redraw *drawing-win*)) @@ -240,8 +240,8 @@ #'gfg:draw-line nil)))

-(defun select-lines (disp item rect) - (declare (ignore disp rect)) +(defun select-lines (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-lines) (gfw:redraw *drawing-win*)) @@ -264,8 +264,8 @@ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size)) (draw-rectangular gc rect nil delta-x #'gfg:draw-rectangle nil)))

-(defun select-rects (disp item rect) - (declare (ignore disp rect)) +(defun select-rects (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-rects) (gfw:redraw *drawing-win*)) @@ -314,8 +314,8 @@ (setf (gfg:foreground-color gc) gfg:*color-red*) (draw-a-string gc pnt "text" "Arial" 12 nil '(:transparent))))

-(defun select-text (disp item rect) - (declare (ignore disp rect)) +(defun select-text (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-strings) (gfw:redraw *drawing-win*)) @@ -336,8 +336,8 @@ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size)) (draw-rect-start-end gc rect (clone-point start-pnt) (clone-point end-pnt) delta-x #'gfg:draw-pie-wedge nil)))

-(defun select-wedges (disp item rect) - (declare (ignore disp rect)) +(defun select-wedges (disp item) + (declare (ignore disp)) (update-drawing-item-check item) (setf (draw-func-of *drawing-dispatcher*) #'draw-wedges) (gfw:redraw *drawing-win*))

Modified: trunk/src/tests/uitoolkit/event-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/event-tester.lisp (original) +++ trunk/src/tests/uitoolkit/event-tester.lisp Sun Jul 9 12:03:27 2006 @@ -184,8 +184,8 @@

(defclass event-tester-exit-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d event-tester-exit-dispatcher) item rect) - (declare (ignore item rect)) +(defmethod gfw:event-select ((d event-tester-exit-dispatcher) item) + (declare (ignore item)) (exit-event-tester))

(defmethod gfw:event-arm ((d event-tester-exit-dispatcher) item) @@ -194,8 +194,7 @@

(defclass event-tester-echo-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d event-tester-echo-dispatcher) item rect) - (declare (ignore rect)) +(defmethod gfw:event-select ((d event-tester-echo-dispatcher) item) (setf *event-tester-text* (text-for-item (gfw:text item) "item selected")) (gfw:redraw *event-tester-window*))

@@ -217,8 +216,8 @@ (let ((item (elt (gfw:items menu) 0))) (setf (gfw:text item) (if *timer* "Sto&p Timer" "&Start Timer"))))

-(defun manage-timer (disp item rect) - (declare (ignore disp item rect)) +(defun manage-timer (disp item) + (declare (ignore disp item)) (if *timer* (progn (gfw:enable *timer* nil)

Modified: trunk/src/tests/uitoolkit/hello-world.lisp ============================================================================== --- trunk/src/tests/uitoolkit/hello-world.lisp (original) +++ trunk/src/tests/uitoolkit/hello-world.lisp Sun Jul 9 12:03:27 2006 @@ -37,15 +37,15 @@

(defclass hellowin-events (gfw:event-dispatcher) ())

-(defun exit-fn (disp item rect) - (declare (ignore disp item rect)) +(defun exit-fn (disp item) + (declare (ignore disp item)) (gfs:dispose *hello-win*) (setf *hello-win* nil) (gfw:shutdown 0))

(defmethod gfw:event-close ((disp hellowin-events) window) (declare (ignore window)) - (exit-fn disp nil nil)) + (exit-fn disp nil))

(defmethod gfw:event-paint ((disp hellowin-events) window gc rect) (declare (ignore rect))

Modified: trunk/src/tests/uitoolkit/image-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/image-tester.lisp (original) +++ trunk/src/tests/uitoolkit/image-tester.lisp Sun Jul 9 12:03:27 2006 @@ -86,8 +86,8 @@ (incf (gfs:point-x pnt) 20) (gfg:draw-image gc *true-image* pnt))))

-(defun exit-image-fn (disp item rect) - (declare (ignorable disp item rect)) +(defun exit-image-fn (disp item) + (declare (ignorable disp item)) (dispose-images) (gfs:dispose *image-win*) (setf *image-win* nil)

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Sun Jul 9 12:03:27 2006 @@ -58,8 +58,8 @@

(defclass pack-layout-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d pack-layout-dispatcher) item rect) - (declare (ignore item rect)) +(defmethod gfw:event-select ((d pack-layout-dispatcher) item) + (declare (ignore item)) (gfw:pack *layout-tester-win*))

(defclass layout-tester-widget-events (gfw:event-dispatcher) @@ -139,8 +139,7 @@ :dispatcher be)))) (incf *widget-counter*)))

-(defmethod gfw:event-select ((d layout-tester-widget-events) btn rect) - (declare (ignore rect)) +(defmethod gfw:event-select ((d layout-tester-widget-events) btn) (setf (gfw:text btn) (funcall (toggle-fn d))) (gfw:layout *layout-tester-win*))

@@ -154,8 +153,8 @@ :initarg :subtype :initform :push-button)))

-(defmethod gfw:event-select ((d add-child-dispatcher) item rect) - (declare (ignorable item rect)) +(defmethod gfw:event-select ((d add-child-dispatcher) item) + (declare (ignore item)) (add-layout-tester-widget (widget-class d) (subtype d)) (gfw:pack *layout-tester-win*))

@@ -191,8 +190,7 @@

(defclass remove-child-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d remove-child-dispatcher) item rect) - (declare (ignore rect)) +(defmethod gfw:event-select ((d remove-child-dispatcher) item) (let ((victim (find-victim (gfw:text item)))) (unless (null victim) (gfs:dispose victim) @@ -200,8 +198,7 @@

(defclass visibility-child-dispatcher (gfw:event-dispatcher) ())

-(defmethod gfw:event-select ((d visibility-child-dispatcher) item rect) - (declare (ignore rect)) +(defmethod gfw:event-select ((d visibility-child-dispatcher) item) (let ((victim (find-victim (gfw:text item)))) (unless (null victim) (gfw:show victim (not (gfw:visible-p victim))) @@ -213,8 +210,8 @@ (gfw:check (elt (gfw:items menu) 0) (find :horizontal (gfw:style-of layout))) (gfw:check (elt (gfw:items menu) 1) (find :vertical (gfw:style-of layout)))))

-(defun set-flow-horizontal (disp item rect) - (declare (ignorable disp item rect)) +(defun set-flow-horizontal (disp item) + (declare (ignorable disp item)) (let* ((layout (gfw:layout-of *layout-tester-win*)) (style (gfw:style-of layout))) (setf style (remove :vertical style)) @@ -222,8 +219,8 @@ (setf (gfw:style-of layout) style) (gfw:layout *layout-tester-win*)))

-(defun set-flow-vertical (disp item rect) - (declare (ignorable disp item rect)) +(defun set-flow-vertical (disp item) + (declare (ignorable disp item)) (let* ((layout (gfw:layout-of *layout-tester-win*)) (style (gfw:style-of layout))) (setf style (remove :horizontal style)) @@ -231,8 +228,8 @@ (setf (gfw:style-of layout) style) (gfw:layout *layout-tester-win*)))

-(defun set-flow-layout-normalize (disp item rect) - (declare (ignorable disp item rect)) +(defun set-flow-layout-normalize (disp item) + (declare (ignorable disp item)) (let* ((layout (gfw:layout-of *layout-tester-win*)) (style (gfw:style-of layout))) (if (find :normalize style) @@ -240,8 +237,8 @@ (setf (gfw:style-of layout) (push :normalize style))) (gfw:layout *layout-tester-win*)))

-(defun set-flow-layout-wrap (disp item rect) - (declare (ignorable disp item rect)) +(defun set-flow-layout-wrap (disp item) + (declare (ignorable disp item)) (let* ((layout (gfw:layout-of *layout-tester-win*)) (style (gfw:style-of layout))) (if (find :wrap style) @@ -254,8 +251,8 @@ (let ((spacing (gfw:spacing-of (gfw:layout-of *layout-tester-win*)))) (gfw:enable (elt (gfw:items menu) 0) (> spacing 0))))

-(defun decrease-flow-spacing (disp item rect) - (declare (ignore disp item rect)) +(defun decrease-flow-spacing (disp item) + (declare (ignore disp item)) (let* ((layout (gfw:layout-of *layout-tester-win*)) (spacing (gfw:spacing-of layout))) (unless (zerop spacing) @@ -263,76 +260,76 @@ (setf (gfw:spacing-of layout) spacing) (gfw:layout *layout-tester-win*))))

-(defun increase-flow-spacing (disp item rect) - (declare (ignore disp item rect)) +(defun increase-flow-spacing (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (incf (gfw:spacing-of layout) +spacing-delta+) (gfw:layout *layout-tester-win*)))

-(defun enable-left-flow-margin-items (disp menu rect) - (declare (ignore disp rect)) +(defun enable-left-flow-margin-items (disp menu) + (declare (ignore disp)) (let ((layout (gfw:layout-of *layout-tester-win*))) (gfw:enable (elt (gfw:items menu) 0) (> (gfw:left-margin-of layout) 0))))

-(defun enable-top-flow-margin-items (disp menu rect) - (declare (ignore disp rect)) +(defun enable-top-flow-margin-items (disp menu) + (declare (ignore disp)) (let ((layout (gfw:layout-of *layout-tester-win*))) (gfw:enable (elt (gfw:items menu) 0) (> (gfw:top-margin-of layout) 0))))

-(defun enable-right-flow-margin-items (disp menu rect) - (declare (ignore disp rect)) +(defun enable-right-flow-margin-items (disp menu) + (declare (ignore disp)) (let ((layout (gfw:layout-of *layout-tester-win*))) (gfw:enable (elt (gfw:items menu) 0) (> (gfw:right-margin-of layout) 0))))

-(defun enable-bottom-flow-margin-items (disp menu rect) - (declare (ignore disp rect)) +(defun enable-bottom-flow-margin-items (disp menu) + (declare (ignore disp)) (let ((layout (gfw:layout-of *layout-tester-win*))) (gfw:enable (elt (gfw:items menu) 0) (> (gfw:bottom-margin-of layout) 0))))

-(defun inc-left-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun inc-left-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (incf (gfw:left-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun inc-top-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun inc-top-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (incf (gfw:top-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun inc-right-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun inc-right-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (incf (gfw:right-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun inc-bottom-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun inc-bottom-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (incf (gfw:bottom-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun dec-left-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun dec-left-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (decf (gfw:left-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun dec-top-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun dec-top-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (decf (gfw:top-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun dec-right-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun dec-right-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (decf (gfw:right-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*)))

-(defun dec-bottom-flow-margin (disp item rect) - (declare (ignore disp item rect)) +(defun dec-bottom-flow-margin (disp item) + (declare (ignore disp item)) (let ((layout (gfw:layout-of *layout-tester-win*))) (decf (gfw:bottom-margin-of layout) +margin-delta+) (gfw:layout *layout-tester-win*))) @@ -382,8 +379,8 @@ (setf it (gfw:append-item menu "Wrap" nil #'set-flow-layout-wrap)) (gfw:check it (find :wrap style)))))

-(defun exit-layout-callback (disp item rect) - (declare (ignorable disp item rect)) +(defun exit-layout-callback (disp item) + (declare (ignorable disp item)) (exit-layout-tester))

(defun run-layout-tester-internal ()

Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Sun Jul 9 12:03:27 2006 @@ -37,15 +37,15 @@

(defclass main-win-events (gfw:event-dispatcher) ())

-(defun windlg-exit-fn (disp item rect) - (declare (ignore disp item rect)) +(defun windlg-exit-fn (disp item) + (declare (ignore disp item)) (gfs:dispose *main-win*) (setf *main-win* nil) (gfw:shutdown 0))

(defmethod gfw:event-close ((self main-win-events) window) (declare (ignore window)) - (windlg-exit-fn self nil nil)) + (windlg-exit-fn self nil))

(defclass test-win-events (gfw:event-dispatcher) ())

@@ -66,8 +66,8 @@ (declare (ignore point button)) (gfs:dispose window))

-(defun create-borderless-win (disp item rect) - (declare (ignore disp item rect)) +(defun create-borderless-win (disp item) + (declare (ignore disp item)) (let ((window (make-instance 'gfw:top-level :dispatcher (make-instance 'test-borderless-events) :owner *main-win* :style '(:borderless)))) @@ -75,8 +75,8 @@ (gfw:center-on-owner window) (gfw:show window t)))

-(defun create-miniframe-win (disp item rect) - (declare (ignore disp item rect)) +(defun create-miniframe-win (disp item) + (declare (ignore disp item)) (let ((window (make-instance 'gfw:top-level :dispatcher (make-instance 'test-mini-events) :owner *main-win* :text "Mini Frame" @@ -85,8 +85,8 @@ (setf (gfw:size window) (gfs:make-size :width 150 :height 225)) (gfw:show window t)))

-(defun create-palette-win (disp item rect) - (declare (ignore disp item rect)) +(defun create-palette-win (disp item) + (declare (ignore disp item)) (let ((window (make-instance 'gfw:top-level :dispatcher (make-instance 'test-mini-events) :owner *main-win* :text "Palette" @@ -95,8 +95,8 @@ (setf (gfw:size window) (gfs:make-size :width 150 :height 225)) (gfw:show window t)))

-(defun open-file-dlg (disp item rect) - (declare (ignore disp item rect)) +(defun open-file-dlg (disp item) + (declare (ignore disp item)) (gfw:with-file-dialog (*main-win* '(:open :add-to-recent :multiple-select) paths @@ -107,8 +107,8 @@ :text "Select Lisp-related files...") (print paths)))

-(defun save-file-dlg (disp item rect) - (declare (ignore disp item rect)) +(defun save-file-dlg (disp item) + (declare (ignore disp item)) (gfw:with-file-dialog (*main-win* '(:save) paths @@ -117,8 +117,8 @@ :initial-directory #P"c:/") (print paths)))

-(defun choose-font-dlg (disp item rect) - (declare (ignore disp item rect)) +(defun choose-font-dlg (disp item) + (declare (ignore disp item)) (gfw:with-graphics-context (gc *main-win*) (gfw:with-font-dialog (*main-win* nil font color :gc gc) (if color @@ -198,15 +198,15 @@ :style '(:vertical :normalize)) :parent dlg)) (ok-btn (make-instance 'gfw:button - :callback (lambda (disp btn rect) - (declare (ignore disp btn rect)) + :callback (lambda (disp btn) + (declare (ignore disp btn)) (gfs:dispose dlg)) :style '(:default-button) :text "OK" :parent btn-panel)) (cancel-btn (make-instance 'gfw:button - :callback (lambda (disp btn rect) - (declare (ignore disp btn rect)) + :callback (lambda (disp btn) + (declare (ignore disp btn)) (gfs:dispose dlg)) :style '(:cancel-button) :text "Cancel" @@ -220,12 +220,12 @@ (gfw:show dlg t) dlg))

-(defun open-modal-dlg (disp item rect) - (declare (ignore disp item rect)) +(defun open-modal-dlg (disp item) + (declare (ignore disp item)) (open-dlg "Modal" '(:owner-modal)))

-(defun open-modeless-dlg (disp item rect) - (declare (ignore disp item rect)) +(defun open-modeless-dlg (disp item) + (declare (ignore disp item)) (open-dlg "Modeless" '(:modeless)))

(defun run-windlg-internal ()

Modified: trunk/src/uitoolkit/widgets/event-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/event-generics.lisp Sun Jul 9 12:03:27 2006 @@ -48,10 +48,10 @@ (:method (dispatcher widget) (declare (ignorable dispatcher widget))))

-(defgeneric event-collapse (dispatcher item rect) +(defgeneric event-collapse (dispatcher item) (:documentation "Implement this to respond to an object (or item within) being collapsed.") - (:method (dispatcher item rect) - (declare (ignorable dispatcher item rect)))) + (:method (dispatcher item) + (declare (ignorable dispatcher item))))

(defgeneric event-deactivate (dispatcher widget) (:documentation "Implement this to respond to an object being deactivated.") @@ -68,10 +68,10 @@ (:method (dispatcher widget) (declare (ignorable dispatcher widget))))

-(defgeneric event-expand (dispatcher item rect) +(defgeneric event-expand (dispatcher item) (:documentation "Implement this to respond to an object (or item within) being expanded.") - (:method (dispatcher item rect) - (declare (ignorable dispatcher item rect)))) + (:method (dispatcher item) + (declare (ignorable dispatcher item))))

(defgeneric event-focus-gain (dispatcher widget) (:documentation "Implement this to respond to an object gaining keyboard focus.") @@ -173,10 +173,10 @@ (:method (dispatcher widget size type) (declare (ignorable dispatcher widget size type))))

-(defgeneric event-select (dispatcher item rect) +(defgeneric event-select (dispatcher item) (:documentation "Implement this to respond to an object (or item within) being selected.") - (:method (dispatcher item rect) - (declare (ignorable dispatcher item rect)))) + (:method (dispatcher item) + (declare (ignorable dispatcher item))))

(defgeneric event-show (dispatcher widget) (:documentation "Implement this to respond to an object being shown.")

Modified: trunk/src/uitoolkit/widgets/event-source.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-source.lisp (original) +++ trunk/src/uitoolkit/widgets/event-source.lisp Sun Jul 9 12:03:27 2006 @@ -35,7 +35,7 @@

(defconstant +callback-info+ '((gfw:event-activate . (gfw:event-source)) (gfw:event-arm . (gfw:event-source)) - (gfw:event-select . (gfw:event-source gfs:rectangle)))) + (gfw:event-select . (gfw:event-source))))

(defun make-specializer-list (disp-class arg-info) (let ((tmp (mapcar #'find-class arg-info)))

Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Sun Jul 9 12:03:27 2006 @@ -120,7 +120,7 @@ (defun dispatch-notification (widget wparam-hi) (let ((disp (dispatcher widget))) (case wparam-hi - (0 (event-select disp widget (gfs:make-rectangle))) ; FIXME + (0 (event-select disp widget)) (#.gfs::+en-killfocus+ (event-focus-loss disp widget)) (#.gfs::+en-setfocus+ (event-focus-gain disp widget)) (#.gfs::+en-update+ (event-modify disp widget))))) @@ -172,7 +172,7 @@ (if (null item) (warn 'gfs:toolkit-warning :detail (format nil "no menu item for id ~x" wparam-lo)) (unless (null (dispatcher item)) - (event-select (dispatcher item) item (gfs:make-rectangle)))))) ; FIXME + (event-select (dispatcher item) item))))) ((eq wparam-hi 1) (format t "accelerator wparam: ~x lparam: ~x~%" wparam lparam)) ; FIXME: debug (t