[mcclim-cvs] CVS mcclim

crhodes crhodes at common-lisp.net
Wed Jan 28 19:27:22 UTC 2009


Update of /project/mcclim/cvsroot/mcclim
In directory cl-net:/tmp/cvs-serv11339

Modified Files:
	frames.lisp menu-choose.lisp protocol-classes.lisp test.lisp 
Log Message:
The spec says that PORT is an accessor on frame-manager; remove 
CLIMI::FRAME-MANAGER-PORT and implement PORT instead.  Fixup all uses 
that I can find.

(Motivated by Climacs's own frame management)


--- /project/mcclim/cvsroot/mcclim/frames.lisp	2008/12/07 20:24:44	1.134
+++ /project/mcclim/cvsroot/mcclim/frames.lisp	2009/01/28 19:27:22	1.135
@@ -36,13 +36,11 @@
 (defun find-frame-manager (&rest options &key port &allow-other-keys)
   (declare (special *frame-manager*))
   (if (and (boundp '*frame-manager*)
-           (or (null port)
-               (eql port (frame-manager-port *frame-manager*))))
+           (or (null port) (eql port (port *frame-manager*))))
       *frame-manager*
     (if (and *default-frame-manager*
              (frame-manager-p *default-frame-manager*)
-             (or (null port)
-                 (eql port (frame-manager-port *default-frame-manager*))))
+             (or (null port) (eql port (port *default-frame-manager*))))
 	*default-frame-manager*
         (first (frame-managers (or port (apply #'find-port options)))))))
 
@@ -624,7 +622,7 @@
 (defmethod adopt-frame ((fm frame-manager) (frame application-frame))
   (setf (slot-value fm 'frames) (cons frame (slot-value fm 'frames)))
   (setf (frame-manager frame) fm)
-  (setf (port frame) (frame-manager-port fm))
+  (setf (port frame) (port fm))
   (setf (graft frame) (find-graft :port (port frame)))
   (let* ((*application-frame* frame)
 	 (t-l-s (make-pane-1 fm frame 'top-level-sheet-pane
@@ -637,8 +635,7 @@
     (setf (slot-value frame 'state) :disabled)
     #+clim-mp
     (when (typep event-queue 'port-event-queue)
-      (setf (event-queue-port event-queue)
-            (frame-manager-port fm)))
+      (setf (event-queue-port event-queue) (port fm)))
     frame))
 
 (defmethod disown-frame ((fm frame-manager) (frame application-frame))
@@ -651,7 +648,7 @@
   (sheet-disown-child (graft frame) (frame-top-level-sheet frame))
   (setf (%frame-manager frame) nil)
   (setf (slot-value frame 'state) :disowned)
-  (port-force-output (frame-manager-port fm))
+  (port-force-output (port fm))
   frame)
 
 (defmethod enable-frame ((frame application-frame))
@@ -977,7 +974,7 @@
 			     :name 'top-level-sheet)))
     (setf (slot-value frame 'top-level-sheet) t-l-s)
     (sheet-adopt-child t-l-s (frame-panes frame))
-    (let ((graft (find-graft :port (frame-manager-port fm))))
+    (let ((graft (find-graft :port (port fm))))
       (sheet-adopt-child graft t-l-s)
       (setf (graft frame) graft))
     (let ((pre-space (compose-space t-l-s))
--- /project/mcclim/cvsroot/mcclim/menu-choose.lisp	2008/02/05 16:58:51	1.23
+++ /project/mcclim/cvsroot/mcclim/menu-choose.lisp	2009/01/28 19:27:22	1.24
@@ -268,7 +268,7 @@
 `frame' (essentially, the screen resolution with a slight
 padding.)"
   ;; FIXME? There may be a better way.
-  (let* ((port (frame-manager-port (frame-manager frame)))
+  (let* ((port (port (frame-manager frame)))
          (graft (find-graft :port port)))
     (values (- (graft-width graft) 50)
             (- (graft-height graft) 50))))
--- /project/mcclim/cvsroot/mcclim/protocol-classes.lisp	2006/10/29 12:56:13	1.4
+++ /project/mcclim/cvsroot/mcclim/protocol-classes.lisp	2009/01/28 19:27:22	1.5
@@ -188,10 +188,8 @@
 ;;; standard-frame-manager and I don't want to add these slots to all the frame
 ;;; manager classes right now.
 (define-protocol-class frame-manager ()
-  ((port :initarg :port
-	 :reader frame-manager-port)
-   (frames :initform nil
-	   :reader frame-manager-frames)))
+  ((port :initarg :port :reader port)
+   (frames :initform nil :reader frame-manager-frames)))
 
 ;;; 30.3 Basic Gadget Classes
 ;;; XXX Slots definitions should be banished.
--- /project/mcclim/cvsroot/mcclim/test.lisp	2003/03/21 21:36:59	1.5
+++ /project/mcclim/cvsroot/mcclim/test.lisp	2009/01/28 19:27:22	1.6
@@ -28,7 +28,7 @@
   (setq climi::*all-ports* nil)
   (setq frame (make-application-frame 'address-book))
 ;  (setq fm (frame-manager frame))
-;  (setq port (climi::frame-manager-port fm))
+;  (setq port (port fm))
 ;  (setq pane (frame-standard-output frame))
 ;  (setq medium (sheet-medium pane))
 ;  (setq graft (graft frame))





More information about the Mcclim-cvs mailing list