[graphic-forms-cvs] r188 - in trunk: docs/manual src/demos/textedit src/demos/unblocked src/tests/uitoolkit src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Sun Jul 9 16:03:28 UTC 2006
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}
- at deffn GenericFunction event-select dispatcher widget rect
+ at 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.
- at 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
More information about the Graphic-forms-cvs
mailing list