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

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 ()
participants (1)
-
rstrandh@common-lisp.net