Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp:/tmp/cvs-serv30236
Modified Files:
frames.lisp sheets.lisp
Log Message:
{raise,bury}-{frame,sheet,mirror}
--- /project/mcclim/cvsroot/mcclim/frames.lisp 2006/01/28 00:47:18 1.112
+++ /project/mcclim/cvsroot/mcclim/frames.lisp 2006/02/06 08:51:02 1.113
@@ -689,6 +689,8 @@
(defgeneric enable-frame (frame))
(defgeneric disable-frame (frame))
(defgeneric destroy-frame (frame))
+(defgeneric raise-frame (frame))
+(defgeneric bury-frame (frame))
(defgeneric note-frame-enabled (frame-manager frame))
(defgeneric note-frame-disbled (frame-manager frame))
@@ -708,6 +710,12 @@
(disable-frame frame))
(disown-frame (frame-manager frame) frame))
+(defmethod raise-frame ((frame application-frame))
+ (raise-sheet (frame-top-level-sheet frame)))
+
+(defmethod bury-frame ((frame application-frame))
+ (bury-sheet (frame-top-level-sheet frame)))
+
(defmethod note-frame-enabled ((fm frame-manager) frame)
(declare (ignore frame))
t)
@@ -989,7 +997,7 @@
(setq frame (apply #'make-application-frame frame-name initargs))))
(when (and frame activate)
(cond ((frame-process frame)
- #-(and)(raise-frame frame)) ; not yet
+ (raise-frame frame))
(own-process
(clim-sys:make-process #'(lambda ()
(run-frame-top-level frame))
--- /project/mcclim/cvsroot/mcclim/sheets.lisp 2005/01/11 13:35:18 1.48
+++ /project/mcclim/cvsroot/mcclim/sheets.lisp 2006/02/06 08:51:02 1.49
@@ -503,14 +503,16 @@
(setf (sheet-parent child) nil))
(defmethod raise-sheet ((sheet sheet-parent-mixin))
- (when (not (sheet-parent sheet))
- (error 'sheet-is-not-child))
- (raise-sheet-internal sheet (sheet-parent sheet)))
+ (when (sheet-parent sheet)
+ (raise-sheet-internal sheet (sheet-parent sheet)))
+ (when (sheet-direct-mirror sheet)
+ (raise-mirror (port sheet) sheet)))
(defmethod bury-sheet ((sheet sheet-parent-mixin))
- (when (not (sheet-parent sheet))
- (error 'sheet-is-not-child))
- (bury-sheet-internal sheet (sheet-parent sheet)))
+ (when (sheet-parent sheet)
+ (bury-sheet-internal sheet (sheet-parent sheet)))
+ (when (sheet-direct-mirror sheet)
+ (bury-mirror (port sheet) sheet)))
(defmethod graft ((sheet sheet-parent-mixin))
(graft (sheet-parent sheet)))
