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

Diff of /climacs/gui.lisp

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

revision 1.159 by dholman, Wed Jul 20 09:41:06 2005 UTC revision 1.160 by rstrandh, Thu Jul 21 05:13:51 2005 UTC
# Line 28  Line 28 
28    
29  (in-package :climacs-gui)  (in-package :climacs-gui)
30    
31  (defclass extended-pane (climacs-pane)  (defclass extended-pane (climacs-pane esa-pane-mixin)
32    (;; allows a certain number of commands to have some minimal memory    (;; for next-line and previous-line commands
    (previous-command :initform nil :accessor previous-command)  
    ;; for next-line and previous-line commands  
33     (goal-column :initform nil)     (goal-column :initform nil)
34     ;; for dynamic abbrev expansion     ;; for dynamic abbrev expansion
35     (original-prefix :initform nil)     (original-prefix :initform nil)
# Line 47  Line 45 
45        :scroll-bars nil        :scroll-bars nil
46        :borders nil))        :borders nil))
47    
 (defclass minibuffer-pane (application-pane)  
   ((message :initform nil :accessor message))  
   (:default-initargs  
       :scroll-bars nil  
       :display-function 'display-minibuffer))  
   
 (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))  
   
48  (defclass climacs-info-pane (info-pane)  (defclass climacs-info-pane (info-pane)
49    ()    ()
50    (:default-initargs    (:default-initargs
# Line 76  Line 57 
57    (:default-initargs    (:default-initargs
58        :height 20 :max-height 20 :min-height 20))        :height 20 :max-height 20 :min-height 20))
59    
60    ;;; eventually remove in favor of esa-frame-mixin
61  (defclass multi-frame-mixin ()  (defclass multi-frame-mixin ()
62    ((windows :accessor windows)    ((windows :accessor windows)
63     (buffers :initform '() :accessor buffers)     (buffers :initform '() :accessor buffers)
# Line 111  Line 93 
93           int)))           int)))
94    (:top-level (climacs-top-level)))    (:top-level (climacs-top-level)))
95    
 (defun display-message (format-string &rest format-args)  
   (setf (message *standard-input*)  
         (apply #'format nil format-string format-args)))  
   
96  (defun current-window ()  (defun current-window ()
97    (car (windows *application-frame*)))    (car (windows *application-frame*)))
98    
# Line 281  Line 259 
259          do (when (modified-p buffer)          do (when (modified-p buffer)
260               (setf (needs-saving buffer) t))))               (setf (needs-saving buffer) t))))
261    
262  (defun do-command (frame command)  (defmethod execute-frame-command :after ((frame multi-frame-mixin) command)
   (execute-frame-command frame command)  
263    (setf (previous-command *standard-output*)    (setf (previous-command *standard-output*)
264          (if (consp command)          (if (consp command)
265              (car command)              (car command)
266              command)))              command)))
   
 (defgeneric update-frame (frame)  
   (:method (frame) (declare (ignore frame)) nil))  
267    
268  (defmethod update-frame ((frame climacs))  (defmethod redisplay-frame-panes :around ((frame multi-frame-mixin) &key force-p)
269      (declare (ignore force-p))
270    (when (null (remaining-keys *application-frame*))    (when (null (remaining-keys *application-frame*))
271      (setf (executingp *application-frame*) nil)      (setf (executingp *application-frame*) nil)
272      (redisplay-frame-panes frame)))      (call-next-method)))
273    
274  (defun process-gestures (frame)  (defun process-gestures (frame command-table)
275    (loop    (loop
276     for gestures = '()     for gestures = '()
277     do (multiple-value-bind (numarg numargp)     do (multiple-value-bind (numarg numargp)
# Line 305  Line 280 
280           (setf *current-gesture* (generic-read-gesture))           (setf *current-gesture* (generic-read-gesture))
281           (setf gestures           (setf gestures
282                 (nconc gestures (list *current-gesture*)))                 (nconc gestures (list *current-gesture*)))
283           (let ((item (find-gestures gestures 'global-climacs-table)))           (let ((item (find-gestures gestures command-table)))
284             (cond             (cond
285               ((not item)               ((not item)
286                (beep) (return))                (beep) (return))
# Line 315  Line 290 
290                    (setf command (list command)))                    (setf command (list command)))
291                  (setf command (substitute-numeric-argument-marker command numarg))                  (setf command (substitute-numeric-argument-marker command numarg))
292                  (setf command (substitute-numeric-argument-p command numargp))                  (setf command (substitute-numeric-argument-p command numargp))
293                  (do-command frame command)                  (execute-frame-command frame command)
294                  (return)))                  (return)))
295               (t nil)))))               (t nil)))))
296     do (update-frame frame)))     do (redisplay-frame-panes frame)))
297    
298  (defun climacs-top-level (frame &key  (defun climacs-top-level (frame &key
299                            command-parser command-unparser                            command-parser command-unparser
# Line 340  Line 315 
315                (with-input-context                (with-input-context
316                    ('(command :command-table global-climacs-table))                    ('(command :command-table global-climacs-table))
317                    (object)                    (object)
318                    (process-gestures frame)                    (process-gestures frame 'global-climacs-table)
319                  (t                  (t
320                   (do-command frame object)                   (execute-frame-command frame object)
321                   (setq maybe-error nil)))                   (setq maybe-error nil)))
322                (abort-gesture () (display-message "Quit")))                (abort-gesture () (display-message "Quit")))
323               (when maybe-error               (when maybe-error
324                 (beep))                 (beep))
325               (update-frame frame))               (redisplay-frame-panes frame))
326             (return-to-climacs () nil))))))             (return-to-climacs () nil))))))
327    
328  (defmacro simple-command-loop (command-table loop-condition end-clauses)  (defmacro simple-command-loop (command-table loop-condition end-clauses)

Legend:
Removed from v.1.159  
changed lines
  Added in v.1.160

  ViewVC Help
Powered by ViewVC 1.1.5