Author: junrue Date: Thu Jul 6 12:19:37 2006 New Revision: 179

Modified: trunk/docs/manual/api.texinfo trunk/docs/manual/glossary.texinfo trunk/src/demos/textedit/textedit-window.lisp trunk/src/packages.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/top-level.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: defined new generic functions for configuring auto-scrolling and scrollbars; refactored existing code that modifies native styles to use a centralized function to set the bits and then refresh the hwnd

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Thu Jul 6 12:19:37 2006 @@ -294,11 +294,14 @@ Specifies that the @code{edit control} will scroll text content to the right by 10 characters when the user types a character at the end of the line. For single-line @code{edit control}s, this style is set -by the library. +by the library. See @ref{auto-hscroll-p}, @ref{auto-vscroll-p}, and +@ref{enable-auto-scrolling}. @item :auto-vscroll Specifies that the @code{edit control} will scroll text up by a page when the user types @sc{enter} on the last line. This style keyword -is only meaningful when @code{:multi-line} is also specified. +is only meaningful when @code{:multi-line} is also specified. See +@ref{auto-hscroll-p}, @ref{auto-vscroll-p}, and +@ref{enable-auto-scrolling}. @item :horizontal-scrollbar Specifies that a horizontal scrollbar should be displayed. @item :mask-characters @@ -964,6 +967,18 @@ be used to set the menu item's initial state. @end deffn

+@anchor{auto-hscroll-p} +@deffn GenericFunction auto-hscroll-p self => boolean +Returns T if @code{self} is configured for automatic horizontal scrolling; +@sc{nil} otherwise. See @ref{auto-vscroll-p} and @ref{enable-auto-scrolling}. +@end deffn + +@anchor{auto-vscroll-p} +@deffn GenericFunction auto-vscroll-p self => boolean +Returns T if @code{self} is configured for automatic vertical scrolling; +@sc{nil} otherwise. See @ref{auto-hscroll-p} and @ref{enable-auto-scrolling}. +@end deffn + @deffn GenericFunction cancel-widget self Returns the @ref{widget} that responds to the @sc{esc} key or otherwise acts to cancel the @ref{owner}. In a @ref{dialog}, this @@ -1055,6 +1070,13 @@ function is also used to start and stop @ref{timer}s. @end deffn

+@anchor{enable-auto-scrolling} +@deffn GenericFunction enable-auto-scrolling self horizontal vertical +Configures the object to allow (or to disable) automatic scrolling in +the horizontal or vertical directions. See @ref{auto-hscroll-p} +and @ref{auto-vscroll-p}. +@end deffn + @deffn GenericFunction enable-layout self flag Cause the object to allow or disallow layout management. @end deffn @@ -1063,6 +1085,16 @@ Returns @sc{t} if @code{self} is enabled; @sc{nil} otherwise. @end deffn

+@anchor{enable-scrollbars} +@deffn GenericFunction enable-scrollbars self horizontal vertical +Specifying T for @code{horizontal} (@code{vertical}) reveals a +scrollbar to attached to the right-hand (bottom) of +@code{self}. Specifying @sc{nil} hides the scrollbar. These flags do +not affect scrolling behavior in @code{self} -- they only control +scrollbar visibility. See @ref{horizontal-scrollbar-p} and +@ref{vertical-scrollbar-p}. +@end deffn + @anchor{file-dialog-paths} @deffn Function file-dialog-paths dlg => @sc{list} Interrogates the data structure associated with an instance of @@ -1094,6 +1126,12 @@ Places keyboard focus on @code{self}. @end deffn

+@anchor{horizontal-scrollbar-p} +@deffn GenericFunction horizontal-scrollbar-p self => boolean +Returns T if @code{self} has been configured to display a horizontal +scrollbar; @sc{nil} otherwise. @xref{enable-scrollbars}. +@end deffn + @deffn GenericFunction item-index self item Return the zero-based index of the location of the other object in this object. @end deffn @@ -1283,6 +1321,12 @@ before this function returns. @end deffn

+@anchor{vertical-scrollbar-p} +@deffn GenericFunction vertical-scrollbar-p self => boolean +Returns T if @code{self} has been configured to display a vertical +scrollbar; @sc{nil} otherwise. @xref{enable-scrollbars}. +@end deffn + @deffn GenericFunction visible-p self Returns T if the object is visible (not necessarily top-most); nil otherwise. @end deffn

Modified: trunk/docs/manual/glossary.texinfo ============================================================================== --- trunk/docs/manual/glossary.texinfo (original) +++ trunk/docs/manual/glossary.texinfo Thu Jul 6 12:19:37 2006 @@ -26,6 +26,13 @@ intended for more knowledgeable users and should not be the sole mechanism for invoking functionality. Compare with @ref{mnemonic}.

+@item auto-scrolling +@cindex auto-scrolling +Auto-scrolling is a feature whereby scrolling occurs +as a side effect of user input so content can remain visible, +thus avoiding the need to explicitly manipulate scrollbars to +achieve the same result. + @item control @cindex control A control is a system-defined window class that accepts user input

Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Thu Jul 6 12:19:37 2006 @@ -49,6 +49,18 @@ (setf *textedit-win* nil) (gfw:shutdown 0))

+(defun format-textedit (disp menu time) + (declare (ignore disp time)) + (gfw:check (elt (gfw:items menu) 1) + (and *textedit-control* (gfw:auto-hscroll-p *textedit-control*)))) + +(defun wordwrap-textedit (disp item time rect) + (declare (ignore disp item time rect)) + (when *textedit-control* + (let ((flag (not (gfw:auto-hscroll-p *textedit-control*)))) + ;(gfw:enable-auto-scrolling *textedit-control* flag t) + (gfw:enable-scrollbars *textedit-control* flag t)))) + (defclass textedit-win-events (gfw:event-dispatcher) ())

(defmethod gfw:event-close ((disp textedit-win-events) window time) @@ -150,9 +162,9 @@ (:item "&Go To...") (:item "" :separator) (:item "Select &All"))) - (:item "F&ormat" + (:item "F&ormat" :callback #'format-textedit :submenu ((:item "&Font...") - (:item "&Word Wrap"))) + (:item "&Word Wrap" :callback #'wordwrap-textedit))) (:item "&Help" :submenu ((:item "&About TextEdit" :callback #'about-textedit))))))) (setf *textedit-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'textedit-win-events)

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Thu Jul 6 12:19:37 2006 @@ -317,6 +317,8 @@ #:append-item #:append-separator #:append-submenu + #:auto-hscroll-p + #:auto-vscroll-p #:background-color #:background-pattern #:border-width @@ -355,8 +357,10 @@ #:display-to-object #:echo-char #:enable + #:enable-auto-scrolling #:enable-layout #:enable-redraw + #:enable-scrollbars #:enabled-p #:event-activate #:event-arm

Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Thu Jul 6 12:19:37 2006 @@ -40,6 +40,14 @@ ;;; methods ;;;

+(defmethod auto-hscroll-p ((self edit)) + (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+))) + (= (logand bits gfs::+es-autohscroll+) gfs::+es-autohscroll+))) + +(defmethod auto-vscroll-p ((self edit)) + (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+))) + (= (logand bits gfs::+es-autovscroll+) gfs::+es-autovscroll+))) + (defmethod compute-style-flags ((self edit) &rest extra-data) (declare (ignore extra-data)) (let ((std-flags (logior +default-child-style+ gfs::+ws-tabstop+)) @@ -66,6 +74,20 @@ (setf std-flags (logior std-flags gfs::+es-autohscroll+))) (values std-flags (if (find :no-border style) 0 gfs::+ws-ex-clientedge+))))

+(defmethod enable-auto-scrolling ((self edit) horizontal vertical) + (declare (ignore horizontal vertical)) + (error 'gfs:toolkit-error :detail "not yet implemented")) + +(defmethod enable-scrollbars ((self edit) horizontal vertical) + (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+))) + (if horizontal + (setf bits (logior bits gfs::+ws-hscroll+)) + (setf bits (logand bits (lognot gfs::+ws-hscroll+)))) + (if vertical + (setf bits (logior bits gfs::+ws-vscroll+)) + (setf bits (logand bits (lognot gfs::+ws-vscroll+)))) + (update-native-style self bits))) + (defmethod initialize-instance :after ((self edit) &key parent text &allow-other-keys) (initialize-comctl-classes gfs::+icc-standard-classes+) (multiple-value-bind (std-style ex-style)

Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Thu Jul 6 12:19:37 2006 @@ -63,11 +63,7 @@ (setf new-flags (logior orig-flags gfs::+ws-maximizebox+)) (setf new-flags (logior new-flags gfs::+ws-thickframe+)))) (when (/= orig-flags new-flags) - (gfs::set-window-long hwnd gfs::+gwl-style+ new-flags) - (gfs::set-window-pos hwnd (cffi:null-pointer) 0 0 0 0 (logior gfs::+swp-framechanged+ - gfs::+swp-nomove+ - gfs::+swp-nosize+ - gfs::+swp-nozorder+))))) + (update-native-style win new-flags))))

;;; ;;; methods

Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Thu Jul 6 12:19:37 2006 @@ -54,6 +54,12 @@ (defgeneric append-submenu (self text submenu dispatcher &optional checked disabled) (:documentation "Adds a submenu anchored to a parent menu and returns the corresponding item."))

+(defgeneric auto-hscroll-p (self) + (:documentation "Returns T if automatic horizontal scrolling is enabled; nil otherwise.")) + +(defgeneric auto-vscroll-p (self) + (:documentation "Returns T if automatic vertical scrolling is enabled; nil otherwise.")) + (defgeneric border-width (self) (:documentation "Returns the object's border width."))

@@ -135,6 +141,9 @@ (defgeneric enable (self flag) (:documentation "Enables or disables the object, causing it to be redrawn with its default look and allows it to be selected."))

+(defgeneric enable-auto-scrolling (self horizontal vertical) + (:documentation "Enables or disables automatic scrolling in either dimension.")) + (defgeneric enable-layout (self flag) (:documentation "Cause the object to allow or disallow layout management."))

@@ -144,6 +153,9 @@ (defgeneric enabled-p (self) (:documentation "Returns T if the object is enabled; nil otherwise."))

+(defgeneric enable-scrollbars (self horizontal vertical) + (:documentation "Shows or hides scrollbars for the widget in either dimension.")) + (defgeneric expand (self deep flag) (:documentation "Set the object (and optionally it's children) to the expanded or collapsed state."))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Thu Jul 6 12:19:37 2006 @@ -116,6 +116,14 @@ (error 'gfs:comdlg-error :detail (format nil "~a failed" (symbol-name dlg-func)))) retval))

+(defun update-native-style (widget bits) + (let ((hwnd (gfs:handle widget))) + (gfs::set-window-long hwnd gfs::+gwl-style+ bits) + (gfs::set-window-pos hwnd (cffi:null-pointer) 0 0 0 0 (logior gfs::+swp-framechanged+ + gfs::+swp-nomove+ + gfs::+swp-nosize+ + gfs::+swp-nozorder+)))) + (defun get-widget-text (w) (if (gfs:disposed-p w) (error 'gfs:disposed-error))

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Thu Jul 6 12:19:37 2006 @@ -79,12 +79,20 @@ (error 'gfs:toolkit-error :detail "no widget for parent handle")) (ancestor-p ancestor parent)))

-(defmethod border-width :before ((widget widget)) - (if (gfs:disposed-p widget) +(defmethod auto-hscroll-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod auto-vscroll-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod border-width :before ((self widget)) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod border-width ((widget widget)) - (let* ((hwnd (gfs:handle widget)) +(defmethod border-width ((self widget)) + (let* ((hwnd (gfs:handle self)) (bits (gfs::get-window-long hwnd gfs::+gwl-exstyle+))) (cond ((/= (logand bits gfs::+ws-ex-clientedge+) 0) @@ -152,13 +160,18 @@ (error 'gfs:win32-error :detail "destroy-window failed")))) (setf (slot-value w 'gfs:handle) nil))

-(defmethod enable :before ((w widget) flag) +(defmethod enable :before ((self widget) flag) (declare (ignore flag)) - (if (gfs:disposed-p w) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod enable ((w widget) flag) - (gfs::enable-window (gfs:handle w) (if (null flag) 0 1))) +(defmethod enable ((self widget) flag) + (gfs::enable-window (gfs:handle self) (if (null flag) 0 1))) + +(defmethod enable-auto-scrolling :before ((self widget) hscroll vscroll) + (declare (ignore hscroll vscroll)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)))

(defmethod enabled-p :before ((w widget)) (if (gfs:disposed-p w)