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

[Robert Strandh]

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

Modified Files:
	gui.lisp 
Log Message:
A small step in towards factoring out common GUI components into a
Climacs-independent module so that they can be reused in similar
applications such as Gsharp. 

Specifically, I am trying to factor out:

   * the info pane (done)
   * the minibuffer pane (done)
   * the pane constellation containing an application pane (possibly
     within a scroller pane) and an info pane inside a vbox pane
   * the command loop
   * command processing     
   * if possible, common commands such as C-x 0, C-x 1, C-x 2, C-x 3


Date: Sun Jul 17 07:07:42 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.150 climacs/gui.lisp:1.151
--- climacs/gui.lisp:1.150	Mon Jul 11 10:47:50 2005
+++ climacs/gui.lisp	Sun Jul 17 07:07:41 2005
@@ -39,15 +39,43 @@
    (dabbrev-expansion-mark :initform nil)
    (overwrite-mode :initform nil)))
 
+;;; a pane that displays some information about another pane
 (defclass info-pane (application-pane)
-  ((climacs-pane :initarg :climacs-pane)))
+  ((master-pane :initarg :master-pane))
+  (:default-initargs
+      :background +gray85+
+      :scroll-bars nil
+      :borders nil))
+
+(defclass minibuffer-pane (application-pane)
+  ((message :initform nil :accessor message))
+  (:default-initargs
+      :scroll-bars nil
+      :display-function 'display-minibuffer))
 
-(defclass minibuffer-pane (application-pane) ())
+(defun display-minibuffer (frame pane)
+  (declare (ignore frame))
+  (with-slots (message) pane
+    (unless (null message)
+    (princ message pane)
+    (setf message nil))))
 
 (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
   (declare (ignore type args))
   (window-clear pane))
 
+(defclass climacs-info-pane (info-pane)
+  ()
+  (:default-initargs
+      :height 20 :max-height 20 :min-height 20
+      :display-function 'display-info
+      :incremental-redisplay t))
+
+(defclass climacs-minibuffer-pane (minibuffer-pane)
+  ()
+  (:default-initargs
+      :height 20 :max-height 20 :min-height 20))
+
 (define-application-frame climacs ()
   ((windows :accessor windows)
    (buffers :initform '() :accessor buffers)
@@ -64,22 +92,14 @@
 			   :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)))
+		(make-pane 'climacs-info-pane
+			   :master-pane extended-pane
+			   :width 900)))
 	  (vertically ()
 	    (scrolling ()
 	      extended-pane)
 	    info-pane)))
-   (int (make-pane 'minibuffer-pane
-		   :width 900 :height 20 :max-height 20 :min-height 20
-		   :display-function 'display-minibuffer
-		   :scroll-bars nil)))
+   (int (make-pane 'climacs-minibuffer-pane :width 900)))
   (:layouts
    (default
        (vertically (:scroll-bars nil)
@@ -87,18 +107,10 @@
 	 int)))
   (:top-level (climacs-top-level)))
 
-(defparameter *message* nil)
-
 (defun display-message (format-string &rest format-args)
-  (setf *message* 
+  (setf (message *standard-input*)
 	(apply #'format nil format-string format-args)))
 
-(defun display-minibuffer (frame pane)
-  (declare (ignore frame))
-  (unless (null *message*)
-    (princ *message* pane)
-    (setf *message* nil)))
-
 (defmacro current-window () ; shouldn't this be an inlined function? --amb
   `(car (windows *application-frame*)))
 
@@ -116,26 +128,26 @@
     (loop for buffer in buffers
 	  do (clear-modify buffer))))
 
-(defun climacs ()
+(defun climacs (&key (width 900) (height 400))
   "Starts up a climacs session"
-  (let ((frame (make-application-frame 'climacs)))
+  (let ((frame (make-application-frame 'climacs :width width :height height)))
     (run-frame-top-level frame)))
 
 (defun display-info (frame pane)
   (declare (ignore frame))
-  (with-slots (climacs-pane) pane
-     (let* ((buf (buffer climacs-pane))
+  (with-slots (master-pane) pane
+     (let* ((buf (buffer master-pane))
 	    (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a~a    ~a"
 			       (if (needs-saving buf) "**" "--")
 			       (name buf)
 			       (name (syntax buf))
-			       (if (slot-value climacs-pane 'overwrite-mode)
+			       (if (slot-value master-pane 'overwrite-mode)
 				   " Ovwrt"
 				   "")
-                               (if (auto-fill-mode climacs-pane)
+                               (if (auto-fill-mode master-pane)
                                    " Fill"
                                    "")
-                               (if (isearch-mode climacs-pane)
+                               (if (isearch-mode master-pane)
                                    " Isearch"
                                    "")
 			       (if (recordingp *application-frame*)
@@ -979,15 +991,9 @@
 	 (vbox
 	  (vertically ()
 	    (scrolling () extended-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))))
+	    (make-pane 'climacs-info-pane
+		       :master-pane extended-pane
+		       :width 900))))
     (values vbox extended-pane)))
 
 (define-named-command com-split-window-vertically ()