[climacs-cvs] CVS update: climacs/esa.lisp climacs/gui.lisp climacs/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Sun Jul 24 05:10:51 UTC 2005
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)
- `(, at command-name :name t)
- `(,command-name :name t)) ,args , at body))
+ `(define-command ,(if (listp command-name)
+ `(, at command-name :name t :command-table global-climacs-table)
+ `(,command-name :name t :command-table global-climacs-table))
+ ,args , at 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))
More information about the Climacs-cvs
mailing list