Author: junrue Date: Tue May 16 01:02:50 2006 New Revision: 132
Modified: trunk/src/uitoolkit/widgets/display.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/thread-context.lisp trunk/src/uitoolkit/widgets/window.lisp Log: simplified child visitor function management in preparation for refactoring visit-* functions into map-like functions
Modified: trunk/src/uitoolkit/widgets/display.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/display.lisp (original) +++ trunk/src/uitoolkit/widgets/display.lisp Tue May 16 01:02:50 2006 @@ -56,7 +56,7 @@
(defun visit-displays (func) ;; - ;; supplied closure should expect three parameters: + ;; supplied closure should expect two parameters: ;; display handle ;; flag data ;;
Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Tue May 16 01:02:50 2006 @@ -167,13 +167,6 @@ (warn 'gfs:toolkit-warning :detail "no object for hwnd"))) 0)
-#| -(defmethod process-message (hwnd (msg (eql gfs::+wm-initdialog+)) wparam lparam) - (declare (ignore hwnd lparam)) - (format t "WM_INITDIALOG: ~x~%" wparam) - 1) -|# - (defmethod process-message (hwnd (msg (eql gfs::+wm-initmenupopup+)) wparam lparam) (declare (ignore hwnd lparam)) (let* ((tc (thread-context))
Modified: trunk/src/uitoolkit/widgets/thread-context.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/thread-context.lisp (original) +++ trunk/src/uitoolkit/widgets/thread-context.lisp Tue May 16 01:02:50 2006 @@ -34,7 +34,7 @@ (in-package #:graphic-forms.uitoolkit.widgets)
(defclass thread-context () - ((child-visitor-stack :initform nil) + ((child-visitor-func :initform nil :accessor child-visitor-func) (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)) @@ -101,32 +101,22 @@ (setf (slot-value tc 'utility-hwnd) hwnd)))
(defmethod call-child-visitor-func ((tc thread-context) parent child) - "Call the closure at the top of the child window visitor function stack." - (let ((fn (first (slot-value tc 'child-visitor-stack)))) - (if (null fn) - (error 'gfs:toolkit-error :detail "child visitor function stack is empty")) - (funcall fn parent child))) - -(defmethod push-child-visitor-func ((tc thread-context) func) - "Push the supplied closure onto the child window visitor function stack." - (if (not (functionp func)) - (error 'gfs:toolkit-error :detail "function argument required")) - (push func (slot-value tc 'child-visitor-stack)) - nil) - -(defmethod pop-child-visitor-func ((tc thread-context)) - "Pop the top of the child window visitor function stack; returns the closure if the stack was not already empty." - (pop (slot-value tc 'child-visitor-stack))) + (let ((func (child-visitor-func tc))) + (if func + (funcall func parent child) + (warn 'gfs:toolkit-warning :detail "child visitor function is nil"))))
(defmethod call-display-visitor-func ((tc thread-context) hmonitor data) (let ((func (display-visitor-func tc))) - (unless (null func) - (funcall func hmonitor data)))) + (if func + (funcall func hmonitor data) + (warn 'gfs:toolkit-warning :detail "display visitor function is nil"))))
(defmethod call-top-level-visitor-func ((tc thread-context) win) (let ((func (top-level-visitor-func tc))) - (unless (null func) - (funcall func win)))) + (if func + (funcall func win) + (warn 'gfs:toolkit-warning :detail "top-level visitor function is nil"))))
(defmethod get-widget ((tc thread-context) hwnd) "Return the widget object corresponding to the specified native window handle."
Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Tue May 16 01:02:50 2006 @@ -87,7 +87,7 @@ ;; current child widget ;; (let ((tc (thread-context))) - (push-child-visitor-func tc func) + (setf (child-visitor-func tc) func) (unwind-protect #+lispworks (gfs::enum-child-windows (fli:make-pointer :address (cffi:pointer-address (gfs:handle win))) (fli:make-pointer :symbol-name "child_window_visitor") @@ -100,7 +100,7 @@ (gfs::enum-child-windows ptr #'child_window_visitor (cffi:pointer-address (gfs:handle win)))) - (pop-child-visitor-func tc))) + (setf (child-visitor-func tc) nil))) nil)
(defun register-window-class (class-name proc-ptr style bkgcolor &optional wndextra)