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

Modified Files: gui.lisp Log Message: C-g now aborts extended commands.

Date: Tue Feb 22 08:29:09 2005 Author: rstrandh

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.118 climacs/gui.lisp:1.119 --- climacs/gui.lisp:1.118 Mon Feb 21 13:51:55 2005 +++ climacs/gui.lisp Tue Feb 22 08:29:08 2005 @@ -176,8 +176,6 @@ (return-from climacs-read-gesture (pop (remaining-keys *application-frame*)))) (loop for gesture = (read-gesture :stream *standard-input*) - when (event-matches-gesture-name-p gesture '(:keyboard #\g 512)) ; FIXME - do (throw 'outer-loop nil) until (or (characterp gesture) (and (typep gesture 'keyboard-event) (or (keyboard-event-character gesture) @@ -260,40 +258,41 @@ (let ((*standard-output* (car windows)) (*standard-input* (find-pane-named frame 'int)) (*print-pretty* nil) - (*abort-gestures* nil)) + (*abort-gestures* '((:keyboard #\g 512)))) (redisplay-frame-panes frame :force-p t) - (loop (catch 'outer-loop - (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)) - (handler-case - (execute-frame-command frame command) - (error (condition) - (beep) - (format *error-output* "~a~%" condition))) - (setf (previous-command *standard-output*) - (if (consp command) - (car command) - command)) - (return))) - (t nil)))) - (let ((buffer (buffer (current-window)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) - (when (null (remaining-keys *application-frame*)) - (setf (executingp *application-frame*) nil) - (redisplay-frame-panes frame))))) + (loop (handler-case + (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)) + (handler-case + (execute-frame-command frame command) + (error (condition) + (beep) + (format *error-output* "~a~%" condition))) + (setf (previous-command *standard-output*) + (if (consp command) + (car command) + command)) + (return))) + (t nil)))) + (let ((buffer (buffer (current-window)))) + (when (modified-p buffer) + (setf (needs-saving buffer) t))) + (when (null (remaining-keys *application-frame*)) + (setf (executingp *application-frame*) nil) + (redisplay-frame-panes frame)))) + (abort-gesture () nil)) (beep) (let ((buffer (buffer (current-window)))) (when (modified-p buffer)