/[climacs]/climacs/gui.lisp
ViewVC logotype

Diff of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.150 by rstrandh, Mon Jul 11 08:47:50 2005 UTC revision 1.151 by rstrandh, Sun Jul 17 05:07:41 2005 UTC
# Line 39  Line 39 
39     (dabbrev-expansion-mark :initform nil)     (dabbrev-expansion-mark :initform nil)
40     (overwrite-mode :initform nil)))     (overwrite-mode :initform nil)))
41    
42    ;;; a pane that displays some information about another pane
43  (defclass info-pane (application-pane)  (defclass info-pane (application-pane)
44    ((climacs-pane :initarg :climacs-pane)))    ((master-pane :initarg :master-pane))
45      (:default-initargs
46          :background +gray85+
47          :scroll-bars nil
48          :borders nil))
49    
50    (defclass minibuffer-pane (application-pane)
51      ((message :initform nil :accessor message))
52      (:default-initargs
53          :scroll-bars nil
54          :display-function 'display-minibuffer))
55    
56  (defclass minibuffer-pane (application-pane) ())  (defun display-minibuffer (frame pane)
57      (declare (ignore frame))
58      (with-slots (message) pane
59        (unless (null message)
60        (princ message pane)
61        (setf message nil))))
62    
63  (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)  (defmethod stream-accept :before ((pane minibuffer-pane) type &rest args)
64    (declare (ignore type args))    (declare (ignore type args))
65    (window-clear pane))    (window-clear pane))
66    
67    (defclass climacs-info-pane (info-pane)
68      ()
69      (:default-initargs
70          :height 20 :max-height 20 :min-height 20
71          :display-function 'display-info
72          :incremental-redisplay t))
73    
74    (defclass climacs-minibuffer-pane (minibuffer-pane)
75      ()
76      (:default-initargs
77          :height 20 :max-height 20 :min-height 20))
78    
79  (define-application-frame climacs ()  (define-application-frame climacs ()
80    ((windows :accessor windows)    ((windows :accessor windows)
81     (buffers :initform '() :accessor buffers)     (buffers :initform '() :accessor buffers)
# Line 64  Line 92 
92                             :incremental-redisplay t                             :incremental-redisplay t
93                             :display-function 'display-win))                             :display-function 'display-win))
94                 (info-pane                 (info-pane
95                  (make-pane 'info-pane                  (make-pane 'climacs-info-pane
96                             :climacs-pane extended-pane                             :master-pane extended-pane
97                             :width 900 :height 20 :max-height 20 :min-height 20                             :width 900)))
                            ::background +gray85+  
                            :scroll-bars nil  
                            :borders nil  
                            :incremental-redisplay t  
                            :display-function 'display-info)))  
98            (vertically ()            (vertically ()
99              (scrolling ()              (scrolling ()
100                extended-pane)                extended-pane)
101              info-pane)))              info-pane)))
102     (int (make-pane 'minibuffer-pane     (int (make-pane 'climacs-minibuffer-pane :width 900)))
                    :width 900 :height 20 :max-height 20 :min-height 20  
                    :display-function 'display-minibuffer  
                    :scroll-bars nil)))  
103    (:layouts    (:layouts
104     (default     (default
105         (vertically (:scroll-bars nil)         (vertically (:scroll-bars nil)
# Line 87  Line 107 
107           int)))           int)))
108    (:top-level (climacs-top-level)))    (:top-level (climacs-top-level)))
109    
 (defparameter *message* nil)  
   
110  (defun display-message (format-string &rest format-args)  (defun display-message (format-string &rest format-args)
111    (setf *message*    (setf (message *standard-input*)
112          (apply #'format nil format-string format-args)))          (apply #'format nil format-string format-args)))
113    
 (defun display-minibuffer (frame pane)  
   (declare (ignore frame))  
   (unless (null *message*)  
     (princ *message* pane)  
     (setf *message* nil)))  
   
114  (defmacro current-window () ; shouldn't this be an inlined function? --amb  (defmacro current-window () ; shouldn't this be an inlined function? --amb
115    `(car (windows *application-frame*)))    `(car (windows *application-frame*)))
116    
# Line 116  Line 128 
128      (loop for buffer in buffers      (loop for buffer in buffers
129            do (clear-modify buffer))))            do (clear-modify buffer))))
130    
131  (defun climacs ()  (defun climacs (&key (width 900) (height 400))
132    "Starts up a climacs session"    "Starts up a climacs session"
133    (let ((frame (make-application-frame 'climacs)))    (let ((frame (make-application-frame 'climacs :width width :height height)))
134      (run-frame-top-level frame)))      (run-frame-top-level frame)))
135    
136  (defun display-info (frame pane)  (defun display-info (frame pane)
137    (declare (ignore frame))    (declare (ignore frame))
138    (with-slots (climacs-pane) pane    (with-slots (master-pane) pane
139       (let* ((buf (buffer climacs-pane))       (let* ((buf (buffer master-pane))
140              (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a~a    ~a"              (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a~a    ~a"
141                                 (if (needs-saving buf) "**" "--")                                 (if (needs-saving buf) "**" "--")
142                                 (name buf)                                 (name buf)
143                                 (name (syntax buf))                                 (name (syntax buf))
144                                 (if (slot-value climacs-pane 'overwrite-mode)                                 (if (slot-value master-pane 'overwrite-mode)
145                                     " Ovwrt"                                     " Ovwrt"
146                                     "")                                     "")
147                                 (if (auto-fill-mode climacs-pane)                                 (if (auto-fill-mode master-pane)
148                                     " Fill"                                     " Fill"
149                                     "")                                     "")
150                                 (if (isearch-mode climacs-pane)                                 (if (isearch-mode master-pane)
151                                     " Isearch"                                     " Isearch"
152                                     "")                                     "")
153                                 (if (recordingp *application-frame*)                                 (if (recordingp *application-frame*)
# Line 979  as two values" Line 991  as two values"
991           (vbox           (vbox
992            (vertically ()            (vertically ()
993              (scrolling () extended-pane)              (scrolling () extended-pane)
994              (make-pane 'info-pane              (make-pane 'climacs-info-pane
995                         :climacs-pane extended-pane                         :master-pane extended-pane
996                         :width 900 :height 20                         :width 900))))
                        :max-height 20 :min-height 20  
                        ::background +gray85+  
                        :scroll-bars nil  
                        :borders nil  
                        :incremental-redisplay t  
                        :display-function 'display-info))))  
997      (values vbox extended-pane)))      (values vbox extended-pane)))
998    
999  (define-named-command com-split-window-vertically ()  (define-named-command com-split-window-vertically ()

Legend:
Removed from v.1.150  
changed lines
  Added in v.1.151

  ViewVC Help
Powered by ViewVC 1.1.5