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. +@end deffn + +@deffn GenericFunction focus-p self +Returns @sc{t} if @code{self} currently has keyboard focus; @sc{nil} +otherwise. +@end deffn + +@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 -@code{setf} function sets this value; if the new maximum size is +@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 -@ref{root-window}, but calling @ref{owner} may return @code{nil}. In +@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%7D, 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%7D, 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%7D
+@item Cells +@url{http://common-lisp.net/project/cells%7D + @item CFFI @url{http://common-lisp.net/project/cffi%7D
-@item lw-compat -@url{http://common-lisp.net/project/cl-containers/lw-compat/lw-compat_latest.tar.... - @item Closer to MOP @url{http://common-lisp.net/project/cl-containers/closer-mop/closer-mop_latest.ta...
@@ -75,6 +75,9 @@
@item lisp-unit @url{http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html... + +@item lw-compat +@url{http://common-lisp.net/project/cl-containers/lw-compat/lw-compat_latest.tar.... @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))