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

Modified Files: gui.lisp Log Message: Renamed things that aren't Climacs specific.

Moved the code for marking buffers as needing to be saved to an :after method of execute-frame-command. The previous code was not right, in that it is entirely possible for a command to modify a buffer which is not the current one.

Date: Mon Jul 18 08:09:51 2005 Author: rstrandh

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.156 climacs/gui.lisp:1.157 --- climacs/gui.lisp:1.156 Mon Jul 18 00:40:37 2005 +++ climacs/gui.lisp Mon Jul 18 08:09:50 2005 @@ -182,9 +182,9 @@ (#\5 :meta) (#\6 :meta) (#\7 :meta) (#\8 :meta) (#\9 :meta)) :test #'event-matches-gesture-name-p))

-(defun climacs-read-gesture () +(defun generic-read-gesture () (unless (null (remaining-keys *application-frame*)) - (return-from climacs-read-gesture + (return-from generic-read-gesture (pop (remaining-keys *application-frame*)))) (loop for gesture = (read-gesture :stream *standard-input*) until (or (characterp gesture) @@ -203,7 +203,7 @@ (push gesture (recorded-keys *application-frame*))) (return gesture))))

-(defun climacs-unread-gesture (gesture stream) +(defun generic-unread-gesture (gesture stream) (cond ((recordingp *application-frame*) (pop (recorded-keys *application-frame*)) (unread-gesture gesture :stream stream)) @@ -213,35 +213,35 @@ (unread-gesture gesture :stream stream))))

(defun read-numeric-argument (&key (stream *standard-input*)) - (let ((gesture (climacs-read-gesture))) + (let ((gesture (generic-read-gesture))) (cond ((event-matches-gesture-name-p gesture '(:keyboard #\u 512)) ; FIXME (let ((numarg 4)) - (loop for gesture = (climacs-read-gesture) + (loop for gesture = (generic-read-gesture) while (event-matches-gesture-name-p gesture '(:keyboard #\u 512)) ; FIXME do (setf numarg (* 4 numarg)) - finally (climacs-unread-gesture gesture stream)) - (let ((gesture (climacs-read-gesture))) + finally (generic-unread-gesture gesture stream)) + (let ((gesture (generic-read-gesture))) (cond ((and (characterp gesture) (digit-char-p gesture 10)) (setf numarg (- (char-code gesture) (char-code #\0))) - (loop for gesture = (climacs-read-gesture) + (loop for gesture = (generic-read-gesture) while (and (characterp gesture) (digit-char-p gesture 10)) do (setf numarg (+ (* 10 numarg) (- (char-code gesture) (char-code #\0)))) - finally (climacs-unread-gesture gesture stream) + finally (generic-unread-gesture gesture stream) (return (values numarg t)))) (t - (climacs-unread-gesture gesture stream) + (generic-unread-gesture gesture stream) (values numarg t)))))) ((meta-digit gesture) (let ((numarg (meta-digit gesture))) - (loop for gesture = (climacs-read-gesture) + (loop for gesture = (generic-read-gesture) while (meta-digit gesture) do (setf numarg (+ (* 10 numarg) (meta-digit gesture))) - finally (climacs-unread-gesture gesture stream) + finally (generic-unread-gesture gesture stream) (return (values numarg t))))) - (t (climacs-unread-gesture gesture stream) + (t (generic-unread-gesture gesture stream) (values 1 nil)))))

;;; we know the vbox pane has a scroller pane and an info @@ -276,6 +276,11 @@ (no-such-operation () (beep) (display-message "Operation unavailable for syntax"))))

+(defmethod execute-frame-command :after ((frame climacs) command) + (loop for buffer in (buffers frame) + do (when (modified-p buffer) + (setf (needs-saving buffer) t)))) + (defun do-command (frame command) (execute-frame-command frame command) (setf (previous-command *standard-output*) @@ -283,10 +288,10 @@ (car command) command))) -(defun update-climacs (frame) - (let ((buffer (buffer (current-window)))) - (when (modified-p buffer) - (setf (needs-saving buffer) t))) +(defgeneric update-frame (frame) + (:method (frame) (declare (ignore frame)) nil)) + +(defmethod update-frame ((frame climacs)) (when (null (remaining-keys *application-frame*)) (setf (executingp *application-frame*) nil) (redisplay-frame-panes frame))) @@ -297,7 +302,7 @@ do (multiple-value-bind (numarg numargp) (read-numeric-argument :stream *standard-input*) (loop - (setf *current-gesture* (climacs-read-gesture)) + (setf *current-gesture* (generic-read-gesture)) (setf gestures (nconc gestures (list *current-gesture*))) (let ((item (find-gestures gestures 'global-climacs-table))) @@ -313,7 +318,7 @@ (do-command frame command) (return))) (t nil))))) - do (update-climacs frame))) + do (update-frame frame)))

(defun climacs-top-level (frame &key command-parser command-unparser @@ -342,7 +347,7 @@ (abort-gesture () (display-message "Quit"))) (when maybe-error (beep)) - (update-climacs frame)) + (update-frame frame)) (return-to-climacs () nil))))))

(defmacro simple-command-loop (command-table loop-condition end-clauses) @@ -352,7 +357,7 @@ `(progn (redisplay-frame-panes *application-frame*) (loop while ,loop-condition - as ,gesture = (climacs-read-gesture) + as ,gesture = (generic-read-gesture) as ,item = (find-gestures (list ,gesture) ,command-table) do (cond ((and ,item (eq (command-menu-item-type ,item) :command)) (setf *current-gesture* ,gesture)