Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25021

Modified Files: gui.lisp Log Message: rearrange the toplevel loop a little

Date: Fri May 6 18:56:33 2005 Author: crhodes

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.132 climacs/gui.lisp:1.133 --- climacs/gui.lisp:1.132 Fri May 6 01:00:23 2005 +++ climacs/gui.lisp Fri May 6 18:56:32 2005 @@ -282,39 +282,46 @@ (when (null (remaining-keys *application-frame*)) (setf (executingp *application-frame*) nil) (redisplay-frame-panes frame)))) - (loop + (flet ((process-gestures () + (loop + for gestures = '() + do (multiple-value-bind (numarg numargp) + (read-numeric-argument :stream *standard-input*) + (loop + (setf *current-gesture* (climacs-read-gesture)) + (setf gestures + (nconc gestures (list *current-gesture*))) + (let ((item (find-gestures gestures 'global-climacs-table))) + (cond + ((not item) + (beep) (return)) + ((eq (command-menu-item-type item) :command) + (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))))) + do (update-climacs)))) + (loop for maybe-error = t - do (with-simple-restart (return-to-climacs "Return to Climacs") - (handler-case - (with-input-context ('(command - :command-table 'global-climacs-table)) - (object) - (loop - for gestures = '() - do (multiple-value-bind (numarg numargp) - (read-numeric-argument :stream *standard-input*) - (loop (setf *current-gesture* (climacs-read-gesture)) - (setf gestures (nconc gestures (list *current-gesture*))) - (let ((item (find-gestures gestures 'global-climacs-table))) - (cond ((not item) - (beep) (return)) - ((eq (command-menu-item-type item) :command) - (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)))))) + do (restart-case + (progn + (handler-case + (with-input-context + ('(command :command-table 'global-climacs-table)) + (object) + (process-gestures) + (t + (do-command object) + (setq maybe-error nil))) + (abort-gesture () (display-message "Quit"))) + (when maybe-error + (beep)) + (update-climacs)) + (return-to-climacs () nil))))))))

(defmacro simple-command-loop (command-table loop-condition end-clauses) (let ((gesture (gensym))