Update of /project/gsharp/cvsroot/gsharp In directory common-lisp:/tmp/cvs-serv6974
Modified Files: gui.lisp Log Message: Gsharp now has an info pane (what Emacs calls a "mode-line").
--- /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 03:18:03 1.55 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2006/02/15 17:46:52 1.56 @@ -26,6 +26,38 @@ (defclass gsharp-pane (score-pane:score-pane) ((view :initarg :view :accessor view)))
+(defvar *info-bg-color* +gray85+) +(defvar *info-fg-color* +black+) + +(defclass gsharp-info-pane (info-pane) + () + (:default-initargs + :height 20 :max-height 20 :min-height 20 + :display-function 'display-info + :incremental-redisplay t)) + +(defun display-info (frame pane) + (declare (ignore frame)) + (let* ((master-pane (master-pane pane)) + (view (view master-pane)) + (buffer (buffer view))) + (princ " " pane) + (princ (cond ((and (needs-saving buffer) + (read-only-p buffer) + "%*")) + ((needs-saving buffer) "**") + ((read-only-p buffer) "%%") + (t "--")) + pane) + (princ " " pane) + (with-text-face (pane :bold) + (format pane "~25A" (name buffer))) + (with-text-family (pane :sans-serif) + (princ (if (recordingp *application-frame*) + "Def" + "") + pane)))) + (define-application-frame gsharp (standard-application-frame esa-frame-mixin) ((views :initarg :views :initform '() :accessor views) @@ -33,16 +65,24 @@ (:menu-bar menubar-command-table :height 25) (:pointer-documentation t) (:panes - (score (let ((win (make-pane 'gsharp-pane - :width 400 :height 500 - :name "score" - ;; :incremental-redisplay t - :double-buffering t - :display-function 'display-score - :command-table 'total-melody-table))) + (score (let* ((win (make-pane 'gsharp-pane + :width 400 :height 500 + :name "score" + ;; :incremental-redisplay t + :double-buffering t + :display-function 'display-score + :command-table 'total-melody-table)) + (info (make-pane 'gsharp-info-pane + :master-pane win + :background *info-bg-color* + :foreground *info-fg-color*))) (setf (windows *application-frame*) (list win)) (setf (view win) (car (views *application-frame*))) - win)) + (vertically () + (scrolling (:width 750 :height 500 + :min-height 400 :max-height 20000) + win) + info))) (state (make-pane 'score-pane:score-pane :width 50 :height 200 :name "state" @@ -57,9 +97,7 @@ (default (vertically () (horizontally () - (scrolling (:width 750 :height 500 - :min-height 400 :max-height 20000) - score) + score (vertically () (scrolling (:width 80 :height 200) state) (scrolling (:width 80 :height 300