[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