Author: junrue Date: Wed Jun 28 17:44:07 2006 New Revision: 167

Modified: trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/widgets/event.lisp Log: introduced infrastructure for dispatching control notifications, and used this to implement event-focus-gain/event-focus-loss and event-modify for edit controls

Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Wed Jun 28 17:44:07 2006 @@ -126,6 +126,23 @@ (call-next-method) (gfs:dispose dlg))

+(defclass edit-control-events (gfw:event-dispatcher) ()) + +(defun truncate-text (str) + (subseq str 0 (min (length str) 5))) + +(defmethod gfw:event-focus-gain ((disp edit-control-events) (ctrl gfw:edit) time) + (declare (ignore time)) + (format t "gained focus: ~a...~%" (truncate-text (gfw:text ctrl)))) + +(defmethod gfw:event-focus-loss ((disp edit-control-events) (ctrl gfw:edit) time) + (declare (ignore time)) + (format t "lost focus: ~a...~%" (truncate-text (gfw:text ctrl)))) + +(defmethod gfw:event-modify ((disp edit-control-events) (ctrl gfw:edit) time) + (declare (ignore time)) + (format t "modified: ~a...~%" (truncate-text (gfw:text ctrl)))) + (defun open-dlg (title style) (let* ((dlg (make-instance 'gfw:dialog :owner *main-win* :dispatcher (make-instance 'dialog-events) @@ -135,6 +152,7 @@ :style '(:horizontal)) :style style :text title)) + (edit-disp (make-instance 'edit-control-events)) (left-panel (make-instance 'gfw:panel :layout (make-instance 'gfw:flow-layout :spacing 4 @@ -145,6 +163,7 @@ :parent left-panel)) (name-edit (make-instance 'gfw:edit :text "WWWWWWWWWWWWWWWWWWWWWWWW" + :dispatcher edit-disp :parent left-panel)) (serial-label (make-instance 'gfw:label :text "Serial Number:" @@ -152,6 +171,7 @@ (serial-edit (make-instance 'gfw:edit :style '(:read-only) :text "323K DSKL3 DSKE23" + :dispatcher edit-disp :parent left-panel)) (pw-label (make-instance 'gfw:label :text "Password:" @@ -159,6 +179,7 @@ (pw-edit (make-instance 'gfw:edit :style '(:mask-characters) :text "WWWWWWWWWWWWWWWWWWWWWWWW" + :dispatcher edit-disp :parent left-panel)) (desc-label (make-instance 'gfw:label :text "Description:" @@ -166,6 +187,7 @@ (desc-edit (make-instance 'gfw:edit :style '(:multi-line :auto-hscroll :auto-vscroll :vertical-scrollbar :want-return) :text (format nil "WWWWWWWWWWWWWWWWWWWWWWWW~%W~%W~%W~%W~%W") + :dispatcher edit-disp :parent left-panel)) (btn-panel (make-instance 'gfw:panel :layout (make-instance 'gfw:flow-layout

Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Wed Jun 28 17:44:07 2006 @@ -271,6 +271,17 @@ (defconstant +em-setimestatus+ #x00D8) (defconstant +em-getimestatus+ #x00D9)

+(defconstant +en-setfocus+ #x0100) +(defconstant +en-killfocus+ #x0200) +(defconstant +en-change+ #x0300) +(defconstant +en-update+ #x0400) +(defconstant +en-errspace+ #x0500) +(defconstant +en-maxtext+ #x0501) +(defconstant +en-hscroll+ #x0601) +(defconstant +en-vscroll+ #x0602) +(defconstant +en-align-ltr-ec+ #x0700) +(defconstant +en-align-rtl-ec+ #x0701) + (defconstant +es-left+ #x0000) (defconstant +es-center+ #x0001) (defconstant +es-right+ #x0002)

Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Wed Jun 28 17:44:07 2006 @@ -118,6 +118,15 @@ (cffi:get-callback 'subclassing_wndproc)))) (error 'gfs:win32-error :detail "set-window-long failed")))

+(defun dispatch-notification (widget wparam-hi) + (let ((disp (dispatcher widget)) + (time (event-time (thread-context)))) + (case wparam-hi + (0 (event-select disp widget time (gfs:make-rectangle))) ; FIXME: debug + (#.gfs::+en-killfocus+ (event-focus-loss disp widget time)) + (#.gfs::+en-setfocus+ (event-focus-gain disp widget time)) + (#.gfs::+en-update+ (event-modify disp widget time))))) + ;;; ;;; process-message methods ;;; @@ -156,14 +165,10 @@ ((eq wparam-hi 1) (format t "accelerator wparam: ~x lparam: ~x~%" wparam lparam)) ; FIXME: debug (t - (let ((w (get-widget tc (cffi:make-pointer lparam)))) - (if (null w) - (warn 'gfs:toolkit-warning :detail "no object for hwnd") - (unless (null (dispatcher w)) - (event-select (dispatcher w) - w - (event-time tc) - (gfs:make-rectangle))))))) ; FIXME + (let ((widget (get-widget tc (cffi:make-pointer lparam)))) + (when (and widget (dispatcher widget)) + ; (format t "wparam-hi: ~x wparam-lo: ~x lparam: ~x~%" wparam-hi wparam-lo lparam) + (dispatch-notification widget wparam-hi))))) (warn 'gfs:toolkit-warning :detail "no object for hwnd"))) 0)