[mcclim-cvs] CVS mcclim - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

6 Feb 2006

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)))

    