Author: junrue Date: Thu May 11 23:20:03 2006 New Revision: 127 Modified: trunk/docs/manual/api.texinfo trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/button.lisp trunk/src/uitoolkit/widgets/dialog.lisp trunk/src/uitoolkit/widgets/display.lisp trunk/src/uitoolkit/widgets/file-dialog.lisp trunk/src/uitoolkit/widgets/label.lisp trunk/src/uitoolkit/widgets/panel.lisp trunk/src/uitoolkit/widgets/thread-context.lisp trunk/src/uitoolkit/widgets/top-level.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget.lisp trunk/src/uitoolkit/widgets/window.lisp Log: refactored compute-style-flags GF and implementations; added utility function for traversing top-level windows owned by UI thread Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Thu May 11 23:20:03 2006 @@ -189,10 +189,36 @@ @anchor{dialog} @deftp Class dialog This is the base class for system and application-defined dialogs. A -dialog is a windowed UI component that is @emph{typically} defined to -remain on top of the primary application window(s). Of course, some +dialog is a windowed UI component, usually containing at least one +@ref{panel} or @ref{control}, that remains on top of application +@ref{window}(s). Dialogs typically serve to collect additional +information from the user in a specific context. Note that some applications are entirely dialog-based. This class derives from -@ref{window}. +@ref{window}.@*@* A @emph{modal} dialog constrains the user to respond +to it, whereas a @emph{modeless} dialog allows continued interaction +with other windows. +@deffn Initarg :owner +Specifies the @ref{owner} of the dialog. +@end deffn +@deffn Initarg :style +@table @code +@item :application-modal +Specifies that the dialog is @emph{modal} with respect to all +@ref{top-level} windows and @ref{dialog}s created by the application +(specifically those created by the calling thread which are still +realized on-screen). +@item :modeless +Specifies that the dialog is @emph{modeless}, meaning that while the +dialog floats on top of all application-created windows, the user may +still interact with other windows and dialogs. +@item :owner-modal +Specifies that the dialog is @emph{modal} only in terms of its +@ref{owner} window or dialog. +@end table +@end deffn +@deffn Initarg :text +Specifies the dialog's title. +@end deffn @end deftp @anchor{display} @@ -485,19 +511,19 @@ @end deftp @anchor{widget} -@deftp Class widget +@deftp Class widget style The widget class is the base class for all windowed user interface objects. It -derives from @ref{event-source}. +derives from @ref{event-source}. The @code{style} slot is a list of keyword +symbols supplying additional information about the desired look-and-feel or +behavior of the widget; style keywords are widget-specific. @end deftp -@anchor{widget-with-items} +@anchor{widget-with-items} items @deftp Class widget-with-items -The widget-with-items class is the base class for objects composed of sub-items. -It derives from @ref{widget}. -@deffn Initarg :items -@end deffn -@deffn Accessor items -@end deffn +The widget-with-items class is the base class for objects composed of +sub-items. It derives from @ref{widget}. The @code{items} slot is an +@sc{adjustable} @sc{vector} containing @ref{item} objects, +representing sub-elements of the widget. @end deftp @anchor{window} @@ -583,20 +609,11 @@ @ref{control}s. Accelerator keys are also translated by this function. Returns @sc{nil} so that @ref{message-loop} will continue, unless @code{gm-code} is less than or equal to zero, in which case -@sc{t} is returned so that @ref{message-loop} will -exit. @code{gm-code} is zero when @code{msg-ptr} identifies a -@sc{WM_QUIT} message indicating normal shutdown. If @code{gm-code} is --1, then the system has indicated an error during message retrieval -that should be reported, followed by an orderly -shutdown. @xref{dialog-message-filter}. -@end deffn - -@anchor{dialog-message-filter} -@deffn Function dialog-message-filter gm-code msg-ptr -This function is similar to @ref{default-message-filter}, except that -it is intended to be called from a nested @code{message-loop} -invocation, usually on behalf of a modal @ref{dialog}. In this case, -the function returns @sc{nil} as long as the dialog continues to live. +@sc{t} is returned so that @ref{message-loop} will exit. When +@code{gm-code} is zero, @code{msg-ptr} identifies a @sc{WM_QUIT} +message indicating normal shutdown. If @code{gm-code} is -1, then the +system has reported an error during message retrieval which should be +handled by (hopefully) graceful shutdown. @end deffn @deffn GenericFunction event-activate dispatcher widget time @@ -683,12 +700,8 @@ continues or returns, and this termination condition depends on the context of the message loop being executed. The return value is @sc{nil} if @code{message-loop} should continue, or not @sc{nil} if -the loop should exit. Two pre-defined implementations of message -filter functions are provided: -@itemize @bullet -@item @ref{default-message-filter} -@item @ref{dialog-message-filter} -@end itemize +the loop should exit. The pre-defined implementation +@ref{default-message-filter} is provided. @end deffn @@ -752,10 +765,10 @@ be drawn within or can display data. @end deffn -@deffn GenericFunction compute-style-flags self &rest style -Convert a list of keyword symbols to a pair of native bitmasks; the -first conveys normal/standard flags, whereas the second any extended -flags that the system supports. +@deffn GenericFunction compute-style-flags self &rest extra-data +Convert a list of keyword symbols in the object's @code{style} slot to +a values pair of native bitmasks; the first conveys normal/standard +flags, whereas the second any extended flags that the system supports. @end deffn @deffn GenericFunction compute-outer-size self desired-client-size Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Thu May 11 23:20:03 2006 @@ -236,6 +236,42 @@ (data ffi:c-pointer)) (:return-type ffi:int)) +;;; FIXME: uncomment this when CFFI callbacks can +;;; be tagged as stdcall or cdecl (only the latter +;;; is supported as of 0.9.0) +;;; +#| +(defcfun + ("EnumThreadWindows" enum-thread-windows) + BOOL + (threadid DWORD) + (func :pointer) + (lparam LPARAM)) +|# + +#+lispworks +(fli:define-foreign-function + (enum-thread-windows "EnumThreadWindows") + ((threadid (:unsigned :long)) + (func :pointer) + (lparam :long)) + :result-type :int) + +#+clisp +(ffi:def-call-out enum-thread-windows + (:name "EnumThreadWindows") + (:library "user32.dll") + (:language :stdc) + (:arguments (threadid ffi:ulong) + (func (ffi:c-function + (:arguments + (hwnd ffi:c-pointer) + (lparam ffi:long)) + (:return-type ffi:int) + (:language :stdc-stdcall))) + (lparam ffi:long)) + (:return-type ffi:int)) + (defcfun ("GetAncestor" get-ancestor) HANDLE @@ -382,6 +418,12 @@ (max INT)) (defcfun + ("GetWindowThreadProcessId" get-window-thread-process-id) + DWORD + (hwnd HANDLE) + (pid LPTR)) + +(defcfun ("InsertMenuItemA" insert-menu-item) BOOL (hmenu HANDLE) Modified: trunk/src/uitoolkit/widgets/button.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/button.lisp (original) +++ trunk/src/uitoolkit/widgets/button.lisp Thu May 11 23:20:03 2006 @@ -37,14 +37,13 @@ ;;; methods ;;; -(defmethod compute-style-flags ((btn button) style &rest extra-data) +(defmethod compute-style-flags ((btn button) &rest extra-data) (declare (ignore extra-data)) (let ((std-flags (logior gfs::+ws-child+ gfs::+ws-visible+))) - (setf style (gfs:flatten style)) ;; FIXME: check whether any of the primary button ;; styles were specified, default to :push-button ;; - (loop for sym in style + (loop for sym in (style-of btn) do (cond ;; primary button styles ;; @@ -60,11 +59,9 @@ (setf std-flags (logior std-flags gfs::+bs-pushbox+))))) (values std-flags 0))) -(defmethod initialize-instance :after ((btn button) &key parent style &allow-other-keys) - (if (not (listp style)) - (setf style (list style))) +(defmethod initialize-instance :after ((btn button) &key parent &allow-other-keys) (multiple-value-bind (std-style ex-style) - (compute-style-flags btn style) + (compute-style-flags btn) (let ((hwnd (create-window gfs::+button-classname+ " " (gfs:handle parent) Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Thu May 11 23:20:03 2006 @@ -54,8 +54,8 @@ (defmethod gfg:background-color ((dlg dialog)) (gfg:rgb->color (gfs::get-sys-color gfs::+color-btnface+))) -(defmethod compute-style-flags ((dlg dialog) style &rest extra-data) - (declare (ignore style extra-data)) +(defmethod compute-style-flags ((dlg dialog) &rest extra-data) + (declare (ignore extra-data)) (values (logior gfs::+ws-caption+ gfs::+ws-popup+ gfs::+ws-sysmenu+) (logior gfs::+ws-ex-dlgmodalframe+ gfs::+ws-ex-windowedge+))) @@ -63,10 +63,10 @@ (declare (ignore time)) (show dlg nil)) -(defmethod initialize-instance :after ((dlg dialog) &key owner style title &allow-other-keys) +(defmethod initialize-instance :after ((dlg dialog) &key owner text &allow-other-keys) (unless (null owner) (if (gfs:disposed-p owner) (error 'gfs:disposed-error))) - (if (null title) - (setf title +default-dialog-title+)) - (init-window dlg +dialog-classname+ #'register-dialog-class style owner title)) + (if (null text) + (setf text +default-dialog-title+)) + (init-window dlg +dialog-classname+ #'register-dialog-class owner text)) Modified: trunk/src/uitoolkit/widgets/display.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/display.lisp (original) +++ trunk/src/uitoolkit/widgets/display.lisp Thu May 11 23:20:03 2006 @@ -83,6 +83,43 @@ (defun obtain-primary-display () (find-if #'primary-p (obtain-displays))) +#+lispworks +(fli:define-foreign-callable + ("top_level_window_visitor" :result-type :integer :calling-convention :stdcall) + ((hwnd :pointer) + (lparam :long)) + (let* ((tc (thread-context)) + (win (get-widget tc hwnd))) + (unless (null win) + (call-top-level-visitor-func tc win))) + 1) + +#+clisp +(defun top_level_window_visitor (hwnd lparam) + (declare (ignore lparam)) + (let* ((tc (thread-context)) + (win (get-widget tc hwnd))) + (unless (null win) + (call-top-level-visitor-func tc win))) + 1) + +(defun visit-top-level-windows (func) + ;; + ;; supplied closure should expect one parameter: + ;; top-level window + ;; + (let ((tc (thread-context))) + (setf (top-level-visitor-func tc) func) + (unwind-protect +#+lispworks (gfs::enum-thread-windows (gfs::get-window-thread-process-id (utility-hwnd tc) (cffi:null-pointer)) + (fli:make-pointer :symbol-name "top_level_window_visitor") + 0) +#+clisp (gfs::enum-child-windows (gfs::get-window-thread-process-id (utility-hwnd tc) (cffi:null-pointer)) + #'top_level_window_visitor + 0) + (setf (top-level-visitor-func tc) nil))) + nil) + ;;; ;;; methods ;;; Modified: trunk/src/uitoolkit/widgets/file-dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/file-dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/file-dialog.lisp Thu May 11 23:20:03 2006 @@ -74,12 +74,12 @@ ;;; methods ;;; -(defmethod compute-style-flags ((dlg file-dialog) style &rest extra-data) +(defmethod compute-style-flags ((dlg file-dialog) &rest extra-data) (declare (ignore extra-data)) (let ((std-flags (logior gfs::+ofn-dontaddtorecent+ gfs::+ofn-hidereadonly+ gfs::+ofn-notestfilecreate+ gfs::+ofn-overwriteprompt+ gfs::+ofn-explorer+))) - (loop for sym in style + (loop for sym in (style-of dlg) do (cond ((eq sym :add-to-recent) (setf std-flags (logand std-flags (lognot gfs::+ofn-dontaddtorecent+)))) @@ -137,7 +137,7 @@ (gfs::strncpy file-buffer tmp-str 1023)) (setf (cffi:mem-ref file-buffer :char) 0)) (multiple-value-bind (std-style ex-style) - (compute-style-flags dlg style) + (compute-style-flags dlg) (cffi:with-foreign-slots ((gfs::ofnsize gfs::ofnhwnd gfs::ofnhinst gfs::ofnfilter gfs::ofncustomfilter gfs::ofnmaxcustfilter gfs::ofnfilterindex gfs::ofnfile gfs::ofnmaxfile gfs::ofnfiletitle gfs::ofnmaxfiletitle Modified: trunk/src/uitoolkit/widgets/label.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/label.lisp (original) +++ trunk/src/uitoolkit/widgets/label.lisp Thu May 11 23:20:03 2006 @@ -91,19 +91,20 @@ (setf (gfg:transparency-pixel-of image) pnt)) (setf (image label) image)))) -(defmethod compute-style-flags ((label label) style &rest extra-data) - (declare (ignore label)) +(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+ (cond ((first extra-data) - (compute-image-style-flags (gfs:flatten style))) + (compute-image-style-flags (style-of label))) ((second extra-data) - (if (find :vertical style) gfs::+ss-etchedvert+ gfs::+ss-etchedhorz+)) + (if (find :vertical (style-of label)) + gfs::+ss-etchedvert+ + gfs::+ss-etchedhorz+)) (t - (compute-text-style-flags (gfs:flatten style))))))) + (compute-text-style-flags (style-of label))))))) (values std-style 0))) (defmethod image ((label label)) @@ -152,11 +153,9 @@ gfs::+image-bitmap+ (cffi:pointer-address (gfs:handle image))))) -(defmethod initialize-instance :after ((label label) &key image parent separator style text &allow-other-keys) - (if (not (listp style)) - (setf style (list style))) +(defmethod initialize-instance :after ((label label) &key image parent separator text &allow-other-keys) (multiple-value-bind (std-style ex-style) - (compute-style-flags label style image separator text) + (compute-style-flags label image separator text) (let ((hwnd (create-window gfs::+static-classname+ (or text " ") (gfs:handle parent) @@ -201,7 +200,7 @@ (etch-flags (logior (logand orig-flags gfs::+ss-etchedframe+) (logand orig-flags gfs::+ss-sunken+)))) (multiple-value-bind (std-flags ex-flags) - (compute-style-flags label nil nil nil str) + (compute-style-flags label nil nil str) (declare (ignore ex-flags)) (gfs::set-window-long hwnd gfs::+gwl-style+ (logior etch-flags std-flags Modified: trunk/src/uitoolkit/widgets/panel.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/panel.lisp (original) +++ trunk/src/uitoolkit/widgets/panel.lisp Thu May 11 23:20:03 2006 @@ -49,24 +49,21 @@ ;;; methods ;;; -(defmethod compute-style-flags ((self panel) style &rest extra-data) +(defmethod compute-style-flags ((self panel) &rest extra-data) (declare (ignore extra-data)) - (let ((std-flags (logior gfs::+ws-child+ gfs::+ws-visible+)) - (ex-flags 0)) + (let ((std-flags (logior gfs::+ws-child+ gfs::+ws-visible+))) (mapc #'(lambda (sym) (cond ;; styles that can be combined ;; ((eq sym :border) (setf std-flags (logior std-flags gfs::+ws-border+))))) - (gfs:flatten style)) - (values std-flags ex-flags))) + (style-of self)) + (values std-flags 0))) -(defmethod initialize-instance :after ((self panel) &key parent style &allow-other-keys) +(defmethod initialize-instance :after ((self panel) &key parent &allow-other-keys) (if (null parent) (error 'gfs:toolkit-error :detail "parent is required for panel")) (if (gfs:disposed-p parent) (error 'gfs:disposed-error)) - (if (not (listp style)) - (setf style (list style))) - (init-window self +panel-window-classname+ #'register-panel-window-class style parent "")) + (init-window self +panel-window-classname+ #'register-panel-window-class parent "")) Modified: trunk/src/uitoolkit/widgets/thread-context.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/thread-context.lisp (original) +++ trunk/src/uitoolkit/widgets/thread-context.lisp Thu May 11 23:20:03 2006 @@ -34,23 +34,24 @@ (in-package #:graphic-forms.uitoolkit.widgets) (defclass thread-context () - ((child-visitor-stack :initform nil) - (display-visitor-func :initform nil :accessor display-visitor-func) - (image-loaders-by-type :initform (make-hash-table :test #'equal)) - (job-table :initform (make-hash-table :test #'equal)) - (job-table-lock :initform nil) - (event-time :initform 0 :accessor event-time) - (virtual-key :initform 0 :accessor virtual-key) - (menuitems-by-id :initform (make-hash-table :test #'equal)) - (mouse-event-pnt :initform (gfs:make-point) :accessor mouse-event-pnt) - (move-event-pnt :initform (gfs:make-point) :accessor move-event-pnt) - (next-menuitem-id :initform 10000 :reader next-menuitem-id) - (next-timer-id :initform 1 :reader next-timer-id) - (size-event-size :initform (gfs:make-size) :accessor size-event-size) - (widgets-by-hwnd :initform (make-hash-table :test #'equal)) - (timers-by-id :initform (make-hash-table :test #'equal)) - (utility-hwnd :initform (cffi:null-pointer) :accessor utility-hwnd) - (wip :initform nil)) + ((child-visitor-stack :initform nil) + (display-visitor-func :initform nil :accessor display-visitor-func) + (image-loaders-by-type :initform (make-hash-table :test #'equal)) + (job-table :initform (make-hash-table :test #'equal)) + (job-table-lock :initform nil) + (event-time :initform 0 :accessor event-time) + (virtual-key :initform 0 :accessor virtual-key) + (menuitems-by-id :initform (make-hash-table :test #'equal)) + (mouse-event-pnt :initform (gfs:make-point) :accessor mouse-event-pnt) + (move-event-pnt :initform (gfs:make-point) :accessor move-event-pnt) + (next-menuitem-id :initform 10000 :reader next-menuitem-id) + (next-timer-id :initform 1 :reader next-timer-id) + (size-event-size :initform (gfs:make-size) :accessor size-event-size) + (widgets-by-hwnd :initform (make-hash-table :test #'equal)) + (timers-by-id :initform (make-hash-table :test #'equal)) + (top-level-visitor-func :initform nil :accessor top-level-visitor-func) + (utility-hwnd :initform (cffi:null-pointer) :accessor utility-hwnd) + (wip :initform nil)) (:documentation "Thread context objects maintain 'global' data for each thread possessing an event loop.")) ;; TODO: change this when CLISP acquires MT support @@ -122,6 +123,11 @@ (unless (null func) (funcall func hmonitor data)))) +(defmethod call-top-level-visitor-func ((tc thread-context) win) + (let ((func (top-level-visitor-func tc))) + (unless (null func) + (funcall func win)))) + (defmethod get-widget ((tc thread-context) hwnd) "Return the widget object corresponding to the specified native window handle." (let ((tmp-widget (slot-value tc 'wip))) Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Thu May 11 23:20:03 2006 @@ -60,7 +60,7 @@ ;;; methods ;;; -(defmethod compute-style-flags ((win top-level) style &rest extra-data) +(defmethod compute-style-flags ((win top-level) &rest extra-data) (declare (ignore extra-data)) (let ((std-flags 0) (ex-flags 0)) @@ -114,7 +114,7 @@ gfs::+ws-clipsiblings+ gfs::+ws-clipchildren+)) (setf ex-flags 0)))) - (gfs:flatten style)) + (style-of win)) (values std-flags ex-flags))) (defmethod gfs:dispose ((win top-level)) @@ -124,20 +124,18 @@ (remove-widget (thread-context) (gfs:handle m)))) (call-next-method)) -(defmethod initialize-instance :after ((win top-level) &key owner style title &allow-other-keys) +(defmethod initialize-instance :after ((win top-level) &key owner title &allow-other-keys) (unless (null owner) (if (gfs:disposed-p owner) (error 'gfs:disposed-error))) (if (null title) (setf title +default-window-title+)) - (if (not (listp style)) - (setf style (list style))) (let ((classname +toplevel-noerasebkgnd-window-classname+) (register-func #'register-toplevel-noerasebkgnd-window-class)) - (when (find :workspace style) + (when (find :workspace (style-of win)) (setf classname +toplevel-erasebkgnd-window-classname+) (setf register-func #'register-toplevel-erasebkgnd-window-class)) - (init-window win classname register-func style owner title))) + (init-window win classname register-func owner title))) (defmethod menu-bar :before ((win top-level)) (if (gfs:disposed-p win) Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Thu May 11 23:20:03 2006 @@ -59,7 +59,11 @@ (defclass menu-item (item) () (:documentation "A subtype of item representing a menu item.")) -(defclass widget (event-source) () +(defclass widget (event-source) + ((style + :reader style-of + :initarg :style + :initform nil)) (:documentation "The widget class is the base class for all windowed user interface objects.")) (defclass caret (widget) () Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Thu May 11 23:20:03 2006 @@ -105,7 +105,7 @@ (defgeneric columns (self) (:documentation "Returns the column objects displayed by the object.")) -(defgeneric compute-style-flags (self style &rest extra-data) +(defgeneric compute-style-flags (self &rest extra-data) (:documentation "Convert a list of keyword symbols to a pair of native bitmasks; the first conveys normal/standard flags, whereas the second any extended flags that the system supports.")) (defgeneric compute-outer-size (self desired-client-size) Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Thu May 11 23:20:03 2006 @@ -167,6 +167,9 @@ (defmethod enabled-p ((w widget)) (not (zerop (gfs::is-window-enabled (gfs:handle w))))) +(defmethod initialize-instance :after ((w widget) &key style &allow-other-keys) + (setf (slot-value w 'style) (if (listp style) style (list style)))) + (defmethod location :before ((w widget)) (if (gfs:disposed-p w) (error 'gfs:disposed-error))) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Thu May 11 23:20:03 2006 @@ -42,12 +42,12 @@ ;;; helper functions ;;; -(defun init-window (win classname register-class-fn style parent text) +(defun init-window (win classname register-class-fn parent text) (let ((tc (thread-context))) (setf (widget-in-progress tc) win) (funcall register-class-fn) (multiple-value-bind (std-style ex-style) - (compute-style-flags win style) + (compute-style-flags win) (create-window classname text (if (null parent) (cffi:null-pointer) (gfs:handle parent)) @@ -75,7 +75,7 @@ (defun child_window_visitor (hwnd lparam) (let* ((tc (thread-context)) (child (get-widget tc hwnd)) - (parent (get-widget tc (cffi:make-pointer lparam)))) + (parent (get-widget tc (cffi:make-pointer lparam)))) (unless (or (null child) (null parent)) (call-child-visitor-func tc parent child))) 1)