Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv29630
Modified Files:
slidemacs-gui.lisp gui.lisp esa.lisp
Log Message:
Changed ESA's set-key to automatically create dead-escape
equivalents to :meta commands. Changed all global-set-keys
to use set-key instead. Now key-chords are assigned next to
the command definitions. All commands currently in
global-climacs-table. The next task is to redistribute them
among relevant groupings of tables.
Date: Tue Aug 30 19:28:53 2005
Author: dmurray
Index: climacs/slidemacs-gui.lisp
diff -u climacs/slidemacs-gui.lisp:1.16 climacs/slidemacs-gui.lisp:1.17
--- climacs/slidemacs-gui.lisp:1.16 Wed Jun 22 20:36:13 2005
+++ climacs/slidemacs-gui.lisp Tue Aug 30 19:28:52 2005
@@ -543,13 +543,27 @@
(setf (syntax buffer) (make-instance 'slidemacs-gui-syntax
:buffer buffer))))))
-(climacs-gui::global-set-key '(#\= :control) 'com-next-talking-point)
-(climacs-gui::global-set-key '(#\- :control) 'com-previous-talking-point)
-(climacs-gui::global-set-key '(#\= :meta) 'com-increase-presentation-font-sizes)
-(climacs-gui::global-set-key '(#\- :meta) 'com-decrease-presentation-font-sizes)
-(climacs-gui::global-set-key '(#\= :control :meta) 'com-last-talking-point)
-(climacs-gui::global-set-key '(#\- :control :meta) 'com-first-talking-point)
-(climacs-gui::global-set-key '(#\s :control :meta) 'com-flip-slidemacs-syntax)
+(esa:set-key 'com-next-talking-point
+ 'climacs-gui::global-climacs-table
+ '((#\= :control)))
+(esa:set-key 'com-previous-talking-point
+ 'climacs-gui::global-climacs-table
+ '((#\- :control)))
+(esa:set-key 'com-increase-presentation-font-sizes
+ 'climacs-gui::global-climacs-table
+ '((#\= :meta)))
+(esa:set-key 'com-decrease-presentation-font-sizes
+ 'climacs-gui::global-climacs-table
+ '((#\- :meta)))
+(esa:set-key 'com-last-talking-point
+ 'climacs-gui::global-climacs-table
+ '((#\= :control :meta)))
+(esa:set-key 'com-first-talking-point
+ 'climacs-gui::global-climacs-table
+ '((#\- :control :meta)))
+(esa:set-key 'com-flip-slidemacs-syntax
+ 'climacs-gui::global-climacs-table
+ '((#\s :control :meta)))
(climacs-gui::define-named-command com-postscript-print-presentation ()
(let ((pane (climacs-gui::current-window)))
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.183 climacs/gui.lisp:1.184
--- climacs/gui.lisp:1.183 Thu Aug 25 10:43:55 2005
+++ climacs/gui.lisp Tue Aug 30 19:28:52 2005
@@ -197,12 +197,21 @@
(with-slots (overwrite-mode) (current-window)
(setf overwrite-mode (not overwrite-mode))))
+(set-key 'com-toggle-overwrite-mode 'global-climacs-table
+ '((:insert)))
+
(define-named-command com-not-modified ()
(setf (needs-saving (buffer (current-window))) nil))
+(set-key 'com-not-modified 'global-climacs-table
+ '((#\~ :meta :shift)))
+
(define-named-command com-set-fill-column ((column 'integer :prompt "Column Number:"))
(set-fill-column column))
+(set-key `(com-set-fill-column ,*numeric-argument-marker*) 'global-climacs-table
+ '((#\x :control) (#\f)))
+
(defun set-fill-column (column)
(if (> column 1)
(setf (auto-fill-column (current-window)) column)
@@ -244,9 +253,21 @@
(define-named-command com-beginning-of-line ()
(beginning-of-line (point (current-window))))
+(set-key 'com-beginning-of-line 'global-climacs-table
+ '((:home)))
+
+(set-key 'com-beginning-of-line 'global-climacs-table
+ '((#\a :control)))
+
(define-named-command com-end-of-line ()
(end-of-line (point (current-window))))
+(set-key 'com-end-of-line 'global-climacs-table
+ '((#\e :control)))
+
+(set-key 'com-end-of-line 'global-climacs-table
+ '((:end)))
+
(define-named-command com-delete-object ((count 'integer :prompt "Number of Objects")
(killp 'boolean :prompt "Kill?"))
(let* ((point (point (current-window)))
@@ -257,6 +278,16 @@
(region-to-sequence point mark)))
(delete-region point mark)))
+(set-key `(com-delete-object ,*numeric-argument-marker*
+ ,*numeric-argument-p*)
+ 'global-climacs-table
+ '(#\Rubout))
+
+(set-key `(com-delete-object ,*numeric-argument-marker*
+ ,*numeric-argument-p*)
+ 'global-climacs-table
+ '((#\d :control)))
+
(define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects")
(killp 'boolean :prompt "Kill?"))
(let* ((point (point (current-window)))
@@ -267,6 +298,11 @@
(region-to-sequence mark point)))
(delete-region mark point)))
+(set-key `(com-backward-delete-object ,*numeric-argument-marker*
+ ,*numeric-argument-p*)
+ 'global-climacs-table
+ '(#\Backspace))
+
(define-named-command com-zap-to-object ()
(let* ((item (handler-case (accept 't :prompt "Zap to Object")
(error () (progn (beep)
@@ -293,27 +329,46 @@
(search-forward item-mark item)
(delete-range current-point (- (offset item-mark) current-offset))))
-(define-named-command com-transpose-objects ()
- (transpose-objects (point (current-window))))
+(set-key 'com-zap-to-character 'global-climacs-table
+ '((#\z :meta)))
(defun transpose-objects (mark)
(unless (beginning-of-buffer-p mark)
- (when (end-of-line-p mark)
- (backward-object mark))
- (let ((object (object-after mark)))
- (delete-range mark)
- (backward-object mark)
- (insert-object mark object)
- (forward-object mark))))
+ (when (end-of-line-p mark)
+ (backward-object mark))
+ (let ((object (object-after mark)))
+ (delete-range mark)
+ (backward-object mark)
+ (insert-object mark object)
+ (forward-object mark))))
+
+(define-named-command com-transpose-objects ()
+ (transpose-objects (point (current-window))))
+
+(set-key 'com-transponse-objects 'global-climacs-table
+ '((#\t :control)))
(define-named-command com-backward-object ((count 'integer :prompt "Number of Objects"))
(backward-object (point (current-window)) count))
+(set-key `(com-backward-object ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\b :control)))
+
+(set-key `(com-backward-object ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((:left)))
+
(define-named-command com-forward-object ((count 'integer :prompt "Number of Objects"))
(forward-object (point (current-window)) count))
-(define-named-command com-transpose-words ()
- (transpose-words (point (current-window))))
+(set-key `(com-forward-object ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\f :control)))
+
+(set-key `(com-forward-object ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((:right)))
(defun transpose-words (mark)
(let (bw1 bw2 ew1 ew2)
@@ -338,8 +393,11 @@
(insert-sequence mark w2)
(forward-word mark))))
-(define-named-command com-transpose-lines ()
- (transpose-lines (point (current-window))))
+(define-named-command com-transpose-words ()
+ (transpose-words (point (current-window))))
+
+(set-key 'com-transpose-words 'global-climacs-table
+ '((#\t :meta)))
(defun transpose-lines (mark)
(beginning-of-line mark)
@@ -363,6 +421,12 @@
(insert-sequence mark line)
(insert-object mark #\Newline)))
+(define-named-command com-transpose-lines ()
+ (transpose-lines (point (current-window))))
+
+(set-key 'com-transpose-lines 'global-climacs-table
+ '((#\x :control) (#\t :control)))
+
(define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?"))
(let* ((win (current-window))
(point (point win)))
@@ -373,6 +437,14 @@
(previous-line point (slot-value win 'goal-column) numarg)
(next-line point (slot-value win 'goal-column) (- numarg)))))
+(set-key `(com-previous-line ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\p :control)))
+
+(set-key `(com-previous-line ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((:up)))
+
(define-named-command com-next-line ((numarg 'integer :prompt "How many lines?"))
(let* ((win (current-window))
(point (point win)))
@@ -383,9 +455,21 @@
(next-line point (slot-value win 'goal-column) numarg)
(previous-line point (slot-value win 'goal-column) (- numarg)))))
+(set-key `(com-next-line ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\n :control)))
+
+(set-key `(com-next-line ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((:down)))
+
(define-named-command com-open-line ((numarg 'integer :prompt "How many lines?"))
(open-line (point (current-window)) numarg))
+(set-key `(com-open-line ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\o :control)))
+
(defun kill-line (mark &optional (count 1) (whole-lines-p nil) (concatenate-p nil))
(let ((start (offset mark)))
(cond ((= 0 count)
@@ -421,14 +505,34 @@
(concatenate-p (eq (previous-command pane) 'com-kill-line)))
(kill-line point numarg numargp concatenate-p)))
+(set-key `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-p*)
+ 'global-climacs-table
+ '((#\k :control)))
+
(define-named-command com-forward-word ((count 'integer :prompt "Number of words"))
(if (plusp count)
(forward-word (point (current-window)) count)
(backward-word (point (current-window)) (- count))))
+(set-key `(com-forward-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\f :meta)))
+
+(set-key `(com-forward-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((:right :control)))
+
(define-named-command com-backward-word ((count 'integer :prompt "Number of words"))
(backward-word (point (current-window)) count))
+(set-key `(com-backward-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\b :meta)))
+
+(set-key `(com-backward-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((:left :control)))
+
(define-named-command com-delete-word ((count 'integer :prompt "Number of words"))
(delete-word (point (current-window)) count))
@@ -458,12 +562,20 @@
(concatenate-p (eq (previous-command pane) 'com-kill-word)))
(kill-word point count concatenate-p)))
+(set-key `(com-kill-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\d :meta)))
+
(define-named-command com-backward-kill-word ((count 'integer :prompt "Number of words"))
(let* ((pane (current-window))
(point (point pane))
(concatenate-p (eq (previous-command pane) 'com-backward-kill-word)))
(kill-word point (- count) concatenate-p)))
+(set-key `(com-backward-kill-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\Backspace :meta)))
+
(define-named-command com-mark-word ((count 'integer :prompt "Number of words"))
(let* ((pane (current-window))
(point (point pane))
@@ -474,6 +586,10 @@
(forward-word mark count)
(backward-word mark (- count)))))
+(set-key `(com-mark-word ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\@ :meta :shift)))
+
(define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words"))
(backward-delete-word (point (current-window)) count))
@@ -492,12 +608,21 @@
(define-named-command com-upcase-word ()
(upcase-word (point (current-window))))
+(set-key 'com-upcase-word 'global-climacs-table
+ '((#\u :meta)))
+
(define-named-command com-downcase-word ()
(downcase-word (point (current-window))))
+(set-key 'com-downcase-word 'global-climacs-table
+ '((#\l :meta)))
+
(define-named-command com-capitalize-word ()
(capitalize-word (point (current-window))))
+(set-key 'com-capitalize-word 'global-climacs-table
+ '((#\c :meta)))
+
(define-named-command com-tabify-region ()
(let ((pane (current-window)))
(tabify-region
@@ -523,15 +648,27 @@
(point (point pane)))
(indent-current-line pane point)))
+(set-key 'com-indent-line 'global-climacs-table
+ '((#\Tab)))
+
+(set-key 'com-indent-line 'global-climacs-table
+ '((#\i :control)))
+
(define-named-command com-newline-and-indent ()
(let* ((pane (current-window))
(point (point pane)))
(insert-object point #\Newline)
(indent-current-line pane point)))
+(set-key 'com-newline-and-indent 'global-climacs-table
+ '((#\j :control)))
+
(define-named-command com-delete-indentation ()
(delete-indentation (point (current-window))))
+(set-key 'com-delete-indentation 'global-climacs-table
+ '((#\^ :shift :meta)))
+
(define-named-command com-auto-fill-mode ()
(let ((pane (current-window)))
(setf (auto-fill-mode pane) (not (auto-fill-mode pane)))))
@@ -556,6 +693,9 @@
(possibly-fill-line)
(setf (offset point) (offset point-backup)))))
+(set-key 'com-fill-paragraph 'global-climacs-table
+ '((#\q :meta)))
+
(eval-when (:compile-toplevel :load-toplevel)
(define-presentation-type completable-pathname ()
:inherit-from 'pathname))
@@ -715,6 +855,9 @@
:prompt "Find File")))
(find-file filepath)))
+(set-key 'com-find-file 'global-climacs-table
+ '((#\x :control) (#\f :control)))
+
(defun find-file-read-only (filepath)
(cond ((null filepath)
(display-message "No file name given.")
@@ -755,10 +898,16 @@
(let ((filepath (accept 'completable-pathname :Prompt "Find file read only")))
(find-file-read-only filepath)))
+(set-key 'com-find-file-read-only 'global-climacs-table
+ '((#\x :control) (#\r :control)))
+
(define-named-command com-toggle-read-only ()
(let ((buffer (buffer (current-window))))
(setf (read-only-p buffer) (not (read-only-p buffer)))))
+(set-key 'com-toggle-read-only 'global-climacs-table
+ '((#\x :control) (#\q :control)))
+
(defun set-visited-file-name (filename buffer)
(setf (filepath buffer) filename
(name buffer) (filepath-filename filename)
@@ -782,6 +931,9 @@
(offset (point pane)) (offset (mark pane))))
(redisplay-frame-panes *application-frame*)))
+(set-key 'com-insert-file 'global-climacs-table
+ '((#\x :control) (#\i :control)))
+
(defgeneric erase-buffer (buffer))
(defmethod erase-buffer ((buffer string))
@@ -844,6 +996,9 @@
(save-buffer buffer)
(display-message "No changes need to be saved from ~a" (name buffer)))))
+(set-key 'com-save-buffer 'global-climacs-table
+ '((#\x :control) (#\s :control)))
+
(defmethod frame-exit :around ((frame climacs))
(loop for buffer in (buffers frame)
when (and (needs-saving buffer)
@@ -877,6 +1032,9 @@
(needs-saving buffer) nil)
(display-message "Wrote: ~a" (filepath buffer))))))
+(set-key 'com-write-buffer 'global-climacs-table
+ '((#\x :control) (#\w :control)))
+
(define-presentation-method present (object (type buffer)
stream
(view textual-view)
@@ -933,6 +1091,9 @@
:default-type 'buffer)))
(switch-to-buffer buffer)))
+(set-key 'com-switch-to-buffer 'global-climacs-table
+ '((#\x :control) (#\b)))
+
(defgeneric kill-buffer (buffer))
(defmethod kill-buffer ((buffer climacs-buffer))
@@ -964,9 +1125,15 @@
:default-type 'buffer)))
(kill-buffer buffer)))
+(set-key 'com-kill-buffer 'global-climacs-table
+ '((#\x :control) (#\k)))
+
(define-named-command com-full-redisplay ()
(full-redisplay (current-window)))
+(set-key 'com-full-redisplay 'global-climacs-table
+ '((#\l :control)))
+
(defun load-file (file-name)
(cond ((directory-pathname-p file-name)
(display-message "~A is a directory name." file-name)
@@ -983,24 +1150,54 @@
:prompt "Load File")))
(load-file filepath)))
+(set-key 'com-load-file 'global-climacs-table
+ '((#\c :control) (#\l :control)))
+
(define-named-command com-beginning-of-buffer ()
(beginning-of-buffer (point (current-window))))
+(set-key 'com-beginning-of-buffer 'global-climacs-table
+ '((#\< :shift :meta)))
+
+(set-key 'com-beginning-of-buffer 'global-climacs-table
+ '((:home :control)))
+
(define-named-command com-page-down ()
(let ((pane (current-window)))
(page-down pane)))
+(set-key 'com-page-down 'global-climacs-table
+ '((#\v :control)))
+
+(set-key 'com-page-down 'global-climacs-table
+ '((:next)))
+
(define-named-command com-page-up ()
(let ((pane (current-window)))
(page-up pane)))
+(set-key 'com-page-up 'global-climacs-table
+ '((#\v :meta)))
+
+(set-key 'com-page-up 'global-climacs-table
+ '((:prior)))
+
(define-named-command com-end-of-buffer ()
(end-of-buffer (point (current-window))))
+(set-key 'com-end-of-buffer 'global-climacs-table
+ '((#\> :shift :meta)))
+
+(set-key 'com-end-of-buffer 'global-climacs-table
+ '((:end :control)))
+
(define-named-command com-mark-whole-buffer ()
(beginning-of-buffer (point (current-window)))
(end-of-buffer (mark (current-window))))
+(set-key 'com-mark-whole-buffer 'global-climacs-table
+ '((#\x :control) (#\h)))
+
(defun back-to-indentation (mark)
(beginning-of-line mark)
(loop until (end-of-line-p mark)
@@ -1010,6 +1207,9 @@
(define-named-command com-back-to-indentation ()
(back-to-indentation (point (current-window))))
+(set-key 'com-back-to-indentation 'global-climacs-table
+ '((#\m :meta)))
+
(defun delete-horizontal-space (mark &optional (backward-only-p nil))
(let ((mark2 (clone-mark mark)))
(loop until (beginning-of-line-p mark)
@@ -1025,6 +1225,10 @@
'boolean :prompt "Delete backwards only?"))
(delete-horizontal-space (point (current-window)) backward-only-p))
+(set-key `(com-delete-horizontal-space ,*numeric-argument-p*)
+ 'global-climacs-table
+ '((#\\ :meta)))
+
(defun just-one-space (mark count)
(let (offset)
(loop until (beginning-of-line-p mark)
@@ -1042,6 +1246,10 @@
(define-named-command com-just-one-space ((count 'integer :prompt "Number of spaces"))
(just-one-space (point (current-window)) count))
+(set-key `(com-just-one-space ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\Space :meta)))
+
(defun goto-position (mark pos)
(setf (offset mark) pos))
@@ -1081,11 +1289,17 @@
(let ((pane (current-window)))
(setf (mark pane) (clone-mark (point pane)))))
+(set-key 'com-set-mark 'global-climacs-table
+ '((#\Space :control)))
+
(define-named-command com-exchange-point-and-mark ()
(let ((pane (current-window)))
(psetf (offset (mark pane)) (offset (point pane))
(offset (point pane)) (offset (mark pane)))))
+(set-key 'com-exchange-point-and-mark 'global-climacs-table
+ '((#\x :control) (#\x :control)))
+
(defgeneric set-syntax (buffer syntax))
(defmethod set-syntax ((buffer climacs-buffer) (syntax syntax))
@@ -1188,6 +1402,9 @@
(define-named-command com-split-window-vertically ()
(split-window-vertically))
+(set-key 'com-split-window-vertically 'global-climacs-table
+ '((#\x :control) (#\2)))
+
(defun split-window-horizontally (&optional (pane (current-window)))
(with-look-and-feel-realization
((frame-manager *application-frame*) *application-frame*)
@@ -1210,6 +1427,9 @@
(define-named-command com-split-window-horizontally ()
(split-window-horizontally))
+(set-key 'com-split-window-horizontally 'global-climacs-table
+ '((#\x :control) (#\3)))
+
(defun other-window ()
(setf (windows *application-frame*)
(append (cdr (windows *application-frame*))
@@ -1219,6 +1439,9 @@
(define-named-command com-other-window ()
(other-window))
+(set-key 'com-other-window 'global-climacs-table
+ '((#\x :control) (#\o)))
+
(defun single-window ()
(loop until (null (cdr (windows *application-frame*)))
do (rotatef (car (windows *application-frame*))
@@ -1229,16 +1452,25 @@
(define-named-command com-single-window ()
(single-window))
+(set-key 'com-single-window 'global-climacs-table
+ '((#\x :control) (#\1)))
+
(define-named-command com-scroll-other-window ()
(let ((other-window (second (windows *application-frame*))))
(when other-window
(page-down other-window))))
+(set-key 'com-scroll-other-window 'global-climacs-table
+ '((#\v :control :meta)))
+
(define-named-command com-scroll-other-window-up ()
(let ((other-window (second (windows *application-frame*))))
(when other-window
(page-up other-window))))
+(set-key 'com-scroll-other-window-up 'global-climacs-table
+ '((#\V :control :meta :shift)))
+
(defun delete-window (&optional (window (current-window)))
(unless (null (cdr (windows *application-frame*)))
(let* ((constellation (if *with-scrollbars*
@@ -1271,6 +1503,9 @@
(define-named-command com-delete-window ()
(delete-window))
+(set-key 'com-delete-window 'global-climacs-table
+ '((#\x :control) (#\0)))
+
;;;;;;;;;;;;;;;;;;;;
;; Kill ring commands
@@ -1278,6 +1513,9 @@
(define-named-command com-yank ()
(insert-sequence (point (current-window)) (kill-ring-yank *kill-ring*)))
+(set-key 'com-yank 'global-climacs-table
+ '((#\y :control)))
+
;; Destructively cut a given buffer region into the kill-ring
(define-named-command com-kill-region ()
(let ((pane (current-window)))
@@ -1285,11 +1523,17 @@
*kill-ring* (region-to-sequence (mark pane) (point pane)))
(delete-region (mark pane) (point pane))))
+(set-key 'com-kill-region 'global-climacs-table
+ '((#\w :control)))
+
;; Non destructively copies buffer region to the kill ring
(define-named-command com-copy-region ()
(let ((pane (current-window)))
(kill-ring-standard-push *kill-ring* (region-to-sequence (point pane) (mark pane)))))
+(set-key 'com-copy-region 'global-climacs-table
+ '((#\w :control)))
+
(define-named-command com-rotate-yank ()
(let* ((pane (current-window))
(point (point pane))
@@ -1301,6 +1545,9 @@
(rotate-yank-position *kill-ring*)))
(insert-sequence point (kill-ring-yank *kill-ring*))))
+(set-key 'com-rotate-yank 'global-climacs-table
+ '((#\y :meta)))
+
(define-named-command com-resize-kill-ring ()
(let ((size (handler-case (accept 'integer :prompt "New kill ring size")
(error () (progn (beep)
@@ -1311,6 +1558,9 @@
(define-named-command com-append-next-kill ()
(setf (append-next-p *kill-ring*) t))
+(set-key 'com-append-next-kill 'global-climacs-table
+ '((#\w :control :meta)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Incremental search
@@ -1364,10 +1614,16 @@
(display-message "Isearch: ")
(isearch-command-loop (current-window) t))
+(set-key 'com-isearch-forward 'global-climacs-table
+ '((#\s :control)))
+
(define-named-command com-isearch-backward ()
(display-message "Isearch backward: ")
(isearch-command-loop (current-window) nil))
+(set-key 'com-isearch-backward 'global-climacs-table
+ '((#\r :control)))
+
(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) ()
(let* ((pane (current-window))
(states (isearch-states pane))
@@ -1493,6 +1749,9 @@
((setf (query-replace-mode pane) nil))))
(display-message "Replaced ~A occurrence~:P" occurrences)))
+(set-key 'com-query-replace 'global-climacs-table
+ '((#\% :shift :meta)))
+
(define-command (com-query-replace-replace :name t :command-table query-replace-climacs-table) ()
(declare (special string1 string2 occurrences))
(let* ((pane (current-window))
@@ -1550,11 +1809,23 @@
(no-more-undo () (beep) (display-message "No more undo")))
(full-redisplay (current-window)))
+(set-key 'com-undo 'global-climacs-table
+ '((#\_ :shift :control)))
+
+(set-key 'com-undo 'global-climacs-table
+ '((#\x :control) (#\u)))
+
(define-named-command com-redo ()
(handler-case (redo (undo-tree (buffer (current-window))))
(no-more-undo () (beep) (display-message "No more redo")))
(full-redisplay (current-window)))
+(set-key 'com-redo 'global-climacs-table
+ '((#\_ :shift :meta)))
+
+(set-key 'com-redo 'global-climacs-table
+ '((#\x :control) (#\r :control)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Dynamic abbrevs
@@ -1596,6 +1867,8 @@
(setf (offset dabbrev-expansion-mark) offset))))
(move))))))))
+(set-key 'com-dabbrev-expand 'global-climacs-table
+ '((#\/ :meta)))
(define-named-command com-backward-paragraph ((count 'integer :prompt "Number of paragraphs"))
(let* ((pane (current-window))
@@ -1605,6 +1878,10 @@
(loop repeat count do (backward-paragraph point syntax))
(loop repeat (- count) do (forward-paragraph point syntax)))))
+(set-key `(com-backward-paragraph ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\{ :shift :meta)))
+
(define-named-command com-forward-paragraph ((count 'integer :prompt "Number of paragraphs"))
(let* ((pane (current-window))
(point (point pane))
@@ -1613,6 +1890,10 @@
(loop repeat count do (forward-paragraph point syntax))
(loop repeat (- count) do (backward-paragraph point syntax)))))
+(set-key `(com-forward-paragraph ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\} :shift :meta)))
+
(define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs"))
(let* ((pane (current-window))
(point (point pane))
@@ -1627,6 +1908,10 @@
(loop repeat count do (forward-paragraph mark syntax))
(loop repeat (- count) do (backward-paragraph mark syntax)))))
+(set-key `(com-mark-paragraph ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\h :meta)))
+
(define-named-command com-backward-sentence ((count 'integer :prompt "Number of sentences"))
(let* ((pane (current-window))
(point (point pane))
@@ -1635,6 +1920,10 @@
(loop repeat count do (backward-sentence point syntax))
(loop repeat (- count) do (forward-sentence point syntax)))))
+(set-key `(com-backward-sentence ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\a :meta)))
+
(define-named-command com-forward-sentence ((count 'integer :prompt "Number of sentences"))
(let* ((pane (current-window))
(point (point pane))
@@ -1643,6 +1932,10 @@
(loop repeat count do (forward-sentence point syntax))
(loop repeat (- count) do (backward-sentence point syntax)))))
+(set-key `(com-forward-sentence ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\e :meta)))
+
(define-named-command com-kill-sentence ((count 'integer :prompt "Number of sentences"))
(let* ((pane (current-window))
(point (point pane))
@@ -1654,6 +1947,10 @@
(kill-ring-standard-push *kill-ring* (region-to-sequence point mark))
(delete-region point mark)))
+(set-key `(com-kill-sentence *numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\k :meta)))
+
(define-named-command com-backward-kill-sentence ((count 'integer :prompt "Number of sentences"))
(let* ((pane (current-window))
(point (point pane))
@@ -1665,6 +1962,10 @@
(kill-ring-standard-push *kill-ring* (region-to-sequence point mark))
(delete-region point mark)))
+(set-key `(com-backward-kill-sentence ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\x :control) (#\Backspace)))
+
(defun forward-page (mark &optional (count 1))
(loop repeat count
unless (search-forward mark (coerce (list #\Newline #\Page) 'vector))
@@ -1678,6 +1979,10 @@
(forward-page point count)
(backward-page point count))))
+(set-key `(com-forward-page ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\x :control) (#\])))
+
(defun backward-page (mark &optional (count 1))
(loop repeat count
when (search-backward mark (coerce (list #\Newline #\Page) 'vector))
@@ -1692,6 +1997,9 @@
(backward-page point count)
(forward-page point count))))
+(set-key 'com-backward-page 'global-climacs-table
+ '((#\x :control) (#\[)))
+
(define-named-command com-mark-page ((count 'integer :prompt "Move how many pages")
(numargp 'boolean :prompt "Move to another page?"))
(let* ((pane (current-window))
@@ -1705,6 +2013,10 @@
(setf (offset mark) (offset point))
(forward-page mark 1)))
+(set-key `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*)
+ 'global-climacs-table
+ '((#\x :control) (#\p :control)))
+
(define-named-command com-count-lines-page ()
(let* ((pane (current-window))
(point (point pane))
@@ -1717,6 +2029,9 @@
(after (number-of-lines-in-region point end)))
(display-message "Page has ~A lines (~A + ~A)" total before after))))
+(set-key 'com-count-lines-page 'global-climacs-table
+ '((#\x :control) (#\l)))
+
(define-named-command com-count-lines-region ()
(let* ((pane (current-window))
(point (point pane))
@@ -1725,6 +2040,9 @@
(chars (abs (- (offset point) (offset mark)))))
(display-message "Region has ~D line~:P, ~D character~:P." lines chars)))
+(set-key 'com-count-lines-region 'global-climacs-table
+ '((#\= :meta)))
+
(define-named-command com-what-cursor-position ()
(let* ((pane (current-window))
(point (point pane))
@@ -1737,6 +2055,9 @@
char (char-code char) offset size
(round (* 100 (/ offset size))) column)))
+(set-key 'com-what-cursor-position 'global-climacs-table
+ '((#\x :control) (#\=)))
+
(define-named-command com-eval-expression ((insertp 'boolean :prompt "Insert?"))
(let* ((*package* (find-package :climacs-gui))
(string (handler-case (accept 'string :prompt "Eval")
@@ -1753,6 +2074,10 @@
(insert-sequence (point (current-window)) result)
(display-message result))))
+(set-key `(com-eval-expression ,*numeric-argument-p*)
+ 'global-climacs-table
+ '((#\: :shift :meta)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Commenting
@@ -1773,6 +2098,10 @@
(loop repeat count do (backward-expression point syntax))
(loop repeat (- count) do (forward-expression point syntax)))))
+(set-key `(com-backward-expression ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\b :control :meta)))
+
(define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions"))
(let* ((pane (current-window))
(point (point pane))
@@ -1781,6 +2110,10 @@
(loop repeat count do (forward-expression point syntax))
(loop repeat (- count) do (backward-expression point syntax)))))
+(set-key `(com-forward-expression ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\f :control :meta)))
+
(define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions"))
(let* ((pane (current-window))
(point (point pane))
@@ -1792,6 +2125,10 @@
(loop repeat count do (forward-expression mark syntax))
(loop repeat (- count) do (backward-expression mark syntax)))))
+(set-key `(com-mark-expression ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\@ :shift :control :meta)))
+
(define-named-command com-kill-expression ((count 'integer :prompt "Number of expressions"))
(let* ((pane (current-window))
(point (point pane))
@@ -1803,6 +2140,10 @@
(kill-ring-standard-push *kill-ring* (region-to-sequence mark point))
(delete-region mark point)))
+(set-key `(com-kill-expression ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\k :control :meta)))
+
(define-named-command com-backward-kill-expression
((count 'integer :prompt "Number of expressions"))
(let* ((pane (current-window))
@@ -1815,6 +2156,10 @@
(kill-ring-standard-push *kill-ring* (region-to-sequence mark point))
(delete-region mark point)))
+(set-key `(com-backward-kill-expression ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\Backspace :control :meta)))
+
(define-named-command com-forward-list ((count 'integer :prompt "Number of lists"))
(let* ((pane (current-window))
(point (point pane))
@@ -1823,6 +2168,10 @@
(loop repeat count do (forward-list point syntax))
(loop repeat (- count) do (backward-list point syntax)))))
+(set-key `(com-forward-list ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\n :control :meta)))
+
(define-named-command com-backward-list ((count 'integer :prompt "Number of lists"))
(let* ((pane (current-window))
(point (point pane))
@@ -1831,6 +2180,10 @@
(loop repeat count do (backward-list point syntax))
(loop repeat (- count) do (forward-list point syntax)))))
+(set-key `(com-backward-list ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\p :control :meta)))
+
(define-named-command com-down-list ((count 'integer :prompt "Number of lists"))
(let* ((pane (current-window))
(point (point pane))
@@ -1839,6 +2192,10 @@
(loop repeat count do (down-list point syntax))
(loop repeat (- count) do (backward-down-list point syntax)))))
+(set-key `(com-down-list ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\d :control :meta)))
+
(define-named-command com-backward-down-list ((count 'integer :prompt "Number of lists"))
(let* ((pane (current-window))
(point (point pane))
@@ -1855,6 +2212,10 @@
(loop repeat count do (backward-up-list point syntax))
(loop repeat (- count) do (up-list point syntax)))))
+(set-key `(com-backward-up-list ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\u :control :meta)))
+
(define-named-command com-up-list ((count 'integer :prompt "Number of lists"))
(let* ((pane (current-window))
(point (point pane))
@@ -1869,6 +2230,9 @@
(syntax (syntax (buffer pane))))
(eval-defun point syntax)))
+(set-key 'com-eval-defun 'global-climacs-table
+ '((#\x :control :meta)))
+
(define-named-command com-beginning-of-definition ((count 'integer :prompt "Number of definitions"))
(let* ((pane (current-window))
(point (point pane))
@@ -1877,6 +2241,10 @@
(loop repeat count do (beginning-of-definition point syntax))
(loop repeat (- count) do (end-of-definition point syntax)))))
+(set-key `(com-beginning-of-definition ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\a :control :meta)))
+
(define-named-command com-end-of-definition ((count 'integer :prompt "Number of definitions"))
(let* ((pane (current-window))
(point (point pane))
@@ -1885,6 +2253,10 @@
(loop repeat count do (end-of-definition point syntax))
(loop repeat (- count) do (beginning-of-definition point syntax)))))
+(set-key `(com-end-of-definition ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\e :control :meta)))
+
(define-named-command com-mark-definition ()
(let* ((pane (current-window))
(point (point pane))
@@ -1895,6 +2267,9 @@
(setf (offset mark) (offset point)))
(end-of-definition mark syntax)))
+(set-key 'com-mark-definition 'global-climacs-table
+ '((#\h :control :meta)))
+
(define-named-command com-package ()
(let* ((pane (current-window))
(syntax (syntax (buffer pane)))
@@ -1940,159 +2315,14 @@
(define-named-command com-toggle-visible-mark ()
(setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window)))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Dead-escape command tables
-
-(make-command-table 'dead-escape-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "dead-escape"
- :menu 'dead-escape-climacs-table
- :keystroke '(:escape))
-
-(defun dead-escape-set-key (gesture command)
- (add-command-to-command-table command 'dead-escape-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-escape-set-key '(#\x) 'esa::com-extended-command)
-
-(defun global-set-key (gesture command)
- (add-command-to-command-table command 'global-climacs-table
- :keystroke gesture :errorp nil)
- (when (and
- (listp gesture)
- (find :meta gesture))
- (dead-escape-set-key (remove :meta gesture) command)))
-
(loop for code from (char-code #\Space) to (char-code #\~)
- do (global-set-key (code-char code) `(com-self-insert ,*numeric-argument-marker*)))
-
-(global-set-key #\Newline `(com-self-insert ,*numeric-argument-marker*))
-(global-set-key #\Tab 'com-indent-line)
-(global-set-key '(#\i :control) 'com-indent-line)
-(global-set-key '(#\: :shift :meta) `(com-eval-expression ,*numeric-argument-p*))
-(global-set-key '(#\j :control) 'com-newline-and-indent)
-(global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*))
-(global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))
-(global-set-key '(#\a :control) 'com-beginning-of-line)
-(global-set-key '(#\e :control) 'com-end-of-line)
-(global-set-key '(#\d :control) `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))
-(global-set-key '(#\p :control) `(com-previous-line ,*numeric-argument-marker*))
-(global-set-key '(#\l :control) 'com-full-redisplay)
-(global-set-key '(#\n :control) `(com-next-line ,*numeric-argument-marker*))
-(global-set-key '(#\o :control) `(com-open-line ,*numeric-argument-marker*))
-(global-set-key '(#\k :control) `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-p*))
-(global-set-key '(#\t :control) 'com-transpose-objects)
-(global-set-key '(#\Space :control) 'com-set-mark)
-(global-set-key '(#\y :control) 'com-yank)
-(global-set-key '(#\w :control) 'com-kill-region)
-(global-set-key '(#\w :control :meta) 'com-append-next-kill)
-(global-set-key '(#\e :meta) `(com-forward-sentence ,*numeric-argument-marker*))
-(global-set-key '(#\a :meta) `(com-backward-sentence ,*numeric-argument-marker*))
-(global-set-key '(#\k :meta) `(com-kill-sentence ,*numeric-argument-marker*))
-(global-set-key '(#\@ :meta :control :shift) `(com-mark-expression ,*numeric-argument-marker*))
-(global-set-key '(#\f :meta) `(com-forward-word ,*numeric-argument-marker*))
-(global-set-key '(#\b :meta) `(com-backward-word ,*numeric-argument-marker*))
-(global-set-key '(#\t :meta) 'com-transpose-words)
-(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 '(#\y :meta) 'com-rotate-yank)
-(global-set-key '(#\z :meta) 'com-zap-to-character)
-(global-set-key '(#\w :meta) 'com-copy-region)
-(global-set-key '(#\v :control) 'com-page-down)
-(global-set-key '(#\v :meta) 'com-page-up)
-(global-set-key '(#\v :control :meta) 'com-scroll-other-window)
-(global-set-key '(#\V :control :meta :shift) 'com-scroll-other-window-up)
-(global-set-key '(#\< :shift :meta) 'com-beginning-of-buffer)
-(global-set-key '(#\> :shift :meta) 'com-end-of-buffer)
-(global-set-key '(#\m :meta) 'com-back-to-indentation)
-(global-set-key '(#\\ :meta) `(com-delete-horizontal-space ,*numeric-argument-p*))
-(global-set-key '(#\Space :meta) `(com-just-one-space ,*numeric-argument-marker*))
-(global-set-key '(#\^ :shift :meta) 'com-delete-indentation)
-(global-set-key '(#\q :meta) 'com-fill-paragraph)
-(global-set-key '(#\d :meta) `(com-kill-word ,*numeric-argument-marker*))
-(global-set-key '(#\Backspace :meta) `(com-backward-kill-word ,*numeric-argument-marker*))
-(global-set-key '(#\@ :meta :shift) `(com-mark-word ,*numeric-argument-marker*))
-(global-set-key '(#\/ :meta) 'com-dabbrev-expand)
-(global-set-key '(#\{ :meta :shift) `(com-backward-paragraph ,*numeric-argument-marker*))
-(global-set-key '(#\} :meta :shift) `(com-forward-paragraph ,*numeric-argument-marker*))
-(global-set-key '(#\h :meta) `(com-mark-paragraph ,*numeric-argument-marker*))
-(global-set-key '(#\s :control) 'com-isearch-forward)
-(global-set-key '(#\r :control) 'com-isearch-backward)
-(global-set-key '(#\_ :shift :meta) 'com-redo)
-(global-set-key '(#\_ :shift :control) 'com-undo)
-(global-set-key '(#\% :shift :meta) 'com-query-replace)
-(global-set-key '(#\= :meta) 'com-count-lines-region)
-(global-set-key '(:up) `(com-previous-line ,*numeric-argument-marker*))
-(global-set-key '(:down) `(com-next-line ,*numeric-argument-marker*))
-(global-set-key '(:left) `(com-backward-object ,*numeric-argument-marker*))
-(global-set-key '(:right) `(com-forward-object ,*numeric-argument-marker*))
-(global-set-key '(:left :control) `(com-backward-word ,*numeric-argument-marker*))
-(global-set-key '(:right :control) `(com-forward-word ,*numeric-argument-marker*))
-(global-set-key '(:home) 'com-beginning-of-line)
-(global-set-key '(:end) 'com-end-of-line)
-(global-set-key '(:prior) 'com-page-up)
-(global-set-key '(:next) 'com-page-down)
-(global-set-key '(:home :control) 'com-beginning-of-buffer)
-(global-set-key '(:end :control) 'com-end-of-buffer)
-(global-set-key #\Rubout `(com-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))
-(global-set-key #\Backspace `(com-backward-delete-object ,*numeric-argument-marker* ,*numeric-argument-p*))
-
-(global-set-key '(:insert) 'com-toggle-overwrite-mode)
-(global-set-key '(#\~ :meta :shift) 'com-not-modified)
-
-(global-set-key '(#\b :control :meta) `(com-backward-expression ,*numeric-argument-marker*))
-(global-set-key '(#\f :control :meta) `(com-forward-expression ,*numeric-argument-marker*))
-(global-set-key '(#\Backspace :control :meta) `(com-backward-kill-expression ,*numeric-argument-marker*))
-(global-set-key '(#\k :control :meta) `(com-kill-expression ,*numeric-argument-marker*))
-(global-set-key '(#\n :control :meta) `(com-forward-list ,*numeric-argument-marker*))
-(global-set-key '(#\p :control :meta) `(com-backward-list ,*numeric-argument-marker*))
-(global-set-key '(#\d :control :meta) `(com-down-list ,*numeric-argument-marker*))
-(global-set-key '(#\u :control :meta) `(com-backward-up-list ,*numeric-argument-marker*))
-(global-set-key '(#\x :control :meta) 'com-eval-defun)
-(global-set-key '(#\a :control :meta) `(com-beginning-of-definition ,*numeric-argument-marker*))
-(global-set-key '(#\e :control :meta) `(com-end-of-definition ,*numeric-argument-marker*))
-(global-set-key '(#\h :control :meta) 'com-mark-definition)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; C-x command table
-
-(make-command-table 'c-x-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "C-x"
- :menu 'c-x-climacs-table
- :keystroke '(#\x :control))
-
-(defun c-x-set-key (gesture command)
- (add-command-to-command-table command 'c-x-climacs-table
- :keystroke gesture :errorp nil))
-
-(c-x-set-key '(#\0) 'com-delete-window)
-(c-x-set-key '(#\1) 'com-single-window)
-(c-x-set-key '(#\2) 'com-split-window-vertically)
-(c-x-set-key '(#\3) 'com-split-window-horizontally)
-(c-x-set-key '(#\b) 'com-switch-to-buffer)
-(c-x-set-key '(#\f :control) 'com-find-file)
-(c-x-set-key '(#\r :control) 'com-find-file-read-only)
-(c-x-set-key '(#\q :control) 'com-toggle-read-only)
-(c-x-set-key '(#\f) `(com-set-fill-column ,*numeric-argument-marker*))
-(c-x-set-key '(#\h) 'com-mark-whole-buffer)
-(c-x-set-key '(#\i) 'com-insert-file)
-(c-x-set-key '(#\k) 'com-kill-buffer)
-(c-x-set-key '(#\o) 'com-other-window)
-(c-x-set-key '(#\r) 'com-redo)
-(c-x-set-key '(#\u) 'com-undo)
-(c-x-set-key '(#\]) `(com-forward-page ,*numeric-argument-marker*))
-(c-x-set-key '(#\[) `(com-backward-page ,*numeric-argument-marker*))
-(c-x-set-key '(#\p :control) `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*))
-(c-x-set-key '(#\l) 'com-count-lines-page)
-(c-x-set-key '(#\s :control) 'com-save-buffer)
-(c-x-set-key '(#\t :control) 'com-transpose-lines)
-(c-x-set-key '(#\w :control) 'com-write-buffer)
-(c-x-set-key '(#\x :control) 'com-exchange-point-and-mark)
-(c-x-set-key '(#\=) 'com-what-cursor-position)
-(c-x-set-key '(#\Backspace) `(com-backward-kill-sentence ,*numeric-argument-marker*))
+ do (set-key `(com-self-insert ,*numeric-argument-marker*)
+ 'global-climacs-table
+ (list (list (code-char code)))))
+
+(set-key `(com-self-insert ,*numeric-argument-marker*)
+ 'global-climacs-table
+ '((#\Newline)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -2101,174 +2331,78 @@
(define-named-command com-insert-charcode ((code 'integer :prompt "Code point"))
(insert-object (point (current-window)) (code-char code)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Dead-acute command table
-
-(make-command-table 'dead-acute-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "dead-acute"
- :menu 'dead-acute-climacs-table
- :keystroke '(:dead--acute))
-
-(defun dead-acute-set-key (gesture command)
- (add-command-to-command-table command 'dead-acute-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-acute-set-key '(#\A) '(com-insert-charcode 193))
-(dead-acute-set-key '(#\E) '(com-insert-charcode 201))
-(dead-acute-set-key '(#\I) '(com-insert-charcode 205))
-(dead-acute-set-key '(#\O) '(com-insert-charcode 211))
-(dead-acute-set-key '(#\U) '(com-insert-charcode 218))
-(dead-acute-set-key '(#\Y) '(com-insert-charcode 221))
-(dead-acute-set-key '(#\a) '(com-insert-charcode 225))
-(dead-acute-set-key '(#\e) '(com-insert-charcode 233))
-(dead-acute-set-key '(#\i) '(com-insert-charcode 237))
-(dead-acute-set-key '(#\o) '(com-insert-charcode 243))
-(dead-acute-set-key '(#\u) '(com-insert-charcode 250))
-(dead-acute-set-key '(#\y) '(com-insert-charcode 253))
-(dead-acute-set-key '(#\C) '(com-insert-charcode 199))
-(dead-acute-set-key '(#\c) '(com-insert-charcode 231))
-(dead-acute-set-key '(#\x) '(com-insert-charcode 215))
-(dead-acute-set-key '(#\-) '(com-insert-charcode 247))
-(dead-acute-set-key '(#\T) '(com-insert-charcode 222))
-(dead-acute-set-key '(#\t) '(com-insert-charcode 254))
-(dead-acute-set-key '(#\s) '(com-insert-charcode 223))
-(dead-acute-set-key '(#\Space) '(com-insert-charcode 39))
-
-(make-command-table 'dead-acute-dead-accute-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'dead-acute-climacs-table "dead-acute-dead-accute"
- :menu 'dead-acute-dead-accute-climacs-table
- :keystroke '(:dead--acute))
-
-(defun dead-acute-dead-accute-set-key (gesture command)
- (add-command-to-command-table command 'dead-acute-dead-accute-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-acute-dead-accute-set-key '(#\A) '(com-insert-charcode 197))
-(dead-acute-dead-accute-set-key '(#\a) '(com-insert-charcode 229))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Dead-grave command table
-
-(make-command-table 'dead-grave-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "dead-grave"
- :menu 'dead-grave-climacs-table
- :keystroke '(:dead--grave))
-
-(defun dead-grave-set-key (gesture command)
- (add-command-to-command-table command 'dead-grave-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-grave-set-key '(#\A) '(com-insert-charcode 192))
-(dead-grave-set-key '(#\E) '(com-insert-charcode 200))
-(dead-grave-set-key '(#\I) '(com-insert-charcode 204))
-(dead-grave-set-key '(#\O) '(com-insert-charcode 210))
-(dead-grave-set-key '(#\U) '(com-insert-charcode 217))
-(dead-grave-set-key '(#\a) '(com-insert-charcode 224))
-(dead-grave-set-key '(#\e) '(com-insert-charcode 232))
-(dead-grave-set-key '(#\i) '(com-insert-charcode 236))
-(dead-grave-set-key '(#\o) '(com-insert-charcode 242))
-(dead-grave-set-key '(#\u) '(com-insert-charcode 249))
-(dead-grave-set-key '(#\Space) '(com-insert-charcode 96))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Dead-diaeresis command table
-
-(make-command-table 'dead-diaeresis-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "dead-diaeresis"
- :menu 'dead-diaeresis-climacs-table
- :keystroke '(:dead--diaeresis :shift))
-
-(defun dead-diaeresis-set-key (gesture command)
- (add-command-to-command-table command 'dead-diaeresis-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-diaeresis-set-key '(#\A) '(com-insert-charcode 196))
-(dead-diaeresis-set-key '(#\E) '(com-insert-charcode 203))
-(dead-diaeresis-set-key '(#\I) '(com-insert-charcode 207))
-(dead-diaeresis-set-key '(#\O) '(com-insert-charcode 214))
-(dead-diaeresis-set-key '(#\U) '(com-insert-charcode 220))
-(dead-diaeresis-set-key '(#\a) '(com-insert-charcode 228))
-(dead-diaeresis-set-key '(#\e) '(com-insert-charcode 235))
-(dead-diaeresis-set-key '(#\i) '(com-insert-charcode 239))
-(dead-diaeresis-set-key '(#\o) '(com-insert-charcode 246))
-(dead-diaeresis-set-key '(#\u) '(com-insert-charcode 252))
-(dead-diaeresis-set-key '(#\y) '(com-insert-charcode 255))
-(dead-diaeresis-set-key '(#\Space) '(com-insert-charcode 34))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Dead-tilde command table
-
-(make-command-table 'dead-tilde-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "dead-tilde"
- :menu 'dead-tilde-climacs-table
- :keystroke '(:dead--tilde :shift))
-
-(defun dead-tilde-set-key (gesture command)
- (add-command-to-command-table command 'dead-tilde-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-tilde-set-key '(#\A) '(com-insert-charcode 195))
-(dead-tilde-set-key '(#\N) '(com-insert-charcode 209))
-(dead-tilde-set-key '(#\a) '(com-insert-charcode 227))
-(dead-tilde-set-key '(#\n) '(com-insert-charcode 241))
-(dead-tilde-set-key '(#\E) '(com-insert-charcode 198))
-(dead-tilde-set-key '(#\e) '(com-insert-charcode 230))
-(dead-tilde-set-key '(#\D) '(com-insert-charcode 208))
-(dead-tilde-set-key '(#\d) '(com-insert-charcode 240))
-(dead-tilde-set-key '(#\O) '(com-insert-charcode 216))
-(dead-tilde-set-key '(#\o) '(com-insert-charcode 248))
-(dead-tilde-set-key '(#\Space) '(com-insert-charcode 126))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Dead-circumflex command table
-
-(make-command-table 'dead-circumflex-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "dead-circumflex"
- :menu 'dead-circumflex-climacs-table
- :keystroke '(:dead--circumflex :shift))
-
-(defun dead-circumflex-set-key (gesture command)
- (add-command-to-command-table command 'dead-circumflex-climacs-table
- :keystroke gesture :errorp nil))
-
-(dead-circumflex-set-key '(#\A) '(com-insert-charcode 194))
-(dead-circumflex-set-key '(#\E) '(com-insert-charcode 202))
-(dead-circumflex-set-key '(#\I) '(com-insert-charcode 206))
-(dead-circumflex-set-key '(#\O) '(com-insert-charcode 212))
-(dead-circumflex-set-key '(#\U) '(com-insert-charcode 219))
-(dead-circumflex-set-key '(#\a) '(com-insert-charcode 226))
-(dead-circumflex-set-key '(#\e) '(com-insert-charcode 234))
-(dead-circumflex-set-key '(#\i) '(com-insert-charcode 238))
-(dead-circumflex-set-key '(#\o) '(com-insert-charcode 244))
-(dead-circumflex-set-key '(#\u) '(com-insert-charcode 251))
-(dead-circumflex-set-key '(#\Space) '(com-insert-charcode 94))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; C-c command table
-
-(make-command-table 'c-c-climacs-table :errorp nil)
-
-(add-menu-item-to-command-table 'global-climacs-table "C-c"
- :menu 'c-c-climacs-table
- :keystroke '(#\c :control))
-
-(defun c-c-set-key (gesture command)
- (add-command-to-command-table command 'c-c-climacs-table
- :keystroke gesture :errorp nil))
-
-(c-c-set-key '(#\l :control) 'com-load-file)
+(set-key '(com-insert-charcode 193) 'global-climacs-table '((:dead--acute)(#\A)))
+(set-key '(com-insert-charcode 201) 'global-climacs-table '((:dead--acute)(#\E)))
+(set-key '(com-insert-charcode 205) 'global-climacs-table '((:dead--acute)(#\I)))
+(set-key '(com-insert-charcode 211) 'global-climacs-table '((:dead--acute)(#\O)))
+(set-key '(com-insert-charcode 218) 'global-climacs-table '((:dead--acute)(#\U)))
+(set-key '(com-insert-charcode 221) 'global-climacs-table '((:dead--acute)(#\Y)))
+(set-key '(com-insert-charcode 225) 'global-climacs-table '((:dead--acute)(#\a)))
+(set-key '(com-insert-charcode 233) 'global-climacs-table '((:dead--acute)(#\e)))
+(set-key '(com-insert-charcode 237) 'global-climacs-table '((:dead--acute)(#\i)))
+(set-key '(com-insert-charcode 243) 'global-climacs-table '((:dead--acute)(#\o)))
+(set-key '(com-insert-charcode 250) 'global-climacs-table '((:dead--acute)(#\u)))
+(set-key '(com-insert-charcode 253) 'global-climacs-table '((:dead--acute)(#\y)))
+(set-key '(com-insert-charcode 199) 'global-climacs-table '((:dead--acute)(#\C)))
+(set-key '(com-insert-charcode 231) 'global-climacs-table '((:dead--acute)(#\c)))
+(set-key '(com-insert-charcode 215) 'global-climacs-table '((:dead--acute)(#\x)))
+(set-key '(com-insert-charcode 247) 'global-climacs-table '((:dead--acute)(#\-)))
+(set-key '(com-insert-charcode 222) 'global-climacs-table '((:dead--acute)(#\T)))
+(set-key '(com-insert-charcode 254) 'global-climacs-table '((:dead--acute)(#\t)))
+(set-key '(com-insert-charcode 223) 'global-climacs-table '((:dead--acute)(#\s)))
+(set-key '(com-insert-charcode 39) 'global-climacs-table '((:dead--acute)(#\Space)))
+
+(set-key '(com-insert-charcode 197) 'global-climacs-table '((:dead--acute)(:dead--acute)(#\A)))
+(set-key '(com-insert-charcode 229) 'global-climacs-table '((:dead--acute)(:dead--acute)(#\a)))
+
+(set-key '(com-insert-charcode 192) 'global-climacs-table '((:dead--grave)(#\A)))
+(set-key '(com-insert-charcode 200) 'global-climacs-table '((:dead--grave)(#\E)))
+(set-key '(com-insert-charcode 204) 'global-climacs-table '((:dead--grave)(#\I)))
+(set-key '(com-insert-charcode 210) 'global-climacs-table '((:dead--grave)(#\O)))
+(set-key '(com-insert-charcode 217) 'global-climacs-table '((:dead--grave)(#\U)))
+(set-key '(com-insert-charcode 224) 'global-climacs-table '((:dead--grave)(#\a)))
+(set-key '(com-insert-charcode 232) 'global-climacs-table '((:dead--grave)(#\e)))
+(set-key '(com-insert-charcode 236) 'global-climacs-table '((:dead--grave)(#\i)))
+(set-key '(com-insert-charcode 242) 'global-climacs-table '((:dead--grave)(#\o)))
+(set-key '(com-insert-charcode 249) 'global-climacs-table '((:dead--grave)(#\u)))
+(set-key '(com-insert-charcode 96) 'global-climacs-table '((:dead--grave)(#\Space)))
+
+(set-key '(com-insert-charcode 196) 'global-climacs-table '((:dead--diaeresis :shift)(#\A)))
+(set-key '(com-insert-charcode 203) 'global-climacs-table '((:dead--diaeresis :shift)(#\E)))
+(set-key '(com-insert-charcode 207) 'global-climacs-table '((:dead--diaeresis :shift)(#\I)))
+(set-key '(com-insert-charcode 214) 'global-climacs-table '((:dead--diaeresis :shift)(#\O)))
+(set-key '(com-insert-charcode 220) 'global-climacs-table '((:dead--diaeresis :shift)(#\U)))
+(set-key '(com-insert-charcode 228) 'global-climacs-table '((:dead--diaeresis :shift)(#\a)))
+(set-key '(com-insert-charcode 235) 'global-climacs-table '((:dead--diaeresis :shift)(#\e)))
+(set-key '(com-insert-charcode 239) 'global-climacs-table '((:dead--diaeresis :shift)(#\i)))
+(set-key '(com-insert-charcode 246) 'global-climacs-table '((:dead--diaeresis :shift)(#\o)))
+(set-key '(com-insert-charcode 252) 'global-climacs-table '((:dead--diaeresis :shift)(#\u)))
+(set-key '(com-insert-charcode 255) 'global-climacs-table '((:dead--diaeresis :shift)(#\y)))
+(set-key '(com-insert-charcode 34) 'global-climacs-table '((:dead--diaeresis :shift)(#\Space)))
+
+(set-key '(com-insert-charcode 195) 'global-climacs-table '((:dead--tilde :shift)(#\A)))
+(set-key '(com-insert-charcode 209) 'global-climacs-table '((:dead--tilde :shift)(#\N)))
+(set-key '(com-insert-charcode 227) 'global-climacs-table '((:dead--tilde :shift)(#\a)))
+(set-key '(com-insert-charcode 241) 'global-climacs-table '((:dead--tilde :shift)(#\n)))
+(set-key '(com-insert-charcode 198) 'global-climacs-table '((:dead--tilde :shift)(#\E)))
+(set-key '(com-insert-charcode 230) 'global-climacs-table '((:dead--tilde :shift)(#\e)))
+(set-key '(com-insert-charcode 208) 'global-climacs-table '((:dead--tilde :shift)(#\D)))
+(set-key '(com-insert-charcode 240) 'global-climacs-table '((:dead--tilde :shift)(#\d)))
+(set-key '(com-insert-charcode 216) 'global-climacs-table '((:dead--tilde :shift)(#\O)))
+(set-key '(com-insert-charcode 248) 'global-climacs-table '((:dead--tilde :shift)(#\o)))
+(set-key '(com-insert-charcode 126) 'global-climacs-table '((:dead--tilde :shift)(#\Space)))
+
+(set-key '(com-insert-charcode 194) 'global-climacs-table '((:dead--circumflex :shift)(#\A)))
+(set-key '(com-insert-charcode 202) 'global-climacs-table '((:dead--circumflex :shift)(#\E)))
+(set-key '(com-insert-charcode 206) 'global-climacs-table '((:dead--circumflex :shift)(#\I)))
+(set-key '(com-insert-charcode 212) 'global-climacs-table '((:dead--circumflex :shift)(#\O)))
+(set-key '(com-insert-charcode 219) 'global-climacs-table '((:dead--circumflex :shift)(#\U)))
+(set-key '(com-insert-charcode 226) 'global-climacs-table '((:dead--circumflex :shift)(#\a)))
+(set-key '(com-insert-charcode 234) 'global-climacs-table '((:dead--circumflex :shift)(#\e)))
+(set-key '(com-insert-charcode 238) 'global-climacs-table '((:dead--circumflex :shift)(#\i)))
+(set-key '(com-insert-charcode 244) 'global-climacs-table '((:dead--circumflex :shift)(#\o)))
+(set-key '(com-insert-charcode 251) 'global-climacs-table '((:dead--circumflex :shift)(#\u)))
+(set-key '(com-insert-charcode 94) 'global-climacs-table '((:dead--circumflex :shift)(#\Space)))
(define-named-command com-regex-search-forward ()
(let ((string (accept 'string :prompt "RE search"
Index: climacs/esa.lisp
diff -u climacs/esa.lisp:1.13 climacs/esa.lisp:1.14
--- climacs/esa.lisp:1.13 Sat Aug 6 22:51:20 2005
+++ climacs/esa.lisp Tue Aug 30 19:28:52 2005
@@ -301,7 +301,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
-;;; comand table manipulation
+;;; command table manipulation
(defun ensure-subtable (table gesture)
(let* ((event (make-instance
@@ -319,15 +319,18 @@
(command-menu-item-value
(find-keystroke-item event table :errorp nil))))
-
(defun set-key (command table gestures)
- (if (null (cdr gestures))
- (add-command-to-command-table
- command table :keystroke (car gestures) :errorp nil)
- (set-key command
- (ensure-subtable table (car gestures))
- (cdr gestures))))
-
+ (let ((gesture (car gestures)))
+ (cond ((null (cdr gestures))
+ (add-command-to-command-table
+ command table :keystroke gesture :errorp nil)
+ (when (and (listp gesture)
+ (find :meta gesture))
+ (set-key command table (list (list :escape) (remove :meta gesture)))))
+ (t (set-key command
+ (ensure-subtable table gesture)
+ (cdr gestures))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; standard key bindings
