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

Modified Files: esa.lisp gui.lisp packages.lisp Log Message: Climacs no longer uses the command table of the application frame, but now has a command table per pane. Eventually, this command table will inherit from a syntax-specific one, but that is not implemented yet.

The global-climacs-table inherits from the global-esa-table.

The commands com-quit and com-extended have been moved to the clobal-esa-table.

Handling modified buffers before quitting has been moved to an :around method on frame-exit.

Date: Sun Jul 24 07:10:49 2005 Author: rstrandh

Index: climacs/esa.lisp diff -u climacs/esa.lisp:1.9 climacs/esa.lisp:1.10 --- climacs/esa.lisp:1.9 Fri Jul 22 15:15:47 2005 +++ climacs/esa.lisp Sun Jul 24 07:10:47 2005 @@ -64,7 +64,8 @@

(defclass esa-pane-mixin () (;; allows a certain number of commands to have some minimal memory - (previous-command :initform nil :accessor previous-command))) + (previous-command :initform nil :accessor previous-command) + (command-table :initarg :command-table :accessor command-table)))

(defmethod handle-repaint :before ((pane esa-pane-mixin) region) (declare (ignore region)) @@ -79,9 +80,7 @@ (recordingp :initform nil :accessor recordingp) (executingp :initform nil :accessor executingp) (recorded-keys :initform '() :accessor recorded-keys) - (remaining-keys :initform '() :accessor remaining-keys) - ;; temporary hack. The command table should be buffer or pane specific - (esa-command-table :initarg :esa-command-table :reader command-table))) + (remaining-keys :initform '() :accessor remaining-keys)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -239,9 +238,9 @@ (progn (handler-case (with-input-context - (`(command :command-table ,(command-table frame))) + (`(command :command-table ,(command-table (car (windows frame))))) (object) - (process-gestures frame (command-table frame)) + (process-gestures frame (command-table (car (windows frame)))) (t (execute-frame-command frame object) (setq maybe-error nil))) @@ -314,6 +313,22 @@

(set-key 'com-quit 'global-esa-table '((#\x :control) (#\c :control)))

+(define-command (com-extended-command + :name t + :command-table global-esa-table) + () + (let ((item (handler-case + (accept + `(command :command-table + ,(command-table (car (windows *application-frame*)))) + :prompt "Extended Command") + (error () (progn (beep) + (display-message "No such command") + (return-from com-extended-command nil)))))) + (execute-frame-command *application-frame* item))) + +(set-key 'com-extended-command 'global-esa-table '((#\x :meta))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; example application @@ -344,7 +359,8 @@ (win (let* ((my-pane (make-pane 'example-pane :width 900 :height 400 - :display-function 'display-my-pane)) + :display-function 'display-my-pane + :command-table 'global-example-table)) (my-info-pane (make-pane 'example-info-pane :master-pane my-pane @@ -370,8 +386,7 @@ "Starts up the example application" (let ((frame (make-application-frame 'example - :width width :height height - :esa-command-table 'global-example-table))) + :width width :height height))) (run-frame-top-level frame)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.163 climacs/gui.lisp:1.164 --- climacs/gui.lisp:1.163 Fri Jul 22 15:15:47 2005 +++ climacs/gui.lisp Sun Jul 24 07:10:47 2005 @@ -58,7 +58,8 @@ :width 900 :height 400 :end-of-line-action :scroll :incremental-redisplay t - :display-function 'display-win)) + :display-function 'display-win + :command-table 'global-climacs-table)) (info-pane (make-pane 'climacs-info-pane :master-pane extended-pane @@ -91,8 +92,7 @@ (defun climacs (&key (width 900) (height 400)) "Starts up a climacs session" (let ((frame (make-application-frame - 'climacs :width width :height height - :esa-command-table 'global-climacs-table))) + 'climacs :width width :height height))) (run-frame-top-level frame)))

(defun display-info (frame pane) @@ -159,10 +159,13 @@ do (when (modified-p buffer) (setf (needs-saving buffer) t))))

+(make-command-table 'global-climacs-table :errorp nil :inherit-from '(global-esa-table)) + (defmacro define-named-command (command-name args &body body) - `(define-climacs-command ,(if (listp command-name) - `(,@command-name :name t) - `(,command-name :name t)) ,args ,@body)) + `(define-command ,(if (listp command-name) + `(,@command-name :name t :command-table global-climacs-table) + `(,command-name :name t :command-table global-climacs-table)) + ,args ,@body))

(define-named-command com-toggle-overwrite-mode () (with-slots (overwrite-mode) (current-window) @@ -436,13 +439,6 @@ (possibly-fill-line) (setf (offset point) (offset point-backup)))))

-(define-command com-extended-command () - (let ((item (handler-case (accept 'command :prompt "Extended Command") - (error () (progn (beep) - (display-message "No such command") - (return-from com-extended-command nil)))))) - (execute-frame-command *application-frame* item))) - (eval-when (:compile-toplevel :load-toplevel) (define-presentation-type completable-pathname () :inherit-from 'pathname)) @@ -597,23 +593,23 @@ (save-buffer buffer) (display-message "No changes need to be saved from ~a" (name buffer)))))

-(define-named-command (com-quit) () - (loop for buffer in (buffers *application-frame*) +(defmethod frame-exit :around ((frame climacs)) + (loop for buffer in (buffers frame) when (and (needs-saving buffer) (filepath buffer) (handler-case (accept 'boolean :prompt (format nil "Save buffer: ~a ?" (name buffer))) (error () (progn (beep) (display-message "Invalid answer") - (return-from com-quit nil))))) + (return-from frame-exit nil))))) do (save-buffer buffer)) (when (or (notany #'(lambda (buffer) (and (needs-saving buffer) (filepath buffer))) - (buffers *application-frame*)) + (buffers frame)) (handler-case (accept 'boolean :prompt "Modified buffers exist. Quit anyway?") (error () (progn (beep) (display-message "Invalid answer") - (return-from com-quit nil))))) - (frame-exit *application-frame*))) + (return-from frame-exit nil))))) + (call-next-method)))

(define-named-command com-write-buffer () (let ((filepath (accept 'completable-pathname @@ -803,7 +799,8 @@ :name 'win :end-of-line-action :scroll :incremental-redisplay t - :display-function 'display-win)) + :display-function 'display-win + :command-table 'global-climacs-table)) (vbox (vertically () (scrolling () extended-pane) @@ -1254,9 +1251,7 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Global and dead-escape command tables - -(make-command-table 'global-climacs-table :errorp nil) +;;; Dead-escape command tables

(make-command-table 'dead-escape-climacs-table :errorp nil)

@@ -1306,7 +1301,6 @@ (global-set-key '(#\u :meta) 'com-upcase-word) (global-set-key '(#\l :meta) 'com-downcase-word) (global-set-key '(#\c :meta) 'com-capitalize-word) -(global-set-key '(#\x :meta) 'com-extended-command) (global-set-key '(#\y :meta) 'com-rotate-yank) (global-set-key '(#\z :meta) 'com-zap-to-character) (global-set-key '(#\w :meta) 'com-copy-out) @@ -1371,7 +1365,6 @@ (c-x-set-key '(#)) 'com-end-kbd-macro) (c-x-set-key '(#\b) 'com-switch-to-buffer) (c-x-set-key '(#\e) 'com-call-last-kbd-macro) -(c-x-set-key '(#\c :control) 'com-quit) (c-x-set-key '(#\f :control) 'com-find-file) (c-x-set-key '(#\i) 'com-insert-file) (c-x-set-key '(#\k) 'com-kill-buffer)

Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.67 climacs/packages.lisp:1.68 --- climacs/packages.lisp:1.67 Thu Jul 21 14:24:30 2005 +++ climacs/packages.lisp Sun Jul 24 07:10:48 2005 @@ -174,6 +174,7 @@ #:esa-frame-mixin #:windows #:recordingp #:executingp #:*numeric-argument-p* #:*current-gesture* #:esa-top-level #:simple-command-loop + #:global-esa-table ;; remove these when kbd macros move to esa #:recorded-keys #:remaining-keys))