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

Diff of /climacs/gui.lisp

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

revision 1.153 by rstrandh, Sun Jul 17 12:31:55 2005 UTC revision 1.154 by rstrandh, Sun Jul 17 12:40:19 2005 UTC
# Line 295  Line 295 
295      (setf (executingp *application-frame*) nil)      (setf (executingp *application-frame*) nil)
296      (redisplay-frame-panes frame)))      (redisplay-frame-panes frame)))
297    
298    (defun process-gestures (frame)
299      (loop
300       for gestures = '()
301       do (multiple-value-bind (numarg numargp)
302              (read-numeric-argument :stream *standard-input*)
303            (loop
304             (setf *current-gesture* (climacs-read-gesture))
305             (setf gestures
306                   (nconc gestures (list *current-gesture*)))
307             (let ((item (find-gestures gestures 'global-climacs-table)))
308               (cond
309                 ((not item)
310                  (beep) (return))
311                 ((eq (command-menu-item-type item) :command)
312                  (let ((command (command-menu-item-value item)))
313                    (unless (consp command)
314                      (setf command (list command)))
315                    (setf command (substitute-numeric-argument-marker command numarg))
316                    (setf command (substitute-numeric-argument-p command numargp))
317                    (do-command frame command)
318                    (return)))
319                 (t nil)))))
320       do (update-climacs frame)))
321    
322  (defun climacs-top-level (frame &key  (defun climacs-top-level (frame &key
323                            command-parser command-unparser                            command-parser command-unparser
324                            partial-command-parser prompt)                            partial-command-parser prompt)
# Line 307  Line 331 
331            (*print-pretty* nil)            (*print-pretty* nil)
332            (*abort-gestures* '((:keyboard #\g 512))))            (*abort-gestures* '((:keyboard #\g 512))))
333        (redisplay-frame-panes frame :force-p t)        (redisplay-frame-panes frame :force-p t)
334        (flet ()        (loop
335          (flet ((process-gestures ()         for maybe-error = t
336                   (loop         do (restart-case
337                    for gestures = '()             (progn
338                    do (multiple-value-bind (numarg numargp)               (handler-case
339                           (read-numeric-argument :stream *standard-input*)                (with-input-context
340                         (loop                    ('(command :command-table global-climacs-table))
341                          (setf *current-gesture* (climacs-read-gesture))                    (object)
342                          (setf gestures                    (process-gestures frame)
343                                (nconc gestures (list *current-gesture*)))                  (t
344                          (let ((item (find-gestures gestures 'global-climacs-table)))                   (do-command frame object)
345                            (cond                   (setq maybe-error nil)))
346                              ((not item)                (abort-gesture () (display-message "Quit")))
347                               (beep) (return))               (when maybe-error
348                              ((eq (command-menu-item-type item) :command)                 (beep))
349                               (let ((command (command-menu-item-value item)))               (update-climacs frame))
350                                 (unless (consp command)             (return-to-climacs () nil))))))
                                  (setf command (list command)))  
                                (setf command (substitute-numeric-argument-marker command numarg))  
                                (setf command (substitute-numeric-argument-p command numargp))  
                                (do-command frame command)  
                                (return)))  
                             (t nil)))))  
                   do (update-climacs frame))))  
           (loop  
            for maybe-error = t  
            do (restart-case  
                   (progn  
                     (handler-case  
                         (with-input-context  
                               ('(command :command-table global-climacs-table))  
                             (object)  
                             (process-gestures)  
                           (t  
                            (do-command frame object)  
                            (setq maybe-error nil)))  
                       (abort-gesture () (display-message "Quit")))  
                     (when maybe-error  
                       (beep))  
                     (update-climacs frame))  
                 (return-to-climacs () nil))))))))  
351    
352  (defmacro simple-command-loop (command-table loop-condition end-clauses)  (defmacro simple-command-loop (command-table loop-condition end-clauses)
353    (let ((gesture (gensym))    (let ((gesture (gensym))

Legend:
Removed from v.1.153  
changed lines
  Added in v.1.154

  ViewVC Help
Powered by ViewVC 1.1.5