[graphic-forms-cvs] r258 - in trunk: docs/manual src/tests/uitoolkit src/uitoolkit/system src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Sep 12 03:04:32 UTC 2006
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
+ at anchor{event-scroll}
+ at deffn GenericFunction event-scroll @ref{event-dispatcher} @ref{widget} axis detail
+Implement this method to handle scrolling notifications for @var{widget}.
+ at table @var
+ at event-dispatcher-arg
+ at item widget
+The @ref{widget} that was scrolled.
+ at item axis
+The scrolling orientation, identified by one of the following
+keyword symbols:@*@*
+ at table @code
+ at item :horizontal
+Indicates that scrolling is occurring in the horizontal axis.
+ at item :vertical
+Indicates that scrolling is occurring in the vertical axis.
+ at end table
+ at item detail
+The specific scrolling request, identified by one of the
+following keyword symbols:@*@*
+ at table @code
+ at item :end
+The bottom or right-most content is revealed.
+ at 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.
+ at 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.
+ at item :start
+The viewport is moved such that the top or left-most
+content edge is revealed.
+ at 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.
+ at 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.
+ at 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.
+ at item :thumb-track
+Indicates that the user is adjusting the position of the
+viewport continuously, as when dragging a scrollbar thumb.
+ at end table
+ at end table
+ at 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
+ at 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:
+ at table @code
+ at end macro
+
+ at macro end-primary-style-choices
+ at end table
+ at end macro
+
+ at macro begin-optional-style-choices
+One or more of the following optional style keyword(s) may be
+specified in the style keyword list:
+ at table @code
+ at end macro
+
+ at macro end-optional-style-choices
+ at end table
+ at 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
- at table @code
+ at 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.
- at end table
+ at 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
- at table @code
+ at 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.
- at end table
+ at 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
- at table @code
+ at 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.
- at 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.
+ at end-primary-style-choices
+ at begin-optional-style-choices
+ at 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.
- at 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.
- at end table
+ at 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:
- at table @code
+ at 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.
- at end table
+ at end-primary-style-choices
@end deffn
@end deftp
@@ -484,7 +485,7 @@
@sc{nil} for the owner.
@end deffn
@deffn Initarg :style
- at table @code
+ at 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.
- at end table
+ at 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:
- at table @code
+ at begin-primary-style-choices{}
+ at item :open
+This configures the dialog to be used to select one or more files
+for loading data.
+ at item :save
+This configures the dialog to be used to specify a destination file
+for data to be saved.
+ at end-primary-style-choices
+ at 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.
- at 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.
- at 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.
- at end table
+ at 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:
- at table @code
+ at 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.
- at end table
+ at 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:
- at table @code
+ at 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.
- at end table
-The following style keyword(s) may also be included:
- at table @code
+ at end-primary-style-choices
+ at begin-optional-style-choices
@item :keyboard-navigation
Enables keyboard traversal of controls within the @code{window} as if
it were a @ref{dialog}.
- at end table
+ at 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))
More information about the Graphic-forms-cvs
mailing list