[climacs-cvs] CVS update: climacs/gui.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv27111

Modified Files:
	gui.lisp 
Log Message:
The info pane now displays info about its own associated Climacs pane.

Date: Mon Jan 17 22:55:47 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.80 climacs/gui.lisp:1.81
--- climacs/gui.lisp:1.80	Mon Jan 17 21:58:24 2005
+++ climacs/gui.lisp	Mon Jan 17 22:55:47 2005
@@ -39,6 +39,9 @@
    (dabbrev-expansion-mark :initform nil)
    (overwrite-mode :initform nil)))
 
+(defclass info-pane (application-pane)
+  ((climacs-pane :initarg :climacs-pane)))
+
 (defclass minibuffer-pane (application-pane) ())
 
 (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
@@ -49,20 +52,25 @@
   ((win :reader win)
    (buffers :initform '() :accessor buffers))
   (:panes
-   (win (vertically ()
-	  (scrolling ()
-	    (make-pane 'extended-pane
-		       :width 900 :height 400
-		       :name 'bla
-		       :incremental-redisplay t
-		       :display-function 'display-win))
-	  (make-pane 'application-pane
-		     :width 900 :height 20 :max-height 20 :min-height 20
-		     ::background +gray85+
-		     :scroll-bars nil
-		     :borders nil
-		     :incremental-redisplay t
-		     :display-function 'display-info)))
+   (win (let* ((extended-pane 
+		(make-pane 'extended-pane
+			   :width 900 :height 400
+			   :name 'bla
+			   :incremental-redisplay t
+			   :display-function 'display-win))
+	       (info-pane
+		(make-pane 'info-pane
+			   :climacs-pane extended-pane
+			   :width 900 :height 20 :max-height 20 :min-height 20
+			   ::background +gray85+
+			   :scroll-bars nil
+			   :borders nil
+			   :incremental-redisplay t
+			   :display-function 'display-info)))
+	  (vertically ()
+	    (scrolling ()
+	      extended-pane)
+	    info-pane)))
    (int (make-pane 'minibuffer-pane
 		   :width 900 :height 20 :max-height 20 :min-height 20
 		   :scroll-bars nil)))
@@ -92,16 +100,17 @@
   (apply #'format *standard-input* format-string format-args))
 
 (defun display-info (frame pane)
-  (let* ((win (win frame))
-	 (buf (buffer win))
-	 (name-info (format nil "   ~a   ~a   Syntax: ~a ~a"
-			    (if (needs-saving buf) "**" "--")
-			    (name buf)
-			    (name (syntax buf))
-			    (if (slot-value win 'overwrite-mode)
-				"Ovwrt"
-				""))))
-    (princ name-info pane)))
+  (declare (ignore frame))
+  (with-slots (climacs-pane) pane
+     (let* ((buf (buffer climacs-pane))
+	    (name-info (format nil "   ~a   ~a   Syntax: ~a ~a"
+			       (if (needs-saving buf) "**" "--")
+			       (name buf)
+			       (name (syntax buf))
+			       (if (slot-value climacs-pane 'overwrite-mode)
+				   "Ovwrt"
+				   ""))))
+       (princ name-info pane))))
 
 (defun display-win (frame pane)
   "The display function used by the climacs application frame."
@@ -678,7 +687,8 @@
       (sheet-adopt-child parent
 			 (vertically ()
 			   (scrolling () new-pane)
-			   (make-pane 'application-pane
+			   (make-pane 'info-pane
+				      :climacs-pane new-pane
 				      :width 900 :height 20
 				      :max-height 20 :min-height 20
 				      ::background +gray85+