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)
