Author: junrue Date: Tue May 16 12:37:07 2006 New Revision: 135
Modified: trunk/src/tests/uitoolkit/windlg.lisp trunk/src/uitoolkit/widgets/dialog.lisp trunk/src/uitoolkit/widgets/top-level.lisp Log: fixed a bug in top-level initialize-instance that interfered with :text initarg; bit more work on re-enabling top-levels when modal dialog is dismissed
Modified: trunk/src/tests/uitoolkit/windlg.lisp ============================================================================== --- trunk/src/tests/uitoolkit/windlg.lisp (original) +++ trunk/src/tests/uitoolkit/windlg.lisp Tue May 16 12:37:07 2006 @@ -80,20 +80,20 @@ (declare (ignore disp item time rect)) (let ((window (make-instance 'gfw:top-level :dispatcher (make-instance 'test-mini-events) :owner *main-win* + :text "Mini Frame" :style '(:miniframe)))) (setf (gfw:location window) (gfs:make-point :x 250 :y 150)) (setf (gfw:size window) (gfs:make-size :width 150 :height 225)) - (setf (gfw:text window) "Mini Frame") (gfw:show window t)))
(defun create-palette-win (disp item time rect) (declare (ignore disp item time rect)) (let ((window (make-instance 'gfw:top-level :dispatcher (make-instance 'test-mini-events) :owner *main-win* + :text "Palette" :style '(:palette)))) (setf (gfw:location window) (gfs:make-point :x 250 :y 150)) (setf (gfw:size window) (gfs:make-size :width 150 :height 225)) - (setf (gfw:text window) "Palette") (gfw:show window t)))
(defun open-file-dlg (disp item time rect)
Modified: trunk/src/uitoolkit/widgets/dialog.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/dialog.lisp (original) +++ trunk/src/uitoolkit/widgets/dialog.lisp Tue May 16 12:37:07 2006 @@ -51,6 +51,21 @@ gfs::+color-btnface+ +dlgwindowextra+))
+(defun disable-top-levels (hdlg) + (let ((hutility (utility-hwnd (thread-context)))) + (setf *disabled-top-levels* nil) + (maptoplevels (lambda (win) + (unless (or (cffi:pointer-eq (gfs:handle win) hdlg) + (cffi:pointer-eq (gfs:handle win) hutility)) + (if (enabled-p win) + (push win *disabled-top-levels*)) + (enable win nil)))))) + +(defun reenable-top-levels () + (loop for win in *disabled-top-levels* + do (enable win t)) + (setf *disabled-top-levels* nil)) + ;;; ;;; methods ;;; @@ -136,6 +151,7 @@ (gfs::send-message hwnd gfs::+bm-setstyle+ style 1)))
(defmethod gfs:dispose ((self dialog)) + (reenable-top-levels) (if (visible-p self) (show self nil)) (call-next-method)) @@ -163,25 +179,15 @@ (show dlg nil))
(defmethod show ((self dialog) flag) - (let* ((tc (thread-context)) - (hutility (utility-hwnd tc)) - (app-modal (find :application-modal (style-of self))) - (owner-modal (find :owner-modal (style-of self))) - (owner (owner self)) - (hdlg (gfs:handle self))) + (let ((app-modal (find :application-modal (style-of self))) + (owner-modal (find :owner-modal (style-of self))) + (owner (owner self)) + (hdlg (gfs:handle self))) (cond ((and app-modal flag) - (setf *disabled-top-levels* nil) - (maptoplevels (lambda (win) - (unless (or (cffi:pointer-eq (gfs:handle win) hdlg) - (cffi:pointer-eq (gfs:handle win) hutility)) - (if (enabled-p win) - (push win *disabled-top-levels*)) - (enable win nil))))) + (disable-top-levels hdlg)) ((and app-modal (null flag)) - (loop for win in *disabled-top-levels* - do (enable win t)) - (setf *disabled-top-levels* nil)) + (reenable-top-levels)) ((and owner-modal owner) (enable owner (null flag)))) (gfs::show-window hdlg (if flag gfs::+sw-shownormal+ gfs::+sw-hide+))
Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Tue May 16 12:37:07 2006 @@ -124,18 +124,18 @@ (remove-widget (thread-context) (gfs:handle m)))) (call-next-method))
-(defmethod initialize-instance :after ((win top-level) &key owner title &allow-other-keys) +(defmethod initialize-instance :after ((win top-level) &key owner text &allow-other-keys) (unless (null owner) (if (gfs:disposed-p owner) (error 'gfs:disposed-error))) - (if (null title) - (setf title +default-window-title+)) + (if (null text) + (setf text +default-window-title+)) (let ((classname +toplevel-noerasebkgnd-window-classname+) (register-func #'register-toplevel-noerasebkgnd-window-class)) (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 owner title))) + (init-window win classname register-func owner text)))
(defmethod menu-bar :before ((win top-level)) (if (gfs:disposed-p win)