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

Diff of /climacs/gui.lisp

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

revision 1.132 by abakic, Thu May 5 23:00:23 2005 UTC revision 1.133 by crhodes, Fri May 6 16:56:32 2005 UTC
# Line 282  Line 282 
282                 (when (null (remaining-keys *application-frame*))                 (when (null (remaining-keys *application-frame*))
283                   (setf (executingp *application-frame*) nil)                   (setf (executingp *application-frame*) nil)
284                   (redisplay-frame-panes frame))))                   (redisplay-frame-panes frame))))
285          (loop          (flet ((process-gestures ()
286                     (loop
287                      for gestures = '()
288                      do (multiple-value-bind (numarg numargp)
289                             (read-numeric-argument :stream *standard-input*)
290                           (loop
291                            (setf *current-gesture* (climacs-read-gesture))
292                            (setf gestures
293                                  (nconc gestures (list *current-gesture*)))
294                            (let ((item (find-gestures gestures 'global-climacs-table)))
295                              (cond
296                                ((not item)
297                                 (beep) (return))
298                                ((eq (command-menu-item-type item) :command)
299                                 (let ((command (command-menu-item-value item)))
300                                   (unless (consp command)
301                                     (setf command (list command)))
302                                   (setf command (substitute-numeric-argument-marker command numarg))
303                                   (setf command (substitute-numeric-argument-p command numargp))
304                                   (do-command command)
305                                   (return)))
306                                (t nil)))))
307                      do (update-climacs))))
308              (loop
309             for maybe-error = t             for maybe-error = t
310             do (with-simple-restart (return-to-climacs "Return to Climacs")             do (restart-case
311                  (handler-case                    (progn
312                      (with-input-context ('(command                      (handler-case
313                                             :command-table 'global-climacs-table))                          (with-input-context
314                        (object)                                ('(command :command-table 'global-climacs-table))
315                        (loop                              (object)
316                         for gestures = '()                              (process-gestures)
317                         do (multiple-value-bind (numarg numargp)                            (t
318                                (read-numeric-argument :stream *standard-input*)                             (do-command object)
319                              (loop (setf *current-gesture* (climacs-read-gesture))                             (setq maybe-error nil)))
320                                    (setf gestures (nconc gestures (list *current-gesture*)))                        (abort-gesture () (display-message "Quit")))
321                                    (let ((item (find-gestures gestures 'global-climacs-table)))                      (when maybe-error
322                                      (cond ((not item)                        (beep))
323                                             (beep) (return))                      (update-climacs))
324                                            ((eq (command-menu-item-type item) :command)                  (return-to-climacs () nil))))))))
                                            (let ((command (command-menu-item-value item)))  
                                              (unless (consp command)  
                                                (setf command (list command)))  
                                              (setf command (substitute-numeric-argument-marker command numarg))  
                                              (setf command (substitute-numeric-argument-p command numargp))  
                                              (do-command command)  
                                              (return)))  
                                           (t nil)))))  
                        (update-climacs))  
                       (t  
                        (do-command object)  
                        (setq maybe-error nil)))  
                   (abort-gesture () (display-message "Quit"))))  
            (when maybe-error  
              (beep))  
            (update-climacs))))))  
325    
326  (defmacro simple-command-loop (command-table loop-condition end-clauses)  (defmacro simple-command-loop (command-table loop-condition end-clauses)
327    (let ((gesture (gensym))    (let ((gesture (gensym))

Legend:
Removed from v.1.132  
changed lines
  Added in v.1.133

  ViewVC Help
Powered by ViewVC 1.1.5