Author: junrue Date: Mon Sep 11 23:04:31 2006 New Revision: 258
Modified: trunk/docs/manual/event-functions.texinfo trunk/docs/manual/reference.texinfo trunk/docs/manual/widget-types.texinfo trunk/src/tests/uitoolkit/widget-tester.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/widgets/event-generics.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/list-box.lisp Log: implemented and documented event-scroll generic function as first stage of implementing general scrolling support; renamed list-box style :vertical-scrollbar to :scrollbar-always to reflect that this is a policy style
Modified: trunk/docs/manual/event-functions.texinfo ============================================================================== --- trunk/docs/manual/event-functions.texinfo (original) +++ trunk/docs/manual/event-functions.texinfo Mon Sep 11 23:04:31 2006 @@ -271,6 +271,62 @@ @end table @end deffn
+@anchor{event-scroll} +@deffn GenericFunction event-scroll @ref{event-dispatcher} @ref{widget} axis detail +Implement this method to handle scrolling notifications for @var{widget}. +@table @var +@event-dispatcher-arg +@item widget +The @ref{widget} that was scrolled. +@item axis +The scrolling orientation, identified by one of the following +keyword symbols:@*@* +@table @code +@item :horizontal +Indicates that scrolling is occurring in the horizontal axis. +@item :vertical +Indicates that scrolling is occurring in the vertical axis. +@end table +@item detail +The specific scrolling request, identified by one of the +following keyword symbols:@*@* +@table @code +@item :end +The bottom or right-most content is revealed. +@item :page-back +The viewport is moved backward towards content start by +an amount equal to the viewport's height or width, or +the amount remaining between the viewport's origin +and the start, whichever is smaller. +@item :page-forward +The viewport is moved forward towards content end by +an amount equal to the viewport's height or width, or +the amount remaining between the viewport's origin +and the end, whichever is smaller. +@item :start +The viewport is moved such that the top or left-most +content edge is revealed. +@item :step-back +The viewport is moved backward towards content start by +an application-defined increment, or the amount +remaining between the viewport's origin and the start, +whichever is smaller. +@item :step-forward +The viewport is moved forward towards content end by an +application-defined increment, or the amount +remaining between the viewport's origina and the end, +whichever is smaller. +@item :thumb-position +Indicates an absolute position to which the viewport origin +is moved, as when the user releases the mouse button from a +scrollbar thumb. +@item :thumb-track +Indicates that the user is adjusting the position of the +viewport continuously, as when dragging a scrollbar thumb. +@end table +@end table +@end deffn + @anchor{event-select} @deffn GenericFunction event-select @ref{event-dispatcher} @ref{widget} Implement this method to handle notification that @var{widget} (or some
Modified: trunk/docs/manual/reference.texinfo ============================================================================== --- trunk/docs/manual/reference.texinfo (original) +++ trunk/docs/manual/reference.texinfo Mon Sep 11 23:04:31 2006 @@ -136,6 +136,27 @@ @end deftp @end macro
+@macro begin-primary-style-choices{defaultdesc} +The @code{:style} initarg is a list of keywords that define the +look-and-feel of the widget being created. \defaultdesc\ +Applications may choose from one of the following primary styles: +@table @code +@end macro + +@macro end-primary-style-choices +@end table +@end macro + +@macro begin-optional-style-choices +One or more of the following optional style keyword(s) may be +specified in the style keyword list: +@table @code +@end macro + +@macro end-optional-style-choices +@end table +@end macro + @c ==========================End Macros =============================
@copying
Modified: trunk/docs/manual/widget-types.texinfo ============================================================================== --- trunk/docs/manual/widget-types.texinfo (original) +++ trunk/docs/manual/widget-types.texinfo Mon Sep 11 23:04:31 2006 @@ -185,7 +185,8 @@ @end deffn @control-parent-initarg{button} @deffn Initarg :style -@table @code +@begin-primary-style-choices{The @code{:push-button} style is the +default.} @item :cancel-button Placing a @code{:cancel-button} in a @ref{dialog} enables the @sc{escape} key @ref{accelerator} for dismissing the dialog. This @@ -218,7 +219,7 @@ This style specifies a control that looks similar to a @code{:check-box}, but the box can be grayed as well as checked or cleared. The grayed look is used to indicate an undetermined state. -@end table +@end-primary-style-choices @end deffn @deffn Initarg :text Supplies the text for the button label. @@ -279,7 +280,7 @@ @control-callback-initarg{edit,event-modify} @control-parent-initarg{edit} @deffn Initarg :style -@table @code +@begin-optional-style-choices @item :auto-hscroll Specifies that the edit control will scroll text content to the right by 10 characters when the user types a character at the end @@ -323,7 +324,7 @@ style is also specified. Without this style, within a dialog the act of typing @sc{enter} has the same effect as pressing the dialog's default button. -@end table +@end-optional-style-choices @end deffn @deffn Initarg :text Supplies the initial text for the edit control. @@ -394,7 +395,8 @@ @end deffn @control-parent-initarg{list-box} @deffn Initarg :style -@table @code +@begin-primary-style-choices{By default, a single item may be +selected at a time.} @item :extend-select This style keyword causes the list-box to allow multiple items to be selected by use of the @sc{shift} key and the mouse or special @@ -405,20 +407,19 @@ @item :no-select This style keyword means that the list-box will display items but not allow any selections. -@item :single-select -This style keyword means that the list-box only allows one item at a -time to be selected. This is the default selection style. +@end-primary-style-choices +@begin-optional-style-choices +@item :scrollbar-always +This style keyword causes the list-box to show a disabled vertical +scrollbar when it does not contain enough items to scroll. Otherwise +in such a case, the scrollbar will be hidden until needed. @item :tab-stops This style keyword configures the list-box to to expand tab characters when rendering item strings. @item :want-keys This style keyword allows the application to perform special processing when the list-box has focus and the user presses a key. -@item :want-scrollbar -This style keyword causes the list-box to show a disabled vertical -scrollbar when it does not contain enough items to scroll. Otherwise -in such a case, the scrollbar will be hidden. -@end table +@end-optional-style-choices @end deffn @end-control-subclass
@@ -453,8 +454,8 @@ @ref{window} or a dialog. @end deffn @deffn Initarg :style -This initarg accepts a list of keyword symbols: -@table @code +@begin-primary-style-choices{By default, the dialog does not +show the custom colors interface.} @item :allow-custom-colors This configures the dialog to enable the Define Custom Color button, which when clicked reveals additional controls for @@ -462,7 +463,7 @@ @item :display-solid-only This configures the dialog to only display solid colors in the set of basic colors. -@end table +@end-primary-style-choices @end deffn @end deftp
@@ -484,7 +485,7 @@ @sc{nil} for the owner. @end deffn @deffn Initarg :style -@table @code +@begin-primary-style-choices{} @item :application-modal Specifies that the dialog is @emph{modal} with respect to all @ref{top-level} windows and @ref{dialog}s created by the application @@ -498,7 +499,7 @@ Specifies that the dialog is @emph{modal} only in relation to its @ref{owner} (which could be a window or another dialog). This style is the default if no style keywords are specified. -@end table +@end-primary-style-choices @end deffn @deffn Initarg :text Specifies the dialog's title. @@ -566,31 +567,32 @@ @ref{window} or a @ref{dialog}. @end deffn @deffn Initarg :style -This initarg accepts a list of keyword symbols: -@table @code +@begin-primary-style-choices{} +@item :open +This configures the dialog to be used to select one or more files +for loading data. +@item :save +This configures the dialog to be used to specify a destination file +for data to be saved. +@end-primary-style-choices +@begin-optional-style-choices @item :add-to-recent This enables the system to add a link to the selected file in the directory that contains the user's most recently used documents. @item :multiple-select This configures the dialog to accept multiple selections. -@item :open -This configures the dialog to be used to select one or more files -for loading data. @item :path-must-exist This keyword enables a validation check that constrains the user's selection to file paths that actually exist. A warning dialog will be displayed if the user supplies a non-existent path. -@item :save -This configures the dialog to be used to specify a destination file -for data to be saved. @item :show-hidden This keyword enables the dialog to display files marked @sc{hidden} by the system. @strong{Note:} files marked both @sc{hidden} and @sc{system} will not be displayed in any case. Also, be aware that using this keyword effectively overrides the user's preference settings. -@end table +@end-optional-style-choices @end deffn @deffn Initarg :text This initarg accepts a string that will become the title of the file @@ -636,8 +638,7 @@ @ref{window} or a @ref{dialog}. @end deffn @deffn Initarg :style -This initarg accepts a list of keyword symbols: -@table @code +@begin-primary-style-choices{} @item :all-fonts This is a convenience style, used by default if no other font criteria are specified, that enables the dialog to offer all @@ -659,7 +660,7 @@ Enables the dialog to offer the intersection of the sets of fonts available on the screen and the printer associated with the graphics-context specified by the @code{:gc} initarg. -@end table +@end-primary-style-choices @end deffn @end deftp
@@ -728,8 +729,9 @@ @anchor{top-level} @deftp Class top-level Base class for @ref{window}s that are self-contained and parented to -the @ref{root-window}. Except for the @code{:palette} style, they are -normally resizable and have title bars (also called 'captions'). +the @ref{root-window}. Except when created with the @code{:borderless} +or @code{:palette} styles, they are resizable and have title bars +(also called @samp{captions}). @deffn Initarg :maximum-size Sets the maximum @ref{size} to which the user may adjust the boundaries of the window. @@ -739,10 +741,7 @@ boundaries of the window. @end deffn @deffn Initarg :style -The @code{:style} initarg is a list of keywords that define the overall -look-and-feel of the window being created. Applications may choose -from one of the following primary styles: -@table @code +@begin-primary-style-choices{} @item :borderless Specifies a window with a one-pixel border (so not really @emph{borderless} in the strictest sense); no frame icon, system menu, minimize/maximize @@ -764,13 +763,12 @@ and minimize/maximize buttons; this window type is resizable; it differs from the @code{:frame} style in that the system paints the background using the @sc{color_appworkspace} Win32 color scheme. -@end table -The following style keyword(s) may also be included: -@table @code +@end-primary-style-choices +@begin-optional-style-choices @item :keyboard-navigation Enables keyboard traversal of controls within the @code{window} as if it were a @ref{dialog}. -@end table +@end-optional-style-choices @end deffn @end deftp
Modified: trunk/src/tests/uitoolkit/widget-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/widget-tester.lisp (original) +++ trunk/src/tests/uitoolkit/widget-tester.lisp Mon Sep 11 23:04:31 2006 @@ -191,7 +191,7 @@ (make-instance 'gfw:label :text "Extended Select:" :parent lb2-panel) (setf lb2 (make-instance 'gfw:list-box :parent lb2-panel :callback lb2-callback - :style '(:extend-select :want-scrollbar) + :style '(:extend-select :scrollbar-always) :items (subseq *list-box-test-data* 4))) (gfw:pack lb2-panel)
Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Mon Sep 11 23:04:31 2006 @@ -834,6 +834,22 @@ (defconstant +ps-geometric+ #x00010000) (defconstant +ps-type-mask+ #x000f0000)
+(defconstant +sb-lineup+ 0) +(defconstant +sb-lineleft+ 0) +(defconstant +sb-linedown+ 1) +(defconstant +sb-lineright+ 1) +(defconstant +sb-pageup+ 2) +(defconstant +sb-pageleft+ 2) +(defconstant +sb-pagedown+ 3) +(defconstant +sb-pageright+ 3) +(defconstant +sb-thumbposition+ 4) +(defconstant +sb-thumbtrack+ 5) +(defconstant +sb-top+ 6) +(defconstant +sb-left+ 6) +(defconstant +sb-bottom+ 7) +(defconstant +sb-right+ 7) +(defconstant +sb-endscroll+ 8) + (defconstant +size-restored+ 0) (defconstant +size-minimized+ 1) (defconstant +size-maximized+ 2)
Modified: trunk/src/uitoolkit/widgets/event-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/event-generics.lisp Mon Sep 11 23:04:31 2006 @@ -174,10 +174,15 @@ (declare (ignorable dispatcher widget))))
(defgeneric event-resize (dispatcher widget size type) - (:documentation "Implement this to respond to an object being resized.") + (:documentation "Implement this to respond to widget being resized.") (:method (dispatcher widget size type) (declare (ignorable dispatcher widget size type))))
+(defgeneric event-scroll (dispatcher widget axis detail) + (:documentation "Implement this to respond to scrolling within widget.") + (:method (dispatcher widget axis detail) + (declare (ignorable dispatcher widget axis detail)))) + (defgeneric event-select (dispatcher item) (:documentation "Implement this to respond to an object (or item within) being selected.") (:method (dispatcher item)
Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Mon Sep 11 23:04:31 2006 @@ -117,7 +117,7 @@ (cffi:pointer-address (cffi:get-callback 'subclassing_wndproc)))) (error 'gfs:win32-error :detail "set-window-long failed")))
-(defun dispatch-notification (widget wparam-hi) +(defun dispatch-control-notification (widget wparam-hi) (let ((disp (dispatcher widget))) (case wparam-hi (0 (event-select disp widget)) @@ -143,6 +143,24 @@ (setf ret-val (cffi:pointer-address (brush-handle-of widget)))) ret-val))
+(defun dispatch-scroll-notification (widget axis wparam-hi) + (let ((disp (dispatcher widget))) + (case wparam-hi + (#.gfs::+sb-top+ (event-scroll disp widget axis :start)) +; (#.gfs::+sb-left+ (event-scroll disp widget axis :start)) + (#.gfs::+sb-bottom+ (event-scroll disp widget axis :end)) +; (#.gfs::+sb-right+ (event-scroll disp widget axis :end)) + (#.gfs::+sb-lineup+ (event-scroll disp widget axis :step-back)) +; (#.gfs::+sb-lineleft+ (event-scroll disp widget axis :step-back)) + (#.gfs::+sb-linedown+ (event-scroll disp widget axis :step-forward)) +; (#.gfs::+sb-lineright+ (event-scroll disp widget axis :step-forward)) + (#.gfs::+sb-pageup+ (event-scroll disp widget axis :page-back)) +; (#.gfs::+sb-pageleft+ (event-scroll disp widget axis :page-back)) + (#.gfs::+sb-pagedown+ (event-scroll disp widget axis :page-forward)) +; (#.gfs::+sb-pageright+ (event-scroll disp widget axis :page-forward)) + (#.gfs::+sb-thumbposition+ (event-scroll disp widget axis :thumb-position)) + (#.gfs::+sb-thumbtrack+ (event-scroll disp widget axis :thumb-track))))) + (defun obtain-event-time () (gfs::get-message-time))
@@ -191,7 +209,7 @@ (event-select (dispatcher item) item)))) (let ((widget (get-widget tc (cffi:make-pointer lparam)))) (when (and widget (dispatcher widget)) - (dispatch-notification widget wparam-hi)))) + (dispatch-control-notification widget wparam-hi)))) (warn 'gfs:toolkit-warning :detail "no object for hwnd"))) 0)
@@ -329,10 +347,23 @@ 1 0)))
+(defmethod process-message (hwnd (msg (eql gfs::+wm-hscroll+)) wparam lparam) + (declare (ignore lparam)) + (let ((widget (get-widget (thread-context) hwnd))) + (if widget + (dispatch-scroll-notification widget :horizontal (hi-word wparam)))) + 0) + +(defmethod process-message (hwnd (msg (eql gfs::+wm-vscroll+)) wparam lparam) + (declare (ignore lparam)) + (let ((widget (get-widget (thread-context) hwnd))) + (if widget + (dispatch-scroll-notification widget :vertical (hi-word wparam)))) + 0) + (defmethod process-message (hwnd (msg (eql gfs::+wm-paint+)) wparam lparam) (declare (ignore wparam lparam)) - (let* ((tc (thread-context)) - (widget (get-widget tc hwnd))) + (let ((widget (get-widget (thread-context) hwnd))) (if widget (let ((rct (gfs:make-rectangle))) (cffi:with-foreign-object (ps-ptr 'gfs::paintstruct)
Modified: trunk/src/uitoolkit/widgets/list-box.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/list-box.lisp (original) +++ trunk/src/uitoolkit/widgets/list-box.lisp Mon Sep 11 23:04:31 2006 @@ -189,16 +189,16 @@ do (ecase sym ;; primary list-box styles ;; - (:extend-select (setf std-flags (lb-extend-select-flags std-flags))) - (:multiple-select (setf std-flags (lb-multi-select-flags std-flags))) - (:no-select (setf std-flags (lb-no-select-flags std-flags))) - (:single-select (setf std-flags (lb-single-select-flags std-flags))) + (:extend-select (setf std-flags (lb-extend-select-flags std-flags))) + (:multiple-select (setf std-flags (lb-multi-select-flags std-flags))) + (:no-select (setf std-flags (lb-no-select-flags std-flags))) + (:single-select (setf std-flags (lb-single-select-flags std-flags)))
;; styles that can be combined ;; - (:tab-stops (setf std-flags (logior std-flags gfs::+lbs-usetabstops+))) - (:want-keys (setf std-flags (logior std-flags gfs::+lbs-wantkeyboardinput+))) - (:want-scrollbar (setf std-flags (logior std-flags gfs::+lbs-disablenoscroll+))))) + (:tab-stops (setf std-flags (logior std-flags gfs::+lbs-usetabstops+))) + (:scrollbar-always (setf std-flags (logior std-flags gfs::+lbs-disablenoscroll+))) + (:want-keys (setf std-flags (logior std-flags gfs::+lbs-wantkeyboardinput+))))) (values std-flags 0)))
(defmethod delete-all ((self list-box))