Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv28181 Modified Files: gui.lisp Log Message: factored out process-gestures from climacs-top-level Date: Sun Jul 17 14:40:19 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.153 climacs/gui.lisp:1.154 --- climacs/gui.lisp:1.153 Sun Jul 17 14:31:55 2005 +++ climacs/gui.lisp Sun Jul 17 14:40:19 2005 @@ -295,6 +295,30 @@ (setf (executingp *application-frame*) nil) (redisplay-frame-panes frame))) +(defun process-gestures (frame) + (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 frame command) + (return))) + (t nil))))) + do (update-climacs frame))) + (defun climacs-top-level (frame &key command-parser command-unparser partial-command-parser prompt) @@ -307,47 +331,23 @@ (*print-pretty* nil) (*abort-gestures* '((:keyboard #\g 512)))) (redisplay-frame-panes frame :force-p t) - (flet () - (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 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)))))))) + (loop + for maybe-error = t + do (restart-case + (progn + (handler-case + (with-input-context + ('(command :command-table global-climacs-table)) + (object) + (process-gestures frame) + (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)))))) (defmacro simple-command-loop (command-table loop-condition end-clauses) (let ((gesture (gensym))