[graphic-forms-cvs] r106 - in trunk: docs/manual src/uitoolkit/system src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Wed Apr 26 01:24:17 UTC 2006
Author: junrue
Date: Tue Apr 25 21:24:16 2006
New Revision: 106
Modified:
trunk/docs/manual/api.texinfo
trunk/docs/manual/overview.texinfo
trunk/src/uitoolkit/system/user32.lisp
trunk/src/uitoolkit/widgets/control.lisp
trunk/src/uitoolkit/widgets/dialog.lisp
trunk/src/uitoolkit/widgets/event.lisp
trunk/src/uitoolkit/widgets/window.lisp
Log:
implemented focus-p and give-focus methods for widgets; enabled repeated event delivery for virtual keys; some other miscellaneous doc cleanup
Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo (original)
+++ trunk/docs/manual/api.texinfo Tue Apr 25 21:24:16 2006
@@ -674,7 +674,16 @@
@end deffn
@deffn GenericFunction enabled-p self
-Returns T if the object is enabled; nil otherwise.
+Returns @sc{t} if @code{self} is enabled; @sc{nil} otherwise.
+ at end deffn
+
+ at deffn GenericFunction focus-p self
+Returns @sc{t} if @code{self} currently has keyboard focus; @sc{nil}
+otherwise.
+ at end deffn
+
+ at deffn GenericFunction give-focus self
+Places keyboard focus on @code{self}.
@end deffn
@deffn GenericFunction item-index self item
@@ -694,9 +703,9 @@
@anchor{maximum-size}
@deffn GenericFunction maximum-size self
Returns a @ref{size} object describing the largest dimensions to which
-the user may resize this widget; by default returns @code{nil},
+the user may resize this widget; by default returns @sc{nil},
indicating that there is effectively no constraint. The corresponding
- at code{setf} function sets this value; if the new maximum size is
+ at sc{setf} function sets this value; if the new maximum size is
smaller than the current size, the widget is resized to the new
maximum. @xref{minimum-size}.
@end deffn
@@ -708,9 +717,9 @@
@anchor{minimum-size}
@deffn GenericFunction minimum-size self
Returns a @ref{size} object describing the smallest dimensions to
-which the user may resize this widget; by default returns @code{nil},
+which the user may resize this widget; by default returns @sc{nil},
indicating that the minimum constraint is determined by the windowing
-system's configuration. The corresponding @code{setf} function sets
+system's configuration. The corresponding @sc{setf} function sets
this value; if the new minimum size is larger than the current size,
the widget is resized to the new minimum. @xref{maximum-size}.
@end deffn
@@ -741,7 +750,7 @@
@ref{top-level}s and dialogs. And it is possible for a window to be
unowned but still have a @ref{parent}. Consequently, calling
@ref{parent} on a @ref{top-level} will return an instance of
- at ref{root-window}, but calling @ref{owner} may return @code{nil}. In
+ at ref{root-window}, but calling @ref{owner} may return @sc{nil}. In
a reply to an entry at
@url{http://blogs.msdn.com/oldnewthing/archive/2004/02/24/79212.aspx},
Raymond Chen says:
@@ -766,7 +775,7 @@
@ref{top-level} window. In the case of a dialog or @ref{top-level},
then a @ref{root-window} is returned. In the case of a @code{submenu},
this will be the @ref{menu}'s ancestor in the hierarchy; but for a
-menubar or context @ref{menu}, @code{parent} returns @code{nil}. In a
+menubar or context @ref{menu}, @code{parent} returns @sc{nil}. In a
reply to an entry at
@url{http://blogs.msdn.com/oldnewthing/archive/2004/02/24/79212.aspx},
Raymond Chen says:
@@ -1007,7 +1016,7 @@
The default pen style is equivalent to @code{(:flat :square-endcap
:round-bevel)}.
-Specifying @code{nil} for @code{pen-style} equates to selecting the
+Specifying @sc{nil} for @code{pen-style} equates to selecting the
Win32 @sc{PS_NULL} pen style, meaning that the pen is invisible.
@end deffn
@anchor{pen-width}
Modified: trunk/docs/manual/overview.texinfo
==============================================================================
--- trunk/docs/manual/overview.texinfo (original)
+++ trunk/docs/manual/overview.texinfo Tue Apr 25 21:24:16 2006
@@ -61,12 +61,12 @@
@item ASDF
@url{http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf}
+ at item Cells
+ at url{http://common-lisp.net/project/cells}
+
@item CFFI
@url{http://common-lisp.net/project/cffi}
- at item lw-compat
- at url{http://common-lisp.net/project/cl-containers/lw-compat/lw-compat_latest.tar.gz}
-
@item Closer to MOP
@url{http://common-lisp.net/project/cl-containers/closer-mop/closer-mop_latest.tar.gz}
@@ -75,6 +75,9 @@
@item lisp-unit
@url{http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html}
+
+ at item lw-compat
+ at url{http://common-lisp.net/project/cl-containers/lw-compat/lw-compat_latest.tar.gz}
@end table
Modified: trunk/src/uitoolkit/system/user32.lisp
==============================================================================
--- trunk/src/uitoolkit/system/user32.lisp (original)
+++ trunk/src/uitoolkit/system/user32.lisp Tue Apr 25 21:24:16 2006
@@ -274,6 +274,10 @@
HANDLE)
(defcfun
+ ("GetFocus" get-focus)
+ HANDLE)
+
+(defcfun
("GetKeyState" get-key-state)
SHORT
(virtkey INT))
@@ -470,6 +474,11 @@
(lparam WPARAM))
(defcfun
+ ("SetFocus" set-focus)
+ HANDLE
+ (hwnd HANDLE))
+
+(defcfun
("SetMenu" set-menu)
BOOL
(hwnd HANDLE)
Modified: trunk/src/uitoolkit/widgets/control.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/control.lisp (original)
+++ trunk/src/uitoolkit/widgets/control.lisp Tue Apr 25 21:24:16 2006
@@ -61,6 +61,22 @@
(declare (ignore ctrl))
(gfg:rgb->color (gfs::get-sys-color gfs::+color-btnface+)))
+(defmethod focus-p :before ((ctrl control))
+ (if (gfs:disposed-p ctrl)
+ (error 'gfs:disposed-error)))
+
+(defmethod focus-p ((ctrl control))
+ (let ((focus-hwnd (gfs::get-focus)))
+ (and (not (gfs:null-handle-p focus-hwnd)) (cffi:pointer-eq focus-hwnd (gfs:handle ctrl)))))
+
+(defmethod give-focus :before ((ctrl control))
+ (if (gfs:disposed-p ctrl)
+ (error 'gfs:disposed-error)))
+
+(defmethod give-focus ((ctrl control))
+ (if (gfs:null-handle-p (gfs::set-focus (gfs:handle ctrl)))
+ (error 'gfs:toolkit-error "set-focus failed")))
+
(defmethod initialize-instance :after ((ctrl control) &key parent &allow-other-keys)
(if (gfs:disposed-p parent)
(error 'gfs:disposed-error)))
Modified: trunk/src/uitoolkit/widgets/dialog.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/dialog.lisp (original)
+++ trunk/src/uitoolkit/widgets/dialog.lisp Tue Apr 25 21:24:16 2006
@@ -37,6 +37,22 @@
;;; methods
;;;
+(defmethod focus-p :before ((dlg dialog))
+ (if (gfs:disposed-p dlg)
+ (error 'gfs:disposed-error)))
+
+(defmethod focus-p ((dlg dialog))
+ (let ((focus-hwnd (gfs::get-focus)))
+ (and (not (gfs:null-handle-p focus-hwnd)) (cffi:pointer-eq focus-hwnd (gfs:handle dlg)))))
+
+(defmethod give-focus :before ((dlg dialog))
+ (if (gfs:disposed-p dlg)
+ (error 'gfs:disposed-error)))
+
+(defmethod give-focus ((dlg dialog))
+ (if (gfs:null-handle-p (gfs::set-focus (gfs:handle dlg)))
+ (error 'gfs:toolkit-error "set-focus failed")))
+
(defmethod print-object ((self dialog) stream)
(print-unreadable-object (self stream :type t)
(format stream "handle: ~x " (gfs:handle self))
Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp (original)
+++ trunk/src/uitoolkit/widgets/event.lisp Tue Apr 25 21:24:16 2006
@@ -209,12 +209,13 @@
0)
(defmethod process-message (hwnd (msg (eql gfs::+wm-keydown+)) wparam lparam)
+ (declare (ignore lparam))
(let* ((tc (thread-context))
(wparam-lo (lo-word wparam))
(ch (gfs::map-virtual-key wparam-lo 2))
(w (get-widget tc hwnd)))
(setf (virtual-key tc) wparam-lo)
- (when (and w (= ch 0) (= (logand lparam #x40000000) 0))
+ (when (and w (= ch 0))
(event-key-down (dispatcher w) w (event-time tc) wparam-lo (code-char ch))))
0)
Modified: trunk/src/uitoolkit/widgets/window.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/window.lisp (original)
+++ trunk/src/uitoolkit/widgets/window.lisp Tue Apr 25 21:24:16 2006
@@ -183,6 +183,22 @@
(let ((sz (client-size win)))
(perform-layout win (gfs:size-width sz) (gfs:size-height sz))))
+(defmethod focus-p :before ((win window))
+ (if (gfs:disposed-p win)
+ (error 'gfs:disposed-error)))
+
+(defmethod focus-p ((win window))
+ (let ((focus-hwnd (gfs::get-focus)))
+ (and (not (gfs:null-handle-p focus-hwnd)) (cffi:pointer-eq focus-hwnd (gfs:handle win)))))
+
+(defmethod give-focus :before ((win window))
+ (if (gfs:disposed-p win)
+ (error 'gfs:disposed-error)))
+
+(defmethod give-focus ((win window))
+ (if (gfs:null-handle-p (gfs::set-focus (gfs:handle win)))
+ (error 'gfs:toolkit-error "set-focus failed")))
+
(defmethod location ((win window))
(if (gfs:disposed-p win)
(error 'gfs:disposed-error))
More information about the Graphic-forms-cvs
mailing list