Author: junrue Date: Mon Jun 26 18:28:49 2006 New Revision: 163 Added: trunk/src/uitoolkit/system/comctl32.lisp trunk/src/uitoolkit/widgets/edit.lisp Modified: trunk/docs/manual/api.texinfo trunk/graphic-forms-uitoolkit.asd trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/system/system-types.lisp trunk/src/uitoolkit/widgets/button.lisp trunk/src/uitoolkit/widgets/label.lisp trunk/src/uitoolkit/widgets/panel.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/widget-constants.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp Log: preparation for implementing edit control Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Mon Jun 26 18:28:49 2006 @@ -280,6 +280,55 @@ derives from @ref{native-object}. @end deftp +@anchor{edit} +@deftp Class edit +This subclass of @ref{control} represents a rectangular area that +permits the user to enter and edit text. The @ref{event-focus-gain} +and @ref{event-focus-loss} methods of each @code{edit control}'s +@ref{event-dispatcher} are invoked when focus is given or taken +away. The @ref{event-modify} method is invoked when the user edits +content. +@deffn Initarg :style +@table @code +@item :auto-hscroll +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. +@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. +@item :mask-characters +Specifies that each character of text be masked by an echo character +instead of the one literally typed. The character can be changed via +the @ref{echo-character} @sc{setf} method. +@item :multi-line +By default, @code{edit control}s are single-line text fields. By specifying +@code{:multi-line}, multiple lines of text can be supplied. When the +@code{edit control} is in a @ref{dialog}, the @sc{enter} key will invoke +the default @ref{button}'s @ref{event-dispatcher}, unless +@code{:want-return} is also specified. If @code{:auto-hscroll} is not +specified, then text will be automatically word-wrapped. +@item :no-border +By default, an @code{edit control} is rendered with a border; this style +keyword disables that feature. +@item :no-hide-selection +This specifies that any selection remain rendered even when the +@code{edit control} loses input focus. By default, the selection +is hidden when focus is lost. +@item :read-only +Specifies that the @code{edit control}'s contents cannot be modified by +the user. +@item :want-return +Specifies that a carriage return be inserted when the user types +@sc{enter}. This style keyword only applies when the @code{:multi-line} +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 deffn +@end deftp + @anchor{event-dispatcher} @deftp Class event-dispatcher This is the base class of objects responsible for processing events on @@ -732,6 +781,12 @@ Implement this to respond to a key up event. @end deffn +@anchor{event-modify} +@deffn GenericFunction event-modify dispatcher widget time +Implement this to respond to changes within a @ref{widget}, for example +when the user types text inside an @ref{edit} control. +@end deffn + @deffn GenericFunction event-mouse-double dispatcher widget time point button Implement this to respond to a mouse double-click. @end deffn @@ -883,6 +938,14 @@ from display-relative coordinates to this object's coordinate system. @end deffn +@anchor{echo-character} +@deffn GenericFunction echo-character self => character +Returns the character currently set to be used to mask text content, +such as inside an @ref{edit} control created with the @code{:password} +style keyword, or @sc{nil} if none has been set. The corresponding +@sc{setf} function sets this value. +@end deffn + @anchor{enable} @deffn GenericFunction enable self flag For widgets, this function enables or disables the object, causing it Modified: trunk/graphic-forms-uitoolkit.asd ============================================================================== --- trunk/graphic-forms-uitoolkit.asd (original) +++ trunk/graphic-forms-uitoolkit.asd Mon Jun 26 18:28:49 2006 @@ -60,6 +60,7 @@ (:file "datastructs") (:file "clib") (:file "comdlg32") + (:file "comctl32") (:file "gdi32") (:file "kernel32") (:file "user32") @@ -98,6 +99,7 @@ (:file "item") (:file "widget") (:file "control") + (:file "edit") (:file "label") (:file "button") (:file "widget-with-items") Added: trunk/src/uitoolkit/system/comctl32.lisp ============================================================================== --- (empty file) +++ trunk/src/uitoolkit/system/comctl32.lisp Mon Jun 26 18:28:49 2006 @@ -0,0 +1,44 @@ +;;;; +;;;; comctl32.lisp +;;;; +;;;; Copyright (C) 2006, Jack D. Unrue +;;;; All rights reserved. +;;;; +;;;; Redistribution and use in source and binary forms, with or without +;;;; modification, are permitted provided that the following conditions +;;;; are met: +;;;; +;;;; 1. Redistributions of source code must retain the above copyright +;;;; notice, this list of conditions and the following disclaimer. +;;;; +;;;; 2. Redistributions in binary form must reproduce the above copyright +;;;; notice, this list of conditions and the following disclaimer in the +;;;; documentation and/or other materials provided with the distribution. +;;;; +;;;; 3. Neither the names of the authors nor the names of its contributors +;;;; may be used to endorse or promote products derived from this software +;;;; without specific prior written permission. +;;;; +;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY +;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS- +;;;; CLAIMED. IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY +;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; + +(in-package :graphic-forms.uitoolkit.system) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (use-package :cffi)) + +(load-foreign-library "comctl32.dll") + +(defcfun + ("InitCommonControlsEx" init-common-controls) + BOOL + (init LPTR)) Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Mon Jun 26 18:28:49 2006 @@ -230,6 +230,21 @@ (defconstant +dt-hideprefix+ #x00100000) (defconstant +dt-prefixonly+ #x00200000) +(defconstant +es-left+ #x0000) +(defconstant +es-center+ #x0001) +(defconstant +es-right+ #x0002) +(defconstant +es-multiline+ #x0004) +(defconstant +es-uppercase+ #x0008) +(defconstant +es-lowercase+ #x0010) +(defconstant +es-password+ #x0020) +(defconstant +es-autovscroll+ #x0040) +(defconstant +es-autohscroll+ #x0080) +(defconstant +es-nohidesel+ #x0100) +(defconstant +es-oemconvert+ #x0400) +(defconstant +es-readonly+ #x0800) +(defconstant +es-wantreturn+ #x1000) +(defconstant +es-number+ #x2000) + (defconstant +eto-opaque+ #x0002) (defconstant +eto-clipped+ #x0004) (defconstant +eto-glyph-index+ #x0010) @@ -303,6 +318,24 @@ (defconstant +hs-cross+ 4) (defconstant +hs-diagcross+ 5) +(defconstant +icc-listview-classes+ #x00000001) +(defconstant +icc-treeview-classes+ #x00000002) +(defconstant +icc-bar-classes+ #x00000004) +(defconstant +icc-tab-classes+ #x00000008) +(defconstant +icc-updown-class+ #x00000010) +(defconstant +icc-progress-class+ #x00000020) +(defconstant +icc-hotkey-class+ #x00000040) +(defconstant +icc-animate-class+ #x00000080) +(defconstant +icc-win95-classes+ #x000000FF) +(defconstant +icc-date-classes+ #x00000100) +(defconstant +icc-userex-classes+ #x00000200) +(defconstant +icc-cool-classes+ #x00000400) +(defconstant +icc-internet-classes+ #x00000800) +(defconstant +icc-pagescroller-class+ #x00001000) +(defconstant +icc-nativefntctl-class+ #x00002000) +(defconstant +icc-standard-classes+ #x00004000) +(defconstant +icc-link-class+ #x00008000) + (defconstant +idok+ 1) (defconstant +idcancel+ 2) (defconstant +idabort+ 3) Modified: trunk/src/uitoolkit/system/system-types.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-types.lisp (original) +++ trunk/src/uitoolkit/system/system-types.lisp Mon Jun 26 18:28:49 2006 @@ -121,6 +121,10 @@ (rightmargin INT) (lengthdrawn UINT)) +(defcstruct initcommoncontrolsex + (size DWORD) + (icc DWORD)) + (defcstruct logbrush (style UINT) (color COLORREF) Modified: trunk/src/uitoolkit/widgets/button.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/button.lisp (original) +++ trunk/src/uitoolkit/widgets/button.lisp Mon Jun 26 18:28:49 2006 @@ -42,9 +42,9 @@ (defmethod compute-style-flags ((btn button) &rest extra-data) (declare (ignore extra-data)) - (let ((std-flags (logior gfs::+ws-child+ gfs::+ws-visible+)) + (let ((std-flags +default-child-style+) (style (style-of btn))) - (loop for sym in (style-of btn) + (loop for sym in style do (cond ;; primary button styles ;; Added: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- (empty file) +++ trunk/src/uitoolkit/widgets/edit.lisp Mon Jun 26 18:28:49 2006 @@ -0,0 +1,62 @@ +;;;; +;;;; edit.lisp +;;;; +;;;; Copyright (C) 2006, Jack D. Unrue +;;;; All rights reserved. +;;;; +;;;; Redistribution and use in source and binary forms, with or without +;;;; modification, are permitted provided that the following conditions +;;;; are met: +;;;; +;;;; 1. Redistributions of source code must retain the above copyright +;;;; notice, this list of conditions and the following disclaimer. +;;;; +;;;; 2. Redistributions in binary form must reproduce the above copyright +;;;; notice, this list of conditions and the following disclaimer in the +;;;; documentation and/or other materials provided with the distribution. +;;;; +;;;; 3. Neither the names of the authors nor the names of its contributors +;;;; may be used to endorse or promote products derived from this software +;;;; without specific prior written permission. +;;;; +;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY +;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS- +;;;; CLAIMED. IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY +;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; + +(in-package :graphic-forms.uitoolkit.widgets) + +;;; +;;; methods +;;; + +(defmethod compute-style-flags ((self edit) &rest extra-data) + (declare (ignore extra-data)) + (let ((border-flag (if (find :no-border (style-of self)) 0 gfs::+ws-border+))) + (values (loop for sym in (style-of self) + for std-flags = (logior +default-child-style+ border-flag) + then (logior std-flags + (ecase sym + ;; primary edit styles + ;; + (:multi-line (logior +default-child-style+ + gfs::+es-multiline+ + border-flag)) + + ;; styles that can be combined + ;; + (:auto-hscroll gfs::+es-autohscroll+) + (:auto-vscroll gfs::+es-autovscroll+) + (:mask-characters gfs::+es-password+) + (:no-hide-selection gfs::+es-nohidesel+) + (:read-only gfs::+es-readonly+) + (:want-return gfs::+es-wantreturn+))) + finally (return std-flags)) + 0))) Modified: trunk/src/uitoolkit/widgets/label.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/label.lisp (original) +++ trunk/src/uitoolkit/widgets/label.lisp Mon Jun 26 18:28:49 2006 @@ -94,8 +94,7 @@ (defmethod compute-style-flags ((label label) &rest extra-data) (if (> (count-if-not #'null extra-data) 1) (error 'gfs:toolkit-error :detail "only one of :image, :separator, or :text are allowed")) - (let ((std-style (logior gfs::+ws-child+ - gfs::+ws-visible+ + (let ((std-style (logior +default-child-style+ (cond ((first extra-data) (compute-image-style-flags (style-of label))) @@ -126,8 +125,7 @@ gfs::+ss-bitmap+ gfs::+ss-realsizeimage+ gfs::+ss-centerimage+ - gfs::+ws-child+ - gfs::+ws-visible+)) + +default-child-style+)) (tr-pnt (gfg:transparency-pixel-of image))) (if tr-pnt (let* ((color (gfg:background-color label)) @@ -206,8 +204,7 @@ (declare (ignore ex-flags)) (gfs::set-window-long hwnd gfs::+gwl-style+ (logior etch-flags std-flags - gfs::+ws-child+ - gfs::+ws-visible+)))) + +default-child-style+)))) (set-widget-text self str)) (defmethod text-baseline ((self label)) Modified: trunk/src/uitoolkit/widgets/panel.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/panel.lisp (original) +++ trunk/src/uitoolkit/widgets/panel.lisp Mon Jun 26 18:28:49 2006 @@ -55,7 +55,7 @@ (defmethod compute-style-flags ((self panel) &rest extra-data) (declare (ignore extra-data)) - (let ((std-flags (logior gfs::+ws-child+ gfs::+ws-visible+))) + (let ((std-flags +default-child-style+)) (mapc #'(lambda (sym) (cond ;; styles that can be combined Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Mon Jun 26 18:28:49 2006 @@ -118,6 +118,9 @@ (defclass button (control) () (:documentation "This class represents selectable controls that issue notifications when clicked.")) +(defclass edit (control) () + (:documentation "This class represents a control in which the user may enter and edit text.")) + (defclass label (control) () (:documentation "This class represents non-selectable controls that display a string or image.")) Modified: trunk/src/uitoolkit/widgets/widget-constants.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-constants.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-constants.lisp Mon Jun 26 18:28:49 2006 @@ -33,63 +33,66 @@ (in-package :graphic-forms.uitoolkit.widgets) -(defconstant +vk-break+ #x03) -(defconstant +vk-backspace+ #x08) -(defconstant +vk-tab+ #x09) -(defconstant +vk-clear+ #x0C) ; numpad-5 when numlock off -(defconstant +vk-return+ #x0D) -(defconstant +vk-shift+ #x10) -(defconstant +vk-control+ #x11) -(defconstant +vk-alt+ #x12) -(defconstant +vk-pause+ #x13) -(defconstant +vk-caps-lock+ #x14) -(defconstant +vk-escape+ #x1B) -(defconstant +vk-page-up+ #x21) -(defconstant +vk-page-down+ #x22) -(defconstant +vk-end+ #x23) -(defconstant +vk-home+ #x24) -(defconstant +vk-left+ #x25) -(defconstant +vk-up+ #x26) -(defconstant +vk-right+ #x27) -(defconstant +vk-down+ #x28) -(defconstant +vk-insert+ #x2D) -(defconstant +vk-delete+ #x2E) -(defconstant +vk-help+ #x2F) -(defconstant +vk-left-win+ #x5B) -(defconstant +vk-right-win+ #x5C) -(defconstant +vk-applications+ #x5D) -(defconstant +vk-numpad-0+ #x60) -(defconstant +vk-numpad-1+ #x61) -(defconstant +vk-numpad-2+ #x62) -(defconstant +vk-numpad-3+ #x63) -(defconstant +vk-numpad-4+ #x64) -(defconstant +vk-numpad-5+ #x65) -(defconstant +vk-numpad-6+ #x66) -(defconstant +vk-numpad-7+ #x67) -(defconstant +vk-numpad-8+ #x68) -(defconstant +vk-numpad-9+ #x69) -(defconstant +vk-numpad-*+ #x6A) -(defconstant +vk-numpad-++ #x6B) -(defconstant +vk-numpad--+ #x6D) -(defconstant +vk-numpad-.+ #x6E) -(defconstant +vk-numpad-/+ #x6F) -(defconstant +vk-numpad-f1+ #x70) -(defconstant +vk-numpad-f2+ #x71) -(defconstant +vk-numpad-f3+ #x72) -(defconstant +vk-numpad-f4+ #x73) -(defconstant +vk-numpad-f5+ #x74) -(defconstant +vk-numpad-f6+ #x75) -(defconstant +vk-numpad-f7+ #x76) -(defconstant +vk-numpad-f8+ #x77) -(defconstant +vk-numpad-f9+ #x78) -(defconstant +vk-numpad-f10+ #x79) -(defconstant +vk-numpad-f11+ #x7A) -(defconstant +vk-numpad-f12+ #x7B) -(defconstant +vk-num-lock+ #x90) -(defconstant +vk-scroll-lock+ #x91) -(defconstant +vk-left-shift+ #xA0) -(defconstant +vk-right-shift+ #xA1) -(defconstant +vk-left-control+ #xA2) -(defconstant +vk-right-control+ #xA3) -(defconstant +vk-left-alt+ #xA4) -(defconstant +vk-right-alt+ #xA5) +(defconstant +vk-break+ #x03) +(defconstant +vk-backspace+ #x08) +(defconstant +vk-tab+ #x09) +(defconstant +vk-clear+ #x0C) ; numpad-5 when numlock off +(defconstant +vk-return+ #x0D) +(defconstant +vk-shift+ #x10) +(defconstant +vk-control+ #x11) +(defconstant +vk-alt+ #x12) +(defconstant +vk-pause+ #x13) +(defconstant +vk-caps-lock+ #x14) +(defconstant +vk-escape+ #x1B) +(defconstant +vk-page-up+ #x21) +(defconstant +vk-page-down+ #x22) +(defconstant +vk-end+ #x23) +(defconstant +vk-home+ #x24) +(defconstant +vk-left+ #x25) +(defconstant +vk-up+ #x26) +(defconstant +vk-right+ #x27) +(defconstant +vk-down+ #x28) +(defconstant +vk-insert+ #x2D) +(defconstant +vk-delete+ #x2E) +(defconstant +vk-help+ #x2F) +(defconstant +vk-left-win+ #x5B) +(defconstant +vk-right-win+ #x5C) +(defconstant +vk-applications+ #x5D) +(defconstant +vk-numpad-0+ #x60) +(defconstant +vk-numpad-1+ #x61) +(defconstant +vk-numpad-2+ #x62) +(defconstant +vk-numpad-3+ #x63) +(defconstant +vk-numpad-4+ #x64) +(defconstant +vk-numpad-5+ #x65) +(defconstant +vk-numpad-6+ #x66) +(defconstant +vk-numpad-7+ #x67) +(defconstant +vk-numpad-8+ #x68) +(defconstant +vk-numpad-9+ #x69) +(defconstant +vk-numpad-*+ #x6A) +(defconstant +vk-numpad-++ #x6B) +(defconstant +vk-numpad--+ #x6D) +(defconstant +vk-numpad-.+ #x6E) +(defconstant +vk-numpad-/+ #x6F) +(defconstant +vk-numpad-f1+ #x70) +(defconstant +vk-numpad-f2+ #x71) +(defconstant +vk-numpad-f3+ #x72) +(defconstant +vk-numpad-f4+ #x73) +(defconstant +vk-numpad-f5+ #x74) +(defconstant +vk-numpad-f6+ #x75) +(defconstant +vk-numpad-f7+ #x76) +(defconstant +vk-numpad-f8+ #x77) +(defconstant +vk-numpad-f9+ #x78) +(defconstant +vk-numpad-f10+ #x79) +(defconstant +vk-numpad-f11+ #x7A) +(defconstant +vk-numpad-f12+ #x7B) +(defconstant +vk-num-lock+ #x90) +(defconstant +vk-scroll-lock+ #x91) +(defconstant +vk-left-shift+ #xA0) +(defconstant +vk-right-shift+ #xA1) +(defconstant +vk-left-control+ #xA2) +(defconstant +vk-right-control+ #xA3) +(defconstant +vk-left-alt+ #xA4) +(defconstant +vk-right-alt+ #xA5) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant +default-child-style+ (logior gfs::+ws-child+ gfs::+ws-visible+))) Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Mon Jun 26 18:28:49 2006 @@ -129,7 +129,7 @@ (defgeneric display-to-object (self pnt) (:documentation "Return a point that is the result of transforming the specified point from display-relative coordinates to this object's coordinate system.")) -(defgeneric echo-char (self) +(defgeneric echo-character (self) (:documentation "Returns the character that will be displayed when the user types text, or nil if no echo character has been set.")) (defgeneric enable (self flag)