[climacs-cvs] CVS update: climacs/syntax.lisp climacs/slidemacs-gui.lisp climacs/pane.lisp climacs/packages.lisp climacs/lisp-syntax.lisp climacs/gui.lisp climacs/esa.lisp

13 Sep 2005

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv7426
Modified Files:
    syntax.lisp slidemacs-gui.lisp pane.lisp packages.lisp 
    lisp-syntax.lisp gui.lisp esa.lisp 
Log Message:
Two major groups of changes, as steps towards supporting
the multi-pane paradigm: (a) changes to support non-buffer-
containing panes (a typeout pane is the first example - try
C-h b); (b) distributed commands among a plethora of little
command tables, as threatened on the mailing list.
Also: changed info-pane (again) - now includes call to
name-for-info-pane (specialised on syntax) - try a lisp file
where climacs can work out the package name; got rid of
'Toggle' names (didn't add anything); mouse-clicks now change
window and position the cursor; now command Insert Parentheses
(M-() that almost works.
Slidemacs temporarily broken...
Date: Tue Sep 13 21:24:00 2005
Author: dmurray
Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.57 climacs/syntax.lisp:1.58

--- climacs/syntax.lisp:1.57	Wed Aug 17 01:10:29 2005
+++ climacs/syntax.lisp	Tue Sep 13 21:23:59 2005
@@ -148,6 +148,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; Name for info-pane
+
+(defgeneric name-for-info-pane (syntax))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; Syntax completion
(defparameter *syntaxes* '())
@@ -240,6 +246,9 @@
 (defmethod update-syntax-for-display (buffer (syntax basic-syntax) from to)
   (declare (ignore buffer from to))
   nil)
+
+(defmethod name-for-info-pane ((syntax basic-syntax))
+  (name syntax))
(defmethod syntax-line-indentation (mark tab-width (syntax basic-syntax))
   (declare (ignore mark tab-width))
Index: climacs/slidemacs-gui.lisp
diff -u climacs/slidemacs-gui.lisp:1.18 climacs/slidemacs-gui.lisp:1.19
--- climacs/slidemacs-gui.lisp:1.18	Thu Sep  1 02:21:08 2005
+++ climacs/slidemacs-gui.lisp	Tue Sep 13 21:23:59 2005
@@ -35,6 +35,8 @@
 (defvar *current-slideset*)
 (defvar *did-display-a-slide*)
+(make-command-table 'slidemacs-table)
+
 (defun slidemacs-entity-string (entity)
   (coerce (buffer-sequence (buffer entity)
                            (1+ (start-offset entity))
@@ -357,7 +359,7 @@
                                             (- y2 y1)))))))
(define-command (com-reveal-text :name "Reveal Text In Window"
-                                   :command-table global-command-table
+                                   :command-table slidemacs-table
                                    :menu t
                                    :provide-output-destination-keyword t)
     ((text 'string :prompt "text"))
@@ -366,7 +368,7 @@
       (write-string text stream))))
(define-presentation-to-command-translator reveal-text-translator
-    (reveal-button com-reveal-text global-command-table
+    (reveal-button com-reveal-text slidemacs-table
                    :gesture :select
                    :documentation "Reveal Text In Window"
                    :pointer-documentation "Reveal Text In Window")
@@ -478,7 +480,7 @@
            (or (word-is lexeme "info")
                (word-is lexeme "graph")))))
-(climacs-gui::define-named-command com-next-talking-point ()
+(define-command (com-next-talking-point :name t :command-table slidemacs-table) ()
   (let* ((pane (climacs-gui::current-window))
          (buffer (buffer pane))
          (syntax (syntax buffer)))
@@ -493,7 +495,7 @@
                (return (setf (offset point) (start-offset lexeme)))))
           (full-redisplay pane))))))
-(climacs-gui::define-named-command com-previous-talking-point ()
+(define-command (com-previous-talking-point :name t :command-table slidemacs-table) ()
   (let* ((pane (climacs-gui::current-window))
          (buffer (buffer pane))
          (syntax (syntax buffer)))
@@ -516,23 +518,23 @@
               collect thing
               else collect (if decrease-p (- thing 8) (+ thing 8)))))
-(climacs-gui::define-named-command com-decrease-presentation-font-sizes ()
+(define-command (com-decrease-presentation-font-sizes :name t :command-table slidemacs-table) ()
   (adjust-font-sizes t)
   (full-redisplay (climacs-gui::current-window)))
-(climacs-gui::define-named-command com-increase-presentation-font-sizes ()
+(define-command (com-increase-presentation-font-sizes :name t :command-table slidemacs-table) ()
   (adjust-font-sizes nil)
   (full-redisplay (climacs-gui::current-window)))
-(climacs-gui::define-named-command com-first-talking-point ()
+(define-command (com-first-talking-point :name t :command-table slidemacs-table) ()
   (climacs-gui::com-beginning-of-buffer)
   (com-next-talking-point))
-(climacs-gui::define-named-command com-last-talking-point ()
+(define-command (com-last-talking-point :name t :command-table slidemacs-table) ()
   (climacs-gui::com-end-of-buffer)
   (com-previous-talking-point))
-(climacs-gui::define-named-command com-flip-slidemacs-syntax ()
+(define-command (com-flip-slidemacs-syntax :name t :command-table slidemacs-table) ()
   (let* ((buffer (buffer (climacs-gui::current-window)))
          (syntax (syntax buffer)))
     (typecase syntax
@@ -544,28 +546,28 @@
                                             :buffer buffer))))))
(esa:set-key  'com-next-talking-point
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#= :control)))
 (esa:set-key  'com-previous-talking-point
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#- :control)))
 (esa:set-key  'com-increase-presentation-font-sizes
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#= :meta)))
 (esa:set-key  'com-decrease-presentation-font-sizes
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#- :meta)))
 (esa:set-key  'com-last-talking-point
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#= :control :meta)))
 (esa:set-key  'com-first-talking-point
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#- :control :meta)))
 (esa:set-key  'com-flip-slidemacs-syntax
-	      'climacs-gui::global-climacs-table
+	      'slidemacs-table
          '((#\s :control :meta)))
-(climacs-gui::define-named-command com-postscript-print-presentation ()
+(define-command (com-postscript-print-presentation :name t :command-table slidemacs-table) ()
   (let ((pane (climacs-gui::current-window)))
     (if (not (and (typep pane 'climacs-pane)
                   (typep (syntax (buffer pane)) 'slidemacs-gui-syntax)))
Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.32 climacs/pane.lisp:1.33
--- climacs/pane.lisp:1.32	Thu Sep  1 02:21:08 2005
+++ climacs/pane.lisp	Tue Sep 13 21:23:59 2005
@@ -267,7 +267,7 @@
    (cursor-y :initform 2)
    (space-width :initform nil)
    (tab-width :initform nil)
-   (auto-fill-mode :initform t :accessor auto-fill-mode)
+   (auto-fill-mode :initform nil :accessor auto-fill-mode)
    (auto-fill-column :initform 70 :accessor auto-fill-column)
    (isearch-mode :initform nil :accessor isearch-mode)
    (isearch-states :initform '() :accessor isearch-states)
Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.81 climacs/packages.lisp:1.82
--- climacs/packages.lisp:1.81	Tue Sep  6 23:30:33 2005
+++ climacs/packages.lisp	Tue Sep 13 21:23:59 2005
@@ -107,6 +107,7 @@
       #:parse-stack-next #:parse-stack-symbol
       #:parse-stack-parse-trees #:map-over-parse-trees
       #:no-such-operation #:no-expression
+	   #:name-for-info-pane
            #:syntax-line-indentation
       #:forward-expression #:backward-expression
       #:eval-defun
Index: climacs/lisp-syntax.lisp
diff -u climacs/lisp-syntax.lisp:1.34 climacs/lisp-syntax.lisp:1.35
--- climacs/lisp-syntax.lisp:1.34	Mon Sep  5 09:07:28 2005
+++ climacs/lisp-syntax.lisp	Tue Sep 13 21:23:59 2005
@@ -43,6 +43,11 @@
   (with-slots (buffer scan) syntax
      (setf scan (clone-mark (low-mark buffer) :left))))
+(defmethod name-for-info-pane ((syntax lisp-syntax))
+  (format nil "Lisp~@[:~(~A~)~]"
+	  (when (slot-value syntax 'package)
+	    (package-name (slot-value syntax 'package)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; lexer
@@ -1571,6 +1576,31 @@
    	    (mark< mark (end-offset form)))
      do (setf (offset mark) (end-offset form))
         (loop-finish))))
+
+(defun in-type-p-in-children (children offset type)
+  (loop for child in children
+	do (cond ((< (start-offset child) offset (end-offset child))
+		  (return (if (typep child type)
+			      child
+			      (in-type-p-in-children (children child) offset type))))
+		 ((<= offset (start-offset child))
+		  (return nil))
+		 (t nil))))
+
+(defun in-type-p (mark syntax type)
+  (let ((offset (offset mark)))
+    (with-slots (stack-top) syntax
+       (if (or (null (start-offset stack-top))
+	       (>= offset (end-offset stack-top))
+	       (<= offset (start-offset stack-top)))
+	   nil)
+       (in-type-p-in-children (children stack-top) offset type))))
+
+(defun in-string-p (mark syntax)
+  (in-type-p mark syntax 'string-form))
+
+(defun in-comment-p (mark syntax)
+  (in-type-p mark syntax 'comment))
;;; shamelessly replacing SWANK code
 ;; We first work through the string removing the characters and noting
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.187 climacs/gui.lisp:1.188
--- climacs/gui.lisp:1.187	Tue Sep  6 23:30:33 2005
+++ climacs/gui.lisp	Tue Sep 13 21:23:59 2005
@@ -53,38 +53,93 @@
 (defparameter *with-scrollbars* t
   "If T, classic look and feel. If NIL, stripped-down look (:")
+;;; Basic functionality
+(make-command-table 'base-table)
+;;; buffers
+(make-command-table 'buffer-table)
+;;; case
+(make-command-table 'case-table)
+;;; comments
+(make-command-table 'comment-table)
+;;; deleting
+(make-command-table 'deletion-table)
+;;; commands used for climacs development
+(make-command-table 'development-table)
+;;; editing - making changes to a buffer
+(make-command-table 'editing-table)
+;;; filling
+(make-command-table 'fill-table)
+;;; indentation
+(make-command-table 'indent-table)
+;;; information about the buffer
+(make-command-table 'info-table)
+;;; lisp-related commands
+(make-command-table 'lisp-table)
+;;; marking things
+(make-command-table 'marking-table)
+;;; moving around
+(make-command-table 'movement-table)
+;;; panes
+(make-command-table 'pane-table)
+;;; searching
+(make-command-table 'search-table)
+;;; self-insertion
+(make-command-table 'self-insert-table)
+;;; windows
+(make-command-table 'window-table)
+
 (define-application-frame climacs (standard-application-frame
    			   esa-frame-mixin)
   ((buffers :initform '() :accessor buffers))
-  (:command-table (global-climacs-table :inherit-from (global-esa-table keyboard-macro-table
-									help-table)))
+  (:command-table (global-climacs-table
+		   :inherit-from (global-esa-table
+				  keyboard-macro-table
+				  help-table
+				  base-table
+				  buffer-table
+				  case-table
+				  comment-table
+				  deletion-table
+				  development-table
+				  editing-table
+				  fill-table
+				  indent-table
+				  info-table
+				  lisp-table
+				  marking-table
+				  movement-table
+				  pane-table
+				  search-table
+				  self-insert-table
+				  window-table)))
   (:menu-bar nil)
   (:panes
-   (window (let* ((extended-pane 
-		(make-pane 'extended-pane
-			   :width 900 :height 400
-			   :end-of-line-action :scroll
-			   :incremental-redisplay t
-			   :display-function 'display-window
-			   :command-table 'global-climacs-table))
-	       (info-pane
-		(make-pane 'climacs-info-pane
-			   :master-pane extended-pane
-			   :width 900)))
-	  (setf (windows *application-frame*) (list extended-pane)
-		(buffers *application-frame*) (list (buffer extended-pane)))
+   (climacs-window
+    (let* ((extended-pane 
+	    (make-pane 'extended-pane
+		       :width 900 :height 400
+		       :end-of-line-action :scroll
+		       :incremental-redisplay t
+		       :display-function 'display-window
+		       :command-table 'global-climacs-table))
+	   (info-pane
+	    (make-pane 'climacs-info-pane
+		       :master-pane extended-pane
+		       :width 900)))
+      (setf (windows *application-frame*) (list extended-pane)
+	    (buffers *application-frame*) (list (buffer extended-pane)))
      
-	  (vertically ()
-	    (if *with-scrollbars*
-		(scrolling ()
-		  extended-pane)
-		extended-pane)
-	    info-pane)))
+      (vertically ()
+	(if *with-scrollbars*
+	    (scrolling ()
+	      extended-pane)
+	    extended-pane)
+	info-pane)))
    (minibuffer (make-pane 'climacs-minibuffer-pane :width 900)))
   (:layouts
    (default
        (vertically (:scroll-bars nil)
-	 window
+	 climacs-window
     minibuffer)))
   (:top-level (esa-top-level)))
@@ -93,7 +148,9 @@
(defmethod redisplay-frame-panes :around ((frame climacs) &rest args)
   (declare (ignore args))
-  (let ((buffers (remove-duplicates (mapcar #'buffer (windows frame)))))
+  (let ((buffers (remove-duplicates (loop for pane in (windows frame)
+					  when (typep pane 'extended-pane)
+					    collect (buffer pane)))))
     (loop for buffer in buffers
      do (update-syntax buffer (syntax buffer)))
     (call-next-method)
@@ -116,52 +173,56 @@
     (buffer (buffer master-pane))
     (size (size buffer))
     (top (top master-pane))
-	 (bot (bot master-pane))
-	 (name-info (format nil "~3T~A~
-                                 ~3@T~A~
-                                 ~:[~30T~A~;~*~]~
-                                 ~3@T~:[(~;Syntax: ~]~
-                                 ~A~
-                                 ~{~:[~*~; ~A~]~}~
-                                 ~:[)~;~]~
-                                 ~3@T~A"
-			    (cond ((and (needs-saving buffer)
-					(read-only-p buffer)
-					"%*"))
-				  ((needs-saving buffer) "**")
-				  ((read-only-p buffer) "%%")
-				  (t "--"))
-			    (name buffer)
-			    *with-scrollbars*
-			    (cond ((and (mark= size bot)
-					(mark= 0 top))
-				   "")
-				  ((mark= size bot)
-				   "Bot")
-				  ((mark= 0 top)
-				   "Top")
-				  (t (format nil "~a%"
-					     (round (* 100 (/ (offset top)
-							      size))))))
-			    *with-scrollbars*
-			    (name (syntax buffer))
-			    (list
-			     (slot-value master-pane 'overwrite-mode)
-			     "Ovwrt"
-			     (auto-fill-mode master-pane)
-			     "Fill"
-			     (isearch-mode master-pane)
-			     "Isearch")
-			    *with-scrollbars*
-			    (if (recordingp *application-frame*)
-				"Def"
-				""))))
-    (princ name-info pane)))
-
-(defun display-window (frame pane)
-  "The display function used by the climacs application frame."
-  (declare (ignore frame))
-  (redisplay-pane pane (eq pane (current-window))))
+	 (bot (bot master-pane)))
+    (formatting-table (pane)
+      (formatting-row (pane)
+	(formatting-cell (pane :align-x :right :min-width '(5 :character))
+	  (princ (cond ((and (needs-saving buffer)
+			     (read-only-p buffer)
+			     "%*"))
+		       ((needs-saving buffer) "**")
+		       ((read-only-p buffer) "%%")
+		       (t "--"))
+		 pane))
+	(formatting-cell (pane :min-width '(25 :character))
+	  (princ "  " pane)
+	  (with-text-face (pane :bold)
+	    (princ (name buffer) pane)))
+	(formatting-cell (pane :min-width '(5 :character))
+	  (princ (cond ((and (mark= size bot)
+			     (mark= 0 top))
+			"")
+		       ((mark= size bot)
+			"Bot")
+		       ((mark= 0 top)
+			"Top")
+		       (t (format nil "~a%"
+				  (round (* 100 (/ (offset top)
+						   size))))))
+		 pane))
+	(formatting-cell (pane)
+	  (with-text-family (pane :sans-serif)
+	    (princ #( pane)
+	    (princ (name-for-info-pane (syntax buffer)) pane)
+	    (format pane "~{~:[~*~; ~A~]~}" (list
+					 (slot-value master-pane 'overwrite-mode)
+					 "Ovwrt"
+					 (auto-fill-mode master-pane)
+					 "Fill"
+					 (isearch-mode master-pane)
+					 "Isearch"))
+	    (princ #) pane)))
+	(formatting-cell (pane)
+	  (with-text-family (pane :sans-serif)
+	    (princ (if (recordingp *application-frame*)
+		       "Def"
+		       "")
+		   pane))))))
+
+  (defun display-window (frame pane)
+    "The display function used by the climacs application frame."
+    (declare (ignore frame))
+    (redisplay-pane pane (eq pane (current-window)))))
(defmethod handle-repaint :before ((pane extended-pane) region)
   (declare (ignore region))
@@ -171,8 +232,10 @@
(defmethod execute-frame-command :around ((frame climacs) command)
   (handler-case
-      (with-undo ((buffer (current-window)))
-	(call-next-method))
+      (if (typep (current-window) 'extended-pane)
+	  (with-undo ((buffer (current-window)))
+	    (call-next-method))
+	  (call-next-method))
     (offset-before-beginning ()
       (beep) (display-message "Beginning of buffer"))
     (offset-after-end ()
@@ -193,29 +256,27 @@
    do (when (modified-p buffer)
         (setf (needs-saving buffer) t))))
-(defmacro define-named-command (command-name args &body 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 ()
+(define-command (com-overwrite-mode :name t :command-table editing-table) ()
   (with-slots (overwrite-mode) (current-window)
     (setf overwrite-mode (not overwrite-mode))))
-(set-key 'com-toggle-overwrite-mode 'global-climacs-table
+(set-key 'com-overwrite-mode
+	 'editing-table
     '((:insert)))
-(define-named-command com-not-modified ()
+(define-command (com-not-modified :name t :command-table buffer-table) ()
   (setf (needs-saving (buffer (current-window))) nil))
-(set-key 'com-not-modified 'global-climacs-table
+(set-key 'com-not-modified
+	 'buffer-table
     '((#~ :meta :shift)))
-(define-named-command com-set-fill-column ((column 'integer :prompt "Column Number:"))
+(define-command (com-set-fill-column :name t :command-table fill-table)
+    ((column 'integer :prompt "Column Number:"))
   (set-fill-column column))
-(set-key `(com-set-fill-column ,*numeric-argument-marker*) 'global-climacs-table
+(set-key `(com-set-fill-column ,*numeric-argument-marker*)
+	 'fill-table
     '((#\x :control) (#\f)))
(defun set-fill-column (column)
@@ -256,26 +317,31 @@
 (define-command com-self-insert ((count 'integer))
   (loop repeat count do (insert-character *current-gesture*)))
-(define-named-command com-beginning-of-line ()
+(define-command (com-beginning-of-line :name t :command-table movement-table) ()
   (beginning-of-line (point (current-window))))
-(set-key 'com-beginning-of-line 'global-climacs-table
+(set-key 'com-beginning-of-line
+	 'movement-table
     '((:home)))
-(set-key 'com-beginning-of-line 'global-climacs-table
+(set-key 'com-beginning-of-line
+	 'movement-table
     '((#\a :control)))
-(define-named-command com-end-of-line ()
+(define-command (com-end-of-line :name t :command-table movement-table) ()
   (end-of-line (point (current-window))))
-(set-key 'com-end-of-line 'global-climacs-table
+(set-key 'com-end-of-line
+	 'movement-table
     '((#\e :control)))
-(set-key 'com-end-of-line 'global-climacs-table
+(set-key 'com-end-of-line
+	 'movement-table
     '((:end)))
-(define-named-command com-delete-object ((count 'integer :prompt "Number of Objects")
-					 (killp 'boolean :prompt "Kill?"))
+(define-command (com-delete-object :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of Objects")
+     (killp 'boolean :prompt "Kill?"))
   (let* ((point (point (current-window)))
     (mark (clone-mark point)))
     (forward-object mark count)
@@ -286,16 +352,17 @@
(set-key `(com-delete-object ,*numeric-argument-marker*
    		     ,*numeric-argument-p*)
-	 'global-climacs-table
+	 'deletion-table
     '(#\Rubout))
(set-key `(com-delete-object ,*numeric-argument-marker*
    		     ,*numeric-argument-p*)
-	 'global-climacs-table
+	 'deletion-table
     '((#\d :control)))
-(define-named-command com-backward-delete-object ((count 'integer :prompt "Number of Objects")
-						  (killp 'boolean :prompt "Kill?"))
+(define-command (com-backward-delete-object :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of Objects")
+     (killp 'boolean :prompt "Kill?"))
   (let* ((point (point (current-window)))
     (mark (clone-mark point)))
     (backward-object mark count)
@@ -306,10 +373,10 @@
(set-key `(com-backward-delete-object ,*numeric-argument-marker*
    			      ,*numeric-argument-p*)
-	 'global-climacs-table
+	 'deletion-table
     '(#\Backspace))
-(define-named-command com-zap-to-object ()
+(define-command (com-zap-to-object :name t :command-table deletion-table) ()
   (let* ((item (handler-case (accept 't :prompt "Zap to Object")
    	(error () (progn (beep)
    			 (display-message "Not a valid object")
@@ -320,7 +387,7 @@
     (search-forward item-mark (vector item))
     (delete-range current-point (- (offset item-mark) current-offset))))
-(define-named-command com-zap-to-character ()
+(define-command (com-zap-to-character :name t :command-table deletion-table) ()
   (let* ((item-string (handler-case (accept 'string :prompt "Zap to Character") ; Figure out how to get #\d and d.  (or 'string 'character)?
    	(error () (progn (beep)
    			 (display-message "Not a valid string. ")
@@ -335,7 +402,8 @@
   (search-forward item-mark item)
   (delete-range current-point (- (offset item-mark) current-offset))))
-(set-key 'com-zap-to-character 'global-climacs-table
+(set-key 'com-zap-to-character
+	 'deletion-table
     '((#\z :meta)))
(defun transpose-objects (mark)
@@ -348,32 +416,35 @@
       (insert-object mark object)
       (forward-object mark))))
-(define-named-command com-transpose-objects ()
+(define-command (com-transpose-objects :name t :command-table editing-table) ()
   (transpose-objects (point (current-window))))
-(set-key 'com-transpose-objects 'global-climacs-table
+(set-key 'com-transpose-objects
+	 'editing-table
     '((#\t :control)))
-(define-named-command com-backward-object ((count 'integer :prompt "Number of Objects"))
+(define-command (com-backward-object :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of Objects"))
   (backward-object (point (current-window)) count))
(set-key `(com-backward-object ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\b :control)))
(set-key `(com-backward-object ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((:left)))
-(define-named-command com-forward-object ((count 'integer :prompt "Number of Objects"))
+(define-command (com-forward-object :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of Objects"))
   (forward-object (point (current-window)) count))
(set-key `(com-forward-object ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\f :control)))
(set-key `(com-forward-object ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((:right)))
(defun transpose-words (mark)
@@ -399,10 +470,11 @@
       (insert-sequence mark w2)
       (forward-word mark))))
-(define-named-command com-transpose-words ()
+(define-command (com-transpose-words :name t :command-table editing-table) ()
   (transpose-words (point (current-window))))
-(set-key 'com-transpose-words 'global-climacs-table
+(set-key 'com-transpose-words
+	 'editing-table
     '((#\t :meta)))
(defun transpose-lines (mark)
@@ -427,13 +499,15 @@
     (insert-sequence mark line)
     (insert-object mark #\Newline)))
-(define-named-command com-transpose-lines ()
+(define-command (com-transpose-lines :name t :command-table editing-table) ()
   (transpose-lines (point (current-window))))
-(set-key 'com-transpose-lines 'global-climacs-table
+(set-key 'com-transpose-lines
+	 'editing-table
     '((#\x :control) (#\t :control)))
-(define-named-command com-previous-line ((numarg 'integer :prompt "How many lines?"))
+(define-command (com-previous-line :name t :command-table movement-table)
+    ((numarg 'integer :prompt "How many lines?"))
   (let* ((window (current-window))
     (point (point window)))
     (unless (or (eq (previous-command window) 'com-previous-line)
@@ -444,14 +518,15 @@
    (next-line point (slot-value window 'goal-column) (- numarg)))))
(set-key `(com-previous-line ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\p :control)))
(set-key `(com-previous-line ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((:up)))
-(define-named-command com-next-line ((numarg 'integer :prompt "How many lines?"))
+(define-command (com-next-line :name t :command-table movement-table)
+    ((numarg 'integer :prompt "How many lines?"))
   (let* ((window (current-window))
     (point (point window)))
     (unless (or (eq (previous-command window) 'com-previous-line)
@@ -462,18 +537,19 @@
    (previous-line point (slot-value window 'goal-column) (- numarg)))))
(set-key `(com-next-line ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\n :control)))
(set-key `(com-next-line ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((:down)))
-(define-named-command com-open-line ((numarg 'integer :prompt "How many lines?"))
+(define-command (com-open-line :name t :command-table editing-table)
+    ((numarg 'integer :prompt "How many lines?"))
   (open-line (point (current-window)) numarg))
(set-key `(com-open-line ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'editing-table
     '((#\o :control)))
(defun kill-line (mark &optional (count 1) (whole-lines-p nil) (concatenate-p nil))
@@ -504,42 +580,45 @@
    			   (region-to-sequence start mark)))
       (delete-region start mark))))
-(define-named-command com-kill-line ((numarg 'integer :prompt "Kill how many lines?")
-				     (numargp 'boolean :prompt "Kill entire lines?"))
+(define-command (com-kill-line :name t :command-table deletion-table)
+    ((numarg 'integer :prompt "Kill how many lines?")
+     (numargp 'boolean :prompt "Kill entire lines?"))
   (let* ((pane (current-window))
     (point (point pane))
          (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
+	 'deletion-table
     '((#\k :control)))
-(define-named-command com-forward-word ((count 'integer :prompt "Number of words"))
+(define-command (com-forward-word :name t :command-table movement-table)
+    ((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
+	 'movement-table
     '((#\f :meta)))
(set-key `(com-forward-word ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((:right :control)))
-(define-named-command com-backward-word ((count 'integer :prompt "Number of words"))
+(define-command (com-backward-word :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of words"))
   (backward-word (point (current-window)) count))
(set-key `(com-backward-word ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\b :meta)))
(set-key `(com-backward-word ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((:left :control)))
-(define-named-command com-delete-word ((count 'integer :prompt "Number of words"))
+(define-command (com-delete-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words"))
   (delete-word (point (current-window)) count))
(defun kill-word (mark &optional (count 1) (concatenate-p nil))
@@ -562,27 +641,30 @@
    			   (region-to-sequence start mark)))
       (delete-region start mark))))
-(define-named-command com-kill-word ((count 'integer :prompt "Number of words"))
+(define-command (com-kill-word :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of words"))
   (let* ((pane (current-window))
     (point (point pane))
     (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
+	 'deletion-table
     '((#\d :meta)))
-(define-named-command com-backward-kill-word ((count 'integer :prompt "Number of words"))
+(define-command (com-backward-kill-word :name t :command-table deletion-table)
+    ((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
+	 'deletion-table
     '((#\Backspace :meta)))
-(define-named-command com-mark-word ((count 'integer :prompt "Number of words"))
+(define-command (com-mark-word :name t :command-table marking-table)
+    ((count 'integer :prompt "Number of words"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (mark pane)))
@@ -593,48 +675,52 @@
    (backward-word mark (- count)))))
(set-key `(com-mark-word ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'marking-table
     '((#@ :meta :shift)))
-(define-named-command com-backward-delete-word ((count 'integer :prompt "Number of words"))
+(define-command (com-backward-delete-word :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of words"))
   (backward-delete-word (point (current-window)) count))
-(define-named-command com-upcase-region ()
+(define-command (com-upcase-region :name t :command-table case-table) ()
   (let ((cw (current-window)))
     (upcase-region (mark cw) (point cw))))
-(define-named-command com-downcase-region ()
+(define-command (com-downcase-region :name t :command-table case-table) ()
   (let ((cw (current-window)))
     (downcase-region (mark cw) (point cw))))
-(define-named-command com-capitalize-region ()
+(define-command (com-capitalize-region :name t :command-table case-table) ()
   (let ((cw (current-window)))
     (capitalize-region (mark cw) (point cw))))
-(define-named-command com-upcase-word ()
+(define-command (com-upcase-word :name t :command-table case-table) ()
   (upcase-word (point (current-window))))
-(set-key 'com-upcase-word 'global-climacs-table
+(set-key 'com-upcase-word
+	 'case-table
     '((#\u :meta)))
-(define-named-command com-downcase-word ()
+(define-command (com-downcase-word :name t :command-table case-table) ()
   (downcase-word (point (current-window))))
-(set-key 'com-downcase-word 'global-climacs-table
+(set-key 'com-downcase-word
+	 'case-table
     '((#\l :meta)))
-(define-named-command com-capitalize-word ()
+(define-command (com-capitalize-word :name t :command-table case-table) ()
   (capitalize-word (point (current-window))))
-(set-key 'com-capitalize-word 'global-climacs-table
+(set-key 'com-capitalize-word
+	 'case-table
     '((#\c :meta)))
-(define-named-command com-tabify-region ()
+(define-command (com-tabify-region :name t :command-table editing-table) ()
   (let ((pane (current-window)))
     (tabify-region
      (mark pane) (point pane) (tab-space-count (stream-default-view pane)))))
-(define-named-command com-untabify-region ()
+(define-command (com-untabify-region :name t :command-table editing-table) ()
   (let ((pane (current-window)))
     (untabify-region
      (mark pane) (point pane) (tab-space-count (stream-default-view pane)))))
@@ -649,37 +735,41 @@
     (indent-line point indentation (and (indent-tabs-mode buffer)
                                         tab-space-count))))
-(define-named-command com-indent-line ()
+(define-command (com-indent-line :name t :command-table indent-table) ()
   (let* ((pane (current-window))
          (point (point pane)))
     (indent-current-line pane point)))
-(set-key 'com-indent-line 'global-climacs-table
+(set-key 'com-indent-line
+	 'indent-table
     '((#\Tab)))
-(set-key 'com-indent-line 'global-climacs-table
+(set-key 'com-indent-line
+	 'indent-table
     '((#\i :control)))
-(define-named-command com-newline-and-indent ()
+(define-command (com-newline-and-indent :name t :command-table indent-table) ()
   (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
+(set-key 'com-newline-and-indent
+	 'indent-table
     '((#\j :control)))
-(define-named-command com-delete-indentation ()
+(define-command (com-delete-indentation :name t :command-table indent-table) ()
   (delete-indentation (point (current-window))))
-(set-key 'com-delete-indentation 'global-climacs-table
+(set-key 'com-delete-indentation
+	 'indent-table
     '((#^ :shift :meta)))
-(define-named-command com-auto-fill-mode ()
+(define-command (com-auto-fill-mode :name t :command-table fill-table) ()
   (let ((pane (current-window)))
     (setf (auto-fill-mode pane) (not (auto-fill-mode pane)))))
-(define-named-command com-fill-paragraph ()
+(define-command (com-fill-paragraph :name t :command-table fill-table) ()
   (let* ((pane (current-window))
          (buffer (buffer pane))
          (syntax (syntax buffer))
@@ -699,7 +789,8 @@
       (possibly-fill-line)
       (setf (offset point) (offset point-backup)))))
-(set-key 'com-fill-paragraph 'global-climacs-table
+(set-key 'com-fill-paragraph
+	 'fill-table
     '((#\q :meta)))
(defun filename-completer (so-far mode)
@@ -849,11 +940,12 @@
    	 (redisplay-frame-panes *application-frame*)
    	 buffer))))))
-(define-named-command com-find-file ()
+(define-command (com-find-file :name t :command-table buffer-table) ()
   (let* ((filepath (accept 'pathname :prompt "Find File")))
     (find-file filepath)))
-(set-key 'com-find-file 'global-climacs-table
+(set-key 'com-find-file
+	 'buffer-table
     '((#\x :control) (#\f :control)))
(defun find-file-read-only (filepath)
@@ -892,18 +984,20 @@
    	     (beep)
    	     nil)))))))
-(define-named-command com-find-file-read-only ()
+(define-command (com-find-file-read-only :name t :command-table buffer-table) ()
   (let ((filepath (accept 'pathname :Prompt "Find file read only")))
     (find-file-read-only filepath)))
-(set-key 'com-find-file-read-only 'global-climacs-table
+(set-key 'com-find-file-read-only
+	 'buffer-table
     '((#\x :control) (#\r :control)))
-(define-named-command com-toggle-read-only ()
+(define-command (com-read-only :name t :command-table buffer-table) ()
   (let ((buffer (buffer (current-window))))
     (setf (read-only-p buffer) (not (read-only-p buffer)))))
-(set-key 'com-toggle-read-only 'global-climacs-table
+(set-key 'com-read-only
+	 'buffer-table
     '((#\x :control) (#\q :control)))
(defun set-visited-file-name (filename buffer)
@@ -911,11 +1005,11 @@
    (name buffer) (filepath-filename filename)
    (needs-saving buffer) t))
-(define-named-command com-set-visited-file-name ()
+(define-command (com-set-visited-file-name :name t :command-table buffer-table) ()
   (let ((filename (accept 'pathname :prompt "New file name")))
     (set-visited-file-name filename (buffer (current-window)))))
-(define-named-command com-insert-file ()
+(define-command (com-insert-file :name t :command-table buffer-table) ()
   (let ((filename (accept 'pathname :prompt "Insert File"))
    (pane (current-window)))
     (when (probe-file filename)
@@ -928,7 +1022,8 @@
         (offset (point pane)) (offset (mark pane))))
     (redisplay-frame-panes *application-frame*)))
-(set-key 'com-insert-file 'global-climacs-table
+(set-key 'com-insert-file
+	 'buffer-table
     '((#\x :control) (#\i :control)))
(defgeneric erase-buffer (buffer))
@@ -945,7 +1040,7 @@
     (end-of-buffer point)
     (delete-region mark point)))
-(define-named-command com-revert-buffer ()
+(define-command (com-revert-buffer :name t :command-table buffer-table) ()
   (let* ((pane (current-window))
     (buffer (buffer pane))
     (filepath (filepath buffer))
@@ -985,14 +1080,15 @@
        (display-message "Wrote: ~a" (filepath buffer))
        (setf (needs-saving buffer) nil)))))
-(define-named-command com-save-buffer ()
+(define-command (com-save-buffer :name t :command-table buffer-table) ()
   (let ((buffer (buffer (current-window))))
     (if (or (null (filepath buffer))
        (needs-saving buffer))
    (save-buffer buffer)
    (display-message "No changes need to be saved from ~a" (name buffer)))))
-(set-key 'com-save-buffer 'global-climacs-table
+(set-key 'com-save-buffer
+	 'buffer-table
     '((#\x :control) (#\s :control)))
(defmethod frame-exit :around ((frame climacs))
@@ -1013,7 +1109,7 @@
    		       (return-from frame-exit nil)))))
     (call-next-method)))
-(define-named-command com-write-buffer ()
+(define-command (com-write-buffer :name t :command-table buffer-table) ()
   (let ((filepath (accept 'pathname :prompt "Write Buffer to File"))
    (buffer (buffer (current-window))))
     (cond
@@ -1027,7 +1123,8 @@
         (needs-saving buffer) nil)
        (display-message "Wrote: ~a" (filepath buffer))))))
-(set-key 'com-write-buffer 'global-climacs-table
+(set-key 'com-write-buffer
+	 'buffer-table
     '((#\x :control) (#\w :control)))
(define-presentation-method present (object (type buffer)
@@ -1079,14 +1176,15 @@
 (defmethod switch-to-buffer ((symbol (eql 'nil)))
   (switch-to-buffer (second (buffers *application-frame*))))
-(define-named-command com-switch-to-buffer ()
+(define-command (com-switch-to-buffer :name t :command-table pane-table) ()
   (let ((buffer (accept 'buffer
    		:prompt "Switch to buffer"
    		:default (second (buffers *application-frame*))
    		:default-type 'buffer)))
     (switch-to-buffer buffer)))
-(set-key 'com-switch-to-buffer 'global-climacs-table
+(set-key 'com-switch-to-buffer
+	 'pane-table
     '((#\x :control) (#\b)))
(defgeneric kill-buffer (buffer))
@@ -1113,20 +1211,22 @@
 (defmethod kill-buffer ((symbol (eql 'nil)))
   (kill-buffer (buffer (current-window))))
-(define-named-command com-kill-buffer ()
+(define-command (com-kill-buffer :name t :command-table pane-table) ()
   (let ((buffer (accept 'buffer
    		:prompt "Kill buffer"
    		:default (buffer (current-window))
    		:default-type 'buffer)))
     (kill-buffer buffer)))
-(set-key 'com-kill-buffer 'global-climacs-table
+(set-key 'com-kill-buffer
+	 'pane-table
     '((#\x :control) (#\k)))
-(define-named-command com-full-redisplay ()
+(define-command (com-full-redisplay :name t :command-table base-table) ()
   (full-redisplay (current-window)))
-(set-key 'com-full-redisplay 'global-climacs-table
+(set-key 'com-full-redisplay
+	 'base-table
     '((#\l :control)))
(defun load-file (file-name)
@@ -1140,56 +1240,66 @@
    	(display-message "No such file: ~A" file-name)
    	(beep))))))
-(define-named-command com-load-file ()
+(define-command (com-load-file :name t :command-table base-table) ()
   (let ((filepath (accept 'pathname :prompt "Load File")))
     (load-file filepath)))
-(set-key 'com-load-file 'global-climacs-table
+(set-key 'com-load-file
+	 'base-table
     '((#\c :control) (#\l :control)))
-(define-named-command com-beginning-of-buffer ()
+(define-command (com-beginning-of-buffer :name t :command-table movement-table) ()
   (beginning-of-buffer (point (current-window))))
-(set-key 'com-beginning-of-buffer 'global-climacs-table
+(set-key 'com-beginning-of-buffer
+	 'movement-table
     '((#< :shift :meta)))
-(set-key 'com-beginning-of-buffer 'global-climacs-table
+(set-key 'com-beginning-of-buffer
+	 'movement-table
     '((:home :control)))
-(define-named-command com-page-down ()
+(define-command (com-page-down :name t :command-table movement-table) ()
   (let ((pane (current-window)))
     (page-down pane)))
-(set-key 'com-page-down 'global-climacs-table
+(set-key 'com-page-down
+	 'movement-table
     '((#\v :control)))
-(set-key 'com-page-down 'global-climacs-table
+(set-key 'com-page-down
+	 'movement-table
     '((:next)))
-(define-named-command com-page-up ()
+(define-command (com-page-up :name t :command-table movement-table) ()
   (let ((pane (current-window)))
     (page-up pane)))
-(set-key 'com-page-up 'global-climacs-table
+(set-key 'com-page-up
+	 'movement-table
     '((#\v :meta)))
-(set-key 'com-page-up 'global-climacs-table
+(set-key 'com-page-up
+	 'movement-table
     '((:prior)))
-(define-named-command com-end-of-buffer ()
+(define-command (com-end-of-buffer :name t :command-table movement-table) ()
   (end-of-buffer (point (current-window))))
-(set-key 'com-end-of-buffer 'global-climacs-table
+(set-key 'com-end-of-buffer
+	 'movement-table
     '((#> :shift :meta)))
-(set-key 'com-end-of-buffer 'global-climacs-table
+(set-key 'com-end-of-buffer
+	 'movement-table
     '((:end :control)))
-(define-named-command com-mark-whole-buffer ()
+(define-command (com-mark-whole-buffer :name t :command-table marking-table) ()
   (beginning-of-buffer (point (current-window)))
   (end-of-buffer (mark (current-window))))
-(set-key 'com-mark-whole-buffer 'global-climacs-table
+(set-key 'com-mark-whole-buffer
+	 'marking-table
     '((#\x :control) (#\h)))
(defun back-to-indentation (mark)
@@ -1198,10 +1308,11 @@
    while (whitespacep (object-after mark))
    do (forward-object mark)))
-(define-named-command com-back-to-indentation ()
+(define-command (com-back-to-indentation :name t :command-table movement-table) ()
   (back-to-indentation (point (current-window))))
-(set-key 'com-back-to-indentation 'global-climacs-table
+(set-key 'com-back-to-indentation
+	 'movement-table
     '((#\m :meta)))
(defun delete-horizontal-space (mark &optional (backward-only-p nil))
@@ -1215,12 +1326,13 @@
        do (forward-object mark2)))
     (delete-region mark mark2)))
-(define-named-command com-delete-horizontal-space ((backward-only-p
-						    'boolean :prompt "Delete backwards only?"))
+(define-command (com-delete-horizontal-space :name t :command-table deletion-table)
+    ((backward-only-p
+      '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
+	 'deletion-table
     '((#\ :meta)))
(defun just-one-space (mark count)
@@ -1237,17 +1349,18 @@
      do (forward-object mark))
     (delete-region offset mark)))
-(define-named-command com-just-one-space ((count 'integer :prompt "Number of spaces"))
+(define-command (com-just-one-space :name t :command-table deletion-table)
+    ((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
+	 'deletion-table
     '((#\Space :meta)))
(defun goto-position (mark pos)
   (setf (offset mark) pos))
-(define-named-command com-goto-position ()
+(define-command (com-goto-position :name t :command-table movement-table) ()
   (goto-position
    (point (current-window))
    (handler-case (accept 'integer :prompt "Goto Position")
@@ -1267,33 +1380,35 @@
    finally (beginning-of-line m)
    	(setf (offset mark) (offset m))))
-(define-named-command com-goto-line ()
+(define-command (com-goto-line :name t :command-table movement-table) ()
   (goto-line (point (current-window))
         (handler-case (accept 'integer :prompt "Goto Line")
    	 (error () (progn (beep)
    			  (display-message "Not a valid line number")
    			  (return-from com-goto-line nil))))))
-(define-named-command com-browse-url ()
+(define-command (com-browse-url :name t :command-table base-table) ()
   (let ((url (accept 'url :prompt "Browse URL")))
     #+ (and sbcl darwin)
     (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil)
     #+ (and openmcl darwin)
     (ccl:run-program "/usr/bin/open" `(,url) :wait nil)))
-(define-named-command com-set-mark ()
+(define-command (com-set-mark :name t :command-table marking-table) ()
   (let ((pane (current-window)))
     (setf (mark pane) (clone-mark (point pane)))))
-(set-key 'com-set-mark 'global-climacs-table
+(set-key 'com-set-mark
+	 'marking-table
     '((#\Space :control)))
-(define-named-command com-exchange-point-and-mark ()
+(define-command (com-exchange-point-and-mark :name t :command-table marking-table) ()
   (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
+(set-key 'com-exchange-point-and-mark
+	 'marking-table
     '((#\x :control) (#\x :control)))
(defgeneric set-syntax (buffer syntax))
@@ -1314,7 +1429,7 @@
       (beep)
       (display-message "No such syntax: ~A." syntax)))))
-(define-named-command com-set-syntax ()
+(define-command (com-set-syntax :name t :command-table buffer-table) ()
   (let* ((pane (current-window))
     (buffer (buffer pane)))
     (set-syntax buffer (accept 'syntax :prompt "Set Syntax"))))		
@@ -1334,9 +1449,9 @@
     (sheet-disown-child parent constellation)
     (let ((new (if vertical-p
    	   (vertically ()
-		     (1/2 constellation) adjust (1/2 additional-constellation))
+		     constellation adjust additional-constellation)
    	   (horizontally ()
-		     (1/2 constellation) adjust (1/2 additional-constellation)))))
+		     constellation adjust additional-constellation))))
       (sheet-adopt-child parent new)
       (reorder-sheets parent 
    	      (if (eq constellation first)
@@ -1347,16 +1462,56 @@
    		      (list first second new)
    		      (list first new)))))))
-(defun parent3 (sheet)
-  (sheet-parent (sheet-parent (sheet-parent sheet))))
+(defun find-parent (sheet)
+  (loop for parent = (sheet-parent sheet)
+	  then (sheet-parent parent)
+	until (typep parent 'vrack-pane)
+	finally (return parent)))
+
+(defclass typeout-pane (application-pane esa-pane-mixin) ())
+
+(defun make-typeout-constellation (&optional label)
+  (let* ((typeout-pane
+	  (make-pane 'typeout-pane :width 900 :height 400 :display-time nil))
+	 (label
+	  (make-pane 'label-pane :label label))
+	 (vbox
+	  (vertically ()
+	    (scrolling (:scroll-bar :vertical) typeout-pane) label)))
+    (values vbox typeout-pane)))
+
+(defun typeout-window (&optional (label "Typeout") (pane (current-window)))
+  (with-look-and-feel-realization
+      ((frame-manager *application-frame*) *application-frame*)
+    (multiple-value-bind (vbox new-pane) (make-typeout-constellation label)
+      (let* ((current-window pane)
+	     (constellation-root (find-parent current-window)))
+	(push new-pane (windows *application-frame*))
+	(other-window)
+	(replace-constellation constellation-root vbox t)
+	(full-redisplay current-window)
+	new-pane))))
-(defun make-pane-constellation ()
+(define-command (com-describe-bindings :name t :command-table help-table)
+    ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?"))
+  (let* ((window (current-window))
+	 (buffer (buffer (current-window)))
+	 (stream (typeout-window
+		   (format nil "~10THelp: Describe Bindings for ~A" (name buffer))))
+	 (command-table (command-table window)))
+    (esa::describe-bindings stream command-table
+		       (if sort-by-keystrokes
+			   #'esa::sort-by-keystrokes
+			   #'esa::sort-by-name))))
+
+(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b)))
+
+(defun make-pane-constellation (&optional (with-scrollbars *with-scrollbars*))
   "make a vbox containing a scroller pane as its first child and an
 info pane as its second child.  The scroller pane contains a viewport
 which contains an extended pane.  Return the vbox and the extended pane
 as two values.
-If *with-scrollbars* nil, omit the scroller."
-
+If with-scrollbars nil, omit the scroller."
   (let* ((extended-pane
      (make-pane 'extended-pane
    	     :width 900 :height 400
@@ -1367,7 +1522,7 @@
    	     :command-table 'global-climacs-table))
     (vbox
      (vertically ()
-	    (if *with-scrollbars*
+	    (if with-scrollbars
    	(scrolling ()
    	  extended-pane)
    	extended-pane)
@@ -1376,68 +1531,79 @@
    	       :width 900))))
     (values vbox extended-pane)))
-(defun split-window-vertically (&optional (pane (current-window)))
+(defun split-window (&optional (vertically-p nil) (pane (current-window)))
   (with-look-and-feel-realization
       ((frame-manager *application-frame*) *application-frame*)
     (multiple-value-bind (vbox new-pane) (make-pane-constellation)
       (let* ((current-window pane)
-	     (constellation-root (if *with-scrollbars*
-				     (parent3 current-window)
-				     (sheet-parent current-window))))
+	     (constellation-root (find-parent current-window)))
         (setf (offset (point (buffer current-window))) (offset (point current-window))
          (buffer new-pane) (buffer current-window)
               (auto-fill-mode new-pane) (auto-fill-mode current-window)
               (auto-fill-column new-pane) (auto-fill-column current-window))
    (push new-pane (windows *application-frame*))
    (setf *standard-output* new-pane)
-	(replace-constellation constellation-root vbox t)
+	(replace-constellation constellation-root vbox vertically-p)
    (full-redisplay current-window)
    (full-redisplay new-pane)
    new-pane))))
-(define-named-command com-split-window-vertically ()
-  (split-window-vertically))
+(define-command (com-split-window-vertically :name t :command-table window-table) ()
+  (split-window t))
-(set-key 'com-split-window-vertically 'global-climacs-table
+(set-key 'com-split-window-vertically
+	 'window-table
     '((#\x :control) (#\2)))
-(defun split-window-horizontally (&optional (pane (current-window)))
-  (with-look-and-feel-realization
-      ((frame-manager *application-frame*) *application-frame*)
-    (multiple-value-bind (vbox new-pane) (make-pane-constellation)
-      (let* ((current-window pane)
-	     (constellation-root (if *with-scrollbars*
-				     (parent3 current-window)
-				     (sheet-parent current-window))))
-        (setf (offset (point (buffer current-window))) (offset (point current-window))
-	      (buffer new-pane) (buffer current-window)
-              (auto-fill-mode new-pane) (auto-fill-mode current-window)
-              (auto-fill-column new-pane) (auto-fill-column current-window))
-	(push new-pane (windows *application-frame*))
-	(setf *standard-output* new-pane)
-	(replace-constellation constellation-root vbox nil)
-	(full-redisplay current-window)
-	(full-redisplay new-pane)
-	new-pane))))
-
-(define-named-command com-split-window-horizontally ()
-  (split-window-horizontally))
+(define-command (com-split-window-horizontally :name t :command-table window-table) ()
+  (split-window))
-(set-key 'com-split-window-horizontally 'global-climacs-table
+(set-key 'com-split-window-horizontally
+	 'window-table
     '((#\x :control) (#\3)))
-(defun other-window ()
-  (setf (windows *application-frame*)
-	(append (cdr (windows *application-frame*))
-		(list (car (windows *application-frame*)))))
+(defun other-window (&optional pane)
+  (if (and pane (find pane (windows *application-frame*)))
+      (setf (windows *application-frame*)
+	    (append (list pane)
+		    (remove pane (windows *application-frame*))))
+      (setf (windows *application-frame*)
+	    (append (cdr (windows *application-frame*))
+		    (list (car (windows *application-frame*))))))
   (setf *standard-output* (car (windows *application-frame*))))
-
-(define-named-command com-other-window ()
+  
+(define-command (com-other-window :name t :command-table window-table) ()
   (other-window))
-(set-key 'com-other-window 'global-climacs-table
+(set-key 'com-other-window
+	 'window-table
     '((#\x :control) (#\o)))
+(define-command (com-switch-to-this-window :name nil :command-table window-table)
+    ((window 'pane) (x 'integer) (y 'integer))
+  (other-window window)
+  (with-slots (top bot) window
+     (let ((new-x (floor x (stream-character-width window #\m)))
+	   (new-y (floor y (stream-line-height window)))
+	   (buffer (buffer window)))
+       (loop for scan from (offset top)
+	     with lines = 0
+	     until (= scan (offset bot))
+	     until (= lines new-y)
+	     when (eql (buffer-object buffer scan) #\Newline)
+	       do (incf lines)
+	     finally (loop for columns from 0
+			   until (= scan (offset bot))
+			   until (eql (buffer-object buffer scan) #\Newline)
+			   until (= columns new-x)
+			   do (incf scan))
+		     (setf (offset (point window)) scan)))))
+
+(define-presentation-to-command-translator blank-area-to-switch-to-this-window
+    (blank-area com-switch-to-this-window window-table :echo nil)
+    (object window x y)
+  (list window x y))
+
 (defun single-window ()
   (loop until (null (cdr (windows *application-frame*)))
    do (rotatef (car (windows *application-frame*))
@@ -1445,33 +1611,34 @@
       (com-delete-window))
   (setf *standard-output* (car (windows *application-frame*))))
-(define-named-command com-single-window ()
+(define-command (com-single-window :name t :command-table window-table) ()
   (single-window))
-(set-key 'com-single-window 'global-climacs-table
+(set-key 'com-single-window
+	 'window-table
     '((#\x :control) (#\1)))
-(define-named-command com-scroll-other-window ()
+(define-command (com-scroll-other-window :name t :command-table window-table) ()
   (let ((other-window (second (windows *application-frame*))))
     (when other-window
       (page-down other-window))))
-(set-key 'com-scroll-other-window 'global-climacs-table
+(set-key 'com-scroll-other-window
+	 'window-table
     '((#\v :control :meta)))
-(define-named-command com-scroll-other-window-up ()
+(define-command (com-scroll-other-window-up :name t :command-table window-table) ()
   (let ((other-window (second (windows *application-frame*))))
     (when other-window
       (page-up other-window))))
-(set-key 'com-scroll-other-window-up 'global-climacs-table
+(set-key 'com-scroll-other-window-up
+	 'window-table
     '((#\V :control :meta :shift)))
(defun delete-window (&optional (window (current-window)))
   (unless (null (cdr (windows *application-frame*)))
-    (let* ((constellation (if *with-scrollbars*
-			      (parent3 window)
-			      (sheet-parent window)))
+    (let* ((constellation (find-parent window))
       (box (sheet-parent constellation))
       (box-children (sheet-children box))
       (other (if (eq constellation (first box-children))
@@ -1496,41 +1663,45 @@
    			     (list first second other)
    			     (list first other)))))))
-(define-named-command com-delete-window ()
+(define-command (com-delete-window :name t :command-table window-table) ()
   (delete-window))
-(set-key 'com-delete-window 'global-climacs-table
+(set-key 'com-delete-window
+	 'window-table
     '((#\x :control) (#\0)))
;;;;;;;;;;;;;;;;;;;;
 ;; Kill ring commands
;; Copies an element from a kill-ring to a buffer at the given offset
-(define-named-command com-yank ()
+(define-command (com-yank :name t :command-table editing-table) ()
   (insert-sequence (point (current-window)) (kill-ring-yank *kill-ring*)))
-(set-key 'com-yank 'global-climacs-table
+(set-key 'com-yank
+	 'editing-table
     '((#\y :control)))
;; Destructively cut a given buffer region into the kill-ring
-(define-named-command com-kill-region ()
+(define-command (com-kill-region :name t :command-table editing-table) ()
   (let ((pane (current-window)))
     (kill-ring-standard-push
      *kill-ring* (region-to-sequence (mark pane) (point pane)))
     (delete-region (mark pane) (point pane))))
-(set-key 'com-kill-region 'global-climacs-table
+(set-key 'com-kill-region
+	 'editing-table
     '((#\w :control)))
;; Non destructively copies buffer region to the kill ring
-(define-named-command com-copy-region ()
+(define-command (com-copy-region :name t :command-table marking-table) ()
   (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
+(set-key 'com-copy-region
+	 'marking-table
     '((#\w :meta)))
-(define-named-command com-rotate-yank ()
+(define-command (com-rotate-yank :name t :command-table editing-table) ()
   (let* ((pane (current-window))
     (point (point pane))
     (last-yank (kill-ring-yank *kill-ring*)))
@@ -1541,20 +1712,22 @@
      (rotate-yank-position *kill-ring*)))
     (insert-sequence point (kill-ring-yank *kill-ring*))))
-(set-key 'com-rotate-yank 'global-climacs-table
+(set-key 'com-rotate-yank
+	 'editing-table
     '((#\y :meta)))
-(define-named-command com-resize-kill-ring ()
+(define-command (com-resize-kill-ring :name t :command-table editing-table) ()
   (let ((size (handler-case (accept 'integer :prompt "New kill ring size")
    	(error () (progn (beep)
    			 (display-message "Not a valid kill ring size")
    			 (return-from com-resize-kill-ring nil))))))
     (setf (kill-ring-max-size *kill-ring*) size)))
-(define-named-command com-append-next-kill ()
+(define-command (com-append-next-kill :name t :command-table editing-table) ()
   (setf (append-next-p *kill-ring*) t))
-(set-key 'com-append-next-kill 'global-climacs-table
+(set-key 'com-append-next-kill
+	 'editing-table
     '((#\w :control :meta)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1606,18 +1779,20 @@
       (unless success
         (beep)))))
-(define-named-command com-isearch-forward ()
+(define-command (com-isearch-forward :name t :command-table search-table) ()
   (display-message "Isearch: ")
   (isearch-command-loop (current-window) t))
-(set-key 'com-isearch-forward 'global-climacs-table
+(set-key 'com-isearch-forward
+	 'search-table
     '((#\s :control)))
-(define-named-command com-isearch-backward ()
+(define-command (com-isearch-backward :name t :command-table search-table) ()
   (display-message "Isearch backward: ")
   (isearch-command-loop (current-window) nil))
-(set-key 'com-isearch-backward 'global-climacs-table
+(set-key 'com-isearch-backward
+	 'search-table
     '((#\r :control)))
(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) ()
@@ -1703,7 +1878,7 @@
       (search-forward mark string :test #'object-equal)
       (/= (offset mark) offset-before))))
-(define-named-command com-query-replace ()
+(define-command (com-query-replace :name t :command-table search-table) ()
   (let* ((pane (current-window))
     (old-state (query-replace-state pane))
     (old-string1 (when old-state (string1 old-state)))
@@ -1745,7 +1920,8 @@
    		   ((setf (query-replace-mode pane) nil))))
     (display-message "Replaced ~A occurrence~:P" occurrences)))
-(set-key 'com-query-replace 'global-climacs-table
+(set-key 'com-query-replace
+	 'search-table
     '((#% :shift :meta)))
(define-command (com-query-replace-replace :name t :command-table query-replace-climacs-table) ()
@@ -1800,33 +1976,37 @@
 ;;; 
 ;;; Undo/redo
-(define-named-command com-undo ()
+(define-command (com-undo :name t :command-table editing-table) ()
   (handler-case (undo (undo-tree (buffer (current-window))))
     (no-more-undo () (beep) (display-message "No more undo")))
   (full-redisplay (current-window)))
-(set-key 'com-undo 'global-climacs-table
+(set-key 'com-undo
+	 'editing-table
     '((#_ :shift :control)))
-(set-key 'com-undo 'global-climacs-table
+(set-key 'com-undo
+	 'editing-table
     '((#\x :control) (#\u)))
-(define-named-command com-redo ()
+(define-command (com-redo :name t :command-table editing-table) ()
   (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
+(set-key 'com-redo
+	 'editing-table
     '((#_ :shift :meta)))
-(set-key 'com-redo 'global-climacs-table
+(set-key 'com-redo
+	 'editing-table
     '((#\x :control) (#\r :control)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Dynamic abbrevs
-(define-named-command com-dabbrev-expand ()
+(define-command (com-dabbrev-expand :name t :command-table editing-table) ()
   (let* ((window (current-window))
     (point (point window)))
     (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) window
@@ -1863,10 +2043,12 @@
    					(setf (offset dabbrev-expansion-mark) offset))))
    	      (move))))))))
-(set-key 'com-dabbrev-expand 'global-climacs-table
+(set-key 'com-dabbrev-expand
+	 'editing-table
     '((#/ :meta)))
-(define-named-command com-backward-paragraph ((count 'integer :prompt "Number of paragraphs"))
+(define-command (com-backward-paragraph :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of paragraphs"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -1875,10 +2057,11 @@
    (loop repeat (- count) do (forward-paragraph point syntax)))))
(set-key `(com-backward-paragraph ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#{ :shift :meta)))
-(define-named-command com-forward-paragraph ((count 'integer :prompt "Number of paragraphs"))
+(define-command (com-forward-paragraph :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of paragraphs"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -1887,10 +2070,11 @@
    (loop repeat (- count) do (backward-paragraph point syntax)))))
(set-key `(com-forward-paragraph ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#} :shift :meta)))
-(define-named-command com-mark-paragraph ((count 'integer :prompt "Number of paragraphs"))
+(define-command (com-mark-paragraph :name t :command-table marking-table)
+    ((count 'integer :prompt "Number of paragraphs"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (mark pane))
@@ -1905,10 +2089,11 @@
    (loop repeat (- count) do (backward-paragraph mark syntax)))))
(set-key `(com-mark-paragraph ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'marking-table
     '((#\h :meta)))
-(define-named-command com-backward-sentence ((count 'integer :prompt "Number of sentences"))
+(define-command (com-backward-sentence :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of sentences"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -1917,10 +2102,11 @@
    (loop repeat (- count) do (forward-sentence point syntax)))))
(set-key `(com-backward-sentence ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\a :meta)))
-(define-named-command com-forward-sentence ((count 'integer :prompt "Number of sentences"))
+(define-command (com-forward-sentence :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of sentences"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -1929,10 +2115,11 @@
    (loop repeat (- count) do (backward-sentence point syntax)))))
(set-key `(com-forward-sentence ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\e :meta)))
-(define-named-command com-kill-sentence ((count 'integer :prompt "Number of sentences"))
+(define-command (com-kill-sentence :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of sentences"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (clone-mark point))
@@ -1944,10 +2131,11 @@
     (delete-region point mark)))
(set-key `(com-kill-sentence ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'deletion-table
     '((#\k :meta)))
-(define-named-command com-backward-kill-sentence ((count 'integer :prompt "Number of sentences"))
+(define-command (com-backward-kill-sentence :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of sentences"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (clone-mark point))
@@ -1959,7 +2147,7 @@
     (delete-region point mark)))
(set-key `(com-backward-kill-sentence ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'deletion-table
     '((#\x :control) (#\Backspace)))
(defun forward-page (mark &optional (count 1))
@@ -1968,7 +2156,8 @@
      do (end-of-buffer mark)
         (loop-finish)))
-(define-named-command com-forward-page ((count 'integer :prompt "Number of pages"))
+(define-command (com-forward-page :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of pages"))
   (let* ((pane (current-window))
     (point (point pane)))
     (if (plusp count)
@@ -1976,7 +2165,7 @@
    (backward-page point count))))
(set-key `(com-forward-page ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\x :control) (#])))
(defun backward-page (mark &optional (count 1))
@@ -1986,18 +2175,21 @@
      else do (beginning-of-buffer mark)
    	  (loop-finish)))
-(define-named-command com-backward-page ((count 'integer :prompt "Number of pages"))
+(define-command (com-backward-page :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of pages"))
   (let* ((pane (current-window))
     (point (point pane)))
     (if (plusp count)
    (backward-page point count)
    (forward-page point count))))
-(set-key `(com-backward-page ,*numeric-argument-marker*) 'global-climacs-table
+(set-key `(com-backward-page ,*numeric-argument-marker*)
+	 'movement-table
     '((#\x :control) (#[)))
-(define-named-command com-mark-page ((count 'integer :prompt "Move how many pages")
-				     (numargp 'boolean :prompt "Move to another page?"))
+(define-command (com-mark-page :name t :command-table marking-table)
+    ((count 'integer :prompt "Move how many pages")
+     (numargp 'boolean :prompt "Move to another page?"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (mark pane)))
@@ -2010,10 +2202,10 @@
       (forward-page mark 1)))
(set-key `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*)
-	 'global-climacs-table
+	 'marking-table
     '((#\x :control) (#\p :control)))
-(define-named-command com-count-lines-page ()
+(define-command (com-count-lines-page :name t :command-table info-table) ()
   (let* ((pane (current-window))
     (point (point pane))
     (start (clone-mark point))
@@ -2025,10 +2217,11 @@
      (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
+(set-key 'com-count-lines-page
+	 'info-table
     '((#\x :control) (#\l)))
-(define-named-command com-count-lines-region ()
+(define-command (com-count-lines-region :name t :command-table info-table) ()
   (let*  ((pane (current-window))
      (point (point pane))
      (mark (mark pane))
@@ -2036,10 +2229,11 @@
      (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
+(set-key 'com-count-lines-region
+	 'info-table
     '((#= :meta)))
-(define-named-command com-what-cursor-position ()
+(define-command (com-what-cursor-position :name t :command-table info-table) ()
   (let* ((pane (current-window))
     (point (point pane))
     (buffer (buffer pane))
@@ -2051,10 +2245,12 @@
    	     char (char-code char) offset size
    	     (round (* 100 (/ offset size))) column)))
-(set-key 'com-what-cursor-position 'global-climacs-table
+(set-key 'com-what-cursor-position
+	 'info-table
     '((#\x :control) (#=)))
-(define-named-command com-eval-expression ((insertp 'boolean :prompt "Insert?"))
+(define-command (com-eval-expression :name t :command-table base-table)
+    ((insertp 'boolean :prompt "Insert?"))
   (let* ((*package* (find-package :climacs-gui))
     (string (handler-case (accept 'string :prompt "Eval")
    	   (error () (progn (beep)
@@ -2071,7 +2267,7 @@
    (display-message result))))
(set-key `(com-eval-expression ,*numeric-argument-p*)
-	 'global-climacs-table
+	 'base-table
     '((#: :shift :meta)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2079,14 +2275,15 @@
 ;;; Commenting
;;; figure out how to make commands without key bindings accept numeric arguments. 
-(define-named-command com-comment-region ()
+(define-command (com-comment-region :name t :command-table comment-table) ()
   (let* ((pane (current-window))
     (point (point pane))
     (mark (mark pane))
     (syntax (syntax (buffer pane))))
     (comment-region syntax point mark)))
-(define-named-command com-backward-expression ((count 'integer :prompt "Number of expressions"))
+(define-command (com-backward-expression :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of expressions"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2095,10 +2292,11 @@
    (loop repeat (- count) do (forward-expression point syntax)))))
(set-key `(com-backward-expression ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\b :control :meta)))
-(define-named-command com-forward-expression ((count 'integer :prompt "Number of expresssions"))
+(define-command (com-forward-expression :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of expresssions"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2107,10 +2305,11 @@
    (loop repeat (- count) do (backward-expression point syntax)))))
(set-key `(com-forward-expression ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\f :control :meta)))
-(define-named-command com-mark-expression ((count 'integer :prompt "Number of expressions"))
+(define-command (com-mark-expression :name t :command-table marking-table)
+    ((count 'integer :prompt "Number of expressions"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (mark pane))
@@ -2122,10 +2321,11 @@
    (loop repeat (- count) do (backward-expression mark syntax)))))
(set-key `(com-mark-expression ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'marking-table
     '((#@ :shift :control :meta)))
-(define-named-command com-kill-expression ((count 'integer :prompt "Number of expressions"))
+(define-command (com-kill-expression :name t :command-table deletion-table)
+    ((count 'integer :prompt "Number of expressions"))
   (let* ((pane (current-window))
     (point (point pane))
     (mark (clone-mark point))
@@ -2137,10 +2337,10 @@
     (delete-region mark point)))
(set-key `(com-kill-expression ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'deletion-table
     '((#\k :control :meta)))
-(define-named-command com-backward-kill-expression
+(define-command (com-backward-kill-expression :name t :command-table deletion-table)
     ((count 'integer :prompt "Number of expressions"))
   (let* ((pane (current-window))
     (point (point pane))
@@ -2153,10 +2353,50 @@
     (delete-region mark point)))
(set-key `(com-backward-kill-expression ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'deletion-table
     '((#\Backspace :control :meta)))
-(define-named-command com-forward-list ((count 'integer :prompt "Number of lists"))
+;; (defparameter *insert-pair-alist*
+;; 	      '((#( #)) (#[ #]) (#{ #}) (#< #>) (#" #") (#' #') (#` #')))
+
+(defun insert-pair (mark syntax &optional (count 0) (open #() (close #)))
+  (cond ((> count 0)
+	 (loop while (and (not (end-of-buffer-p mark))
+			  (whitespacep (object-after mark)))
+	       do (forward-object mark)))
+	((< count 0)
+	 (setf count (- count))
+	 (loop repeat count do (backward-expression mark syntax))))
+  (unless (or (beginning-of-buffer-p mark)
+	      (whitespacep (object-before mark)))
+    (insert-object mark #\Space))
+  (insert-object mark open)
+  (let ((here (clone-mark mark)))
+    (loop repeat count
+	  do (forward-expression here syntax))
+    (insert-object here close)
+    (unless (or (end-of-buffer-p here)
+		(whitespacep (object-after here)))
+      (insert-object here #\Space))))
+
+(defun insert-parentheses (mark syntax count)
+  (insert-pair mark syntax count #( #)))
+
+(define-command (com-insert-parentheses :name t :command-table editing-table)
+    ((count 'integer :prompt "Number of expressions")
+     (wrap-p 'boolean :prompt "Wrap expressions?"))
+  (let* ((pane (current-window))
+	 (point (point pane))
+	 (syntax (syntax (buffer pane))))
+    (unless wrap-p (setf count 0))
+    (insert-parentheses point syntax count)))
+
+(set-key `(com-insert-parentheses ,*numeric-argument-marker* ,*numeric-argument-p*)
+	 'editing-table
+	 '((#( :meta)))
+
+(define-command (com-forward-list :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of lists"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2165,10 +2405,11 @@
     (loop repeat (- count) do (backward-list point syntax)))))
(set-key `(com-forward-list ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\n :control :meta)))
-(define-named-command com-backward-list ((count 'integer :prompt "Number of lists"))
+(define-command (com-backward-list :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of lists"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2177,10 +2418,11 @@
    (loop repeat (- count) do (forward-list point syntax)))))
(set-key `(com-backward-list ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\p :control :meta)))
-(define-named-command com-down-list ((count 'integer :prompt "Number of lists"))
+(define-command (com-down-list :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of lists"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2189,10 +2431,11 @@
    (loop repeat (- count) do (backward-down-list point syntax)))))
(set-key `(com-down-list ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\d :control :meta)))
-(define-named-command com-backward-down-list ((count 'integer :prompt "Number of lists"))
+(define-command (com-backward-down-list :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of lists"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2200,7 +2443,8 @@
    (loop repeat count do (backward-down-list point syntax))
    (loop repeat (- count) do (down-list point syntax)))))
-(define-named-command com-backward-up-list ((count 'integer :prompt "Number of lists"))
+(define-command (com-backward-up-list :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of lists"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2209,10 +2453,10 @@
    (loop repeat (- count) do (up-list point syntax)))))
(set-key `(com-backward-up-list ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\u :control :meta)))
-(define-named-command com-up-list ((count 'integer :prompt "Number of lists"))
+(define-command (com-up-list :name t :command-table movement-table) ((count 'integer :prompt "Number of lists"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2220,16 +2464,18 @@
    (loop repeat count do (up-list point syntax))
    (loop repeat (- count) do (backward-up-list point syntax)))))
-(define-named-command com-eval-defun ()
+(define-command (com-eval-defun :name t :command-table lisp-table) ()
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
     (eval-defun point syntax)))
-(set-key 'com-eval-defun 'global-climacs-table
+(set-key 'com-eval-defun
+	 'lisp-table
     '((#\x :control :meta)))
-(define-named-command com-beginning-of-definition ((count 'integer :prompt "Number of definitions"))
+(define-command (com-beginning-of-definition :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of definitions"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2238,10 +2484,11 @@
    (loop repeat (- count) do (end-of-definition point syntax)))))
(set-key `(com-beginning-of-definition ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\a :control :meta)))
-(define-named-command com-end-of-definition ((count 'integer :prompt "Number of definitions"))
+(define-command (com-end-of-definition :name t :command-table movement-table)
+    ((count 'integer :prompt "Number of definitions"))
   (let* ((pane (current-window))
     (point (point pane))
     (syntax (syntax (buffer pane))))
@@ -2250,10 +2497,10 @@
    (loop repeat (- count) do (beginning-of-definition point syntax)))))
(set-key `(com-end-of-definition ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'movement-table
     '((#\e :control :meta)))
-(define-named-command com-mark-definition ()
+(define-command (com-mark-definition :name t :command-table marking-table) ()
   (let* ((pane (current-window))
     (point (point pane))
     (mark (mark pane))
@@ -2263,10 +2510,11 @@
       (setf (offset mark) (offset point)))
     (end-of-definition mark syntax)))
-(set-key 'com-mark-definition 'global-climacs-table
+(set-key 'com-mark-definition
+	 'marking-table
     '((#\h :control :meta)))
-(define-named-command com-package ()
+(define-command (com-package :name t :command-table lisp-table) ()
   (let* ((pane (current-window))
     (syntax (syntax (buffer pane)))
     (package (climacs-lisp-syntax::package-of syntax)))
@@ -2276,22 +2524,22 @@
 ;;; 
 ;;; For testing purposes
-(define-named-command com-reset-profile ()
+(define-command (com-reset-profile :name t :command-table development-table) ()
   #+sbcl (sb-profile:reset)
   #-sbcl nil)
-(define-named-command com-report-profile ()
+(define-command (com-report-profile :name t :command-table development-table) ()
   #+sbcl (sb-profile:report)
   #-sbcl nil)
-(define-named-command com-recompile ()
+(define-command (com-recompile :name t :command-table development-table) ()
   (asdf:operate 'asdf:load-op :climacs))
(define-gesture-name :select-other :pointer-button-press (:left :meta) :unique nil)
(define-presentation-translator lisp-string-to-string
-    (climacs-lisp-syntax::lisp-string string global-climacs-table
+    (climacs-lisp-syntax::lisp-string string development-table
                   :gesture :select-other
                   :tester-definitive t
                   :menu nil
@@ -2299,115 +2547,116 @@
     (object)
   object)
-(define-named-command com-accept-string ()
+(define-command (com-accept-string :name t :command-table development-table) ()
   (display-message (format nil "~s" (accept 'string))))
-(define-named-command com-accept-symbol ()
+(define-command (com-accept-symbol :name t :command-table development-table) ()
   (display-message (format nil "~s" (accept 'symbol))))
-(define-named-command com-accept-lisp-string ()
+(define-command (com-accept-lisp-string :name t :command-table development-table) ()
   (display-message (format nil "~s" (accept 'lisp-string))))
-(define-named-command com-toggle-visible-mark ()
+(define-command (com-visible-mark :name t :command-table marking-table) ()
   (setf (mark-visible-p (current-window)) (not (mark-visible-p (current-window)))))
(loop for code from (char-code #\Space) to (char-code #~)
       do (set-key `(com-self-insert ,*numeric-argument-marker*)
-	     'global-climacs-table
+	     'self-insert-table
         (list (list (code-char code)))))
(set-key `(com-self-insert ,*numeric-argument-marker*)
-	 'global-climacs-table
+	 'self-insert-table
     '((#\Newline)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Some Unicode stuff
-(define-named-command com-insert-charcode ((code 'integer :prompt "Code point"))
+(define-command (com-insert-charcode :name t :command-table self-insert-table)
+    ((code 'integer :prompt "Code point"))
   (insert-object (point (current-window)) (code-char code)))
-(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)))
+(set-key '(com-insert-charcode 193) 'self-insert-table '((:dead--acute)(#\A)))
+(set-key '(com-insert-charcode 201) 'self-insert-table '((:dead--acute)(#\E)))
+(set-key '(com-insert-charcode 205) 'self-insert-table '((:dead--acute)(#\I)))
+(set-key '(com-insert-charcode 211) 'self-insert-table '((:dead--acute)(#\O)))
+(set-key '(com-insert-charcode 218) 'self-insert-table '((:dead--acute)(#\U)))
+(set-key '(com-insert-charcode 221) 'self-insert-table '((:dead--acute)(#\Y)))
+(set-key '(com-insert-charcode 225) 'self-insert-table '((:dead--acute)(#\a)))
+(set-key '(com-insert-charcode 233) 'self-insert-table '((:dead--acute)(#\e)))
+(set-key '(com-insert-charcode 237) 'self-insert-table '((:dead--acute)(#\i)))
+(set-key '(com-insert-charcode 243) 'self-insert-table '((:dead--acute)(#\o)))
+(set-key '(com-insert-charcode 250) 'self-insert-table '((:dead--acute)(#\u)))
+(set-key '(com-insert-charcode 253) 'self-insert-table '((:dead--acute)(#\y)))
+(set-key '(com-insert-charcode 199) 'self-insert-table '((:dead--acute)(#\C)))
+(set-key '(com-insert-charcode 231) 'self-insert-table '((:dead--acute)(#\c)))
+(set-key '(com-insert-charcode 215) 'self-insert-table '((:dead--acute)(#\x)))
+(set-key '(com-insert-charcode 247) 'self-insert-table '((:dead--acute)(#-)))
+(set-key '(com-insert-charcode 222) 'self-insert-table '((:dead--acute)(#\T)))
+(set-key '(com-insert-charcode 254) 'self-insert-table '((:dead--acute)(#\t)))
+(set-key '(com-insert-charcode 223) 'self-insert-table '((:dead--acute)(#\s)))
+(set-key '(com-insert-charcode 39) 'self-insert-table '((:dead--acute)(#\Space)))
+
+(set-key '(com-insert-charcode 197) 'self-insert-table '((:dead--acute)(:dead--acute)(#\A)))
+(set-key '(com-insert-charcode 229) 'self-insert-table '((:dead--acute)(:dead--acute)(#\a)))
+
+(set-key '(com-insert-charcode 192) 'self-insert-table '((:dead--grave)(#\A)))
+(set-key '(com-insert-charcode 200) 'self-insert-table '((:dead--grave)(#\E)))
+(set-key '(com-insert-charcode 204) 'self-insert-table '((:dead--grave)(#\I)))
+(set-key '(com-insert-charcode 210) 'self-insert-table '((:dead--grave)(#\O)))
+(set-key '(com-insert-charcode 217) 'self-insert-table '((:dead--grave)(#\U)))
+(set-key '(com-insert-charcode 224) 'self-insert-table '((:dead--grave)(#\a)))
+(set-key '(com-insert-charcode 232) 'self-insert-table '((:dead--grave)(#\e)))
+(set-key '(com-insert-charcode 236) 'self-insert-table '((:dead--grave)(#\i)))
+(set-key '(com-insert-charcode 242) 'self-insert-table '((:dead--grave)(#\o)))
+(set-key '(com-insert-charcode 249) 'self-insert-table '((:dead--grave)(#\u)))
+(set-key '(com-insert-charcode 96) 'self-insert-table '((:dead--grave)(#\Space)))
+
+(set-key '(com-insert-charcode 196) 'self-insert-table '((:dead--diaeresis :shift)(#\A)))
+(set-key '(com-insert-charcode 203) 'self-insert-table '((:dead--diaeresis :shift)(#\E)))
+(set-key '(com-insert-charcode 207) 'self-insert-table '((:dead--diaeresis :shift)(#\I)))
+(set-key '(com-insert-charcode 214) 'self-insert-table '((:dead--diaeresis :shift)(#\O)))
+(set-key '(com-insert-charcode 220) 'self-insert-table '((:dead--diaeresis :shift)(#\U)))
+(set-key '(com-insert-charcode 228) 'self-insert-table '((:dead--diaeresis :shift)(#\a)))
+(set-key '(com-insert-charcode 235) 'self-insert-table '((:dead--diaeresis :shift)(#\e)))
+(set-key '(com-insert-charcode 239) 'self-insert-table '((:dead--diaeresis :shift)(#\i)))
+(set-key '(com-insert-charcode 246) 'self-insert-table '((:dead--diaeresis :shift)(#\o)))
+(set-key '(com-insert-charcode 252) 'self-insert-table '((:dead--diaeresis :shift)(#\u)))
+(set-key '(com-insert-charcode 255) 'self-insert-table '((:dead--diaeresis :shift)(#\y)))
+(set-key '(com-insert-charcode 34) 'self-insert-table '((:dead--diaeresis :shift)(#\Space)))
+
+(set-key '(com-insert-charcode 195) 'self-insert-table '((:dead--tilde :shift)(#\A)))
+(set-key '(com-insert-charcode 209) 'self-insert-table '((:dead--tilde :shift)(#\N)))
+(set-key '(com-insert-charcode 227) 'self-insert-table '((:dead--tilde :shift)(#\a)))
+(set-key '(com-insert-charcode 241) 'self-insert-table '((:dead--tilde :shift)(#\n)))
+(set-key '(com-insert-charcode 198) 'self-insert-table '((:dead--tilde :shift)(#\E)))
+(set-key '(com-insert-charcode 230) 'self-insert-table '((:dead--tilde :shift)(#\e)))
+(set-key '(com-insert-charcode 208) 'self-insert-table '((:dead--tilde :shift)(#\D)))
+(set-key '(com-insert-charcode 240) 'self-insert-table '((:dead--tilde :shift)(#\d)))
+(set-key '(com-insert-charcode 216) 'self-insert-table '((:dead--tilde :shift)(#\O)))
+(set-key '(com-insert-charcode 248) 'self-insert-table '((:dead--tilde :shift)(#\o)))
+(set-key '(com-insert-charcode 126) 'self-insert-table '((:dead--tilde :shift)(#\Space)))
+
+(set-key '(com-insert-charcode 194) 'self-insert-table '((:dead--circumflex :shift)(#\A)))
+(set-key '(com-insert-charcode 202) 'self-insert-table '((:dead--circumflex :shift)(#\E)))
+(set-key '(com-insert-charcode 206) 'self-insert-table '((:dead--circumflex :shift)(#\I)))
+(set-key '(com-insert-charcode 212) 'self-insert-table '((:dead--circumflex :shift)(#\O)))
+(set-key '(com-insert-charcode 219) 'self-insert-table '((:dead--circumflex :shift)(#\U)))
+(set-key '(com-insert-charcode 226) 'self-insert-table '((:dead--circumflex :shift)(#\a)))
+(set-key '(com-insert-charcode 234) 'self-insert-table '((:dead--circumflex :shift)(#\e)))
+(set-key '(com-insert-charcode 238) 'self-insert-table '((:dead--circumflex :shift)(#\i)))
+(set-key '(com-insert-charcode 244) 'self-insert-table '((:dead--circumflex :shift)(#\o)))
+(set-key '(com-insert-charcode 251) 'self-insert-table '((:dead--circumflex :shift)(#\u)))
+(set-key '(com-insert-charcode 94) 'self-insert-table '((:dead--circumflex :shift)(#\Space)))
-(define-named-command com-regex-search-forward ()
+(define-command (com-regex-search-forward :name t :command-table search-table) ()
   (let ((string (accept 'string :prompt "RE search"
    		:delimiter-gestures nil
    		:activation-gestures
    		'(:newline :return))))
     (re-search-forward (point (current-window)) string)))
-(define-named-command com-regex-search-backward ()
+(define-command (com-regex-search-backward :name t :command-table search-table) ()
   (let ((string (accept 'string :prompt "RE search backward"
    		:delimiter-gestures nil
    		:activation-gestures
Index: climacs/esa.lisp
diff -u climacs/esa.lisp:1.17 climacs/esa.lisp:1.18
--- climacs/esa.lisp:1.17	Tue Sep  6 23:30:34 2005
+++ climacs/esa.lisp	Tue Sep 13 21:23:59 2005
@@ -466,6 +466,17 @@
       (helper command-table nil)
       results)))
+(defun find-all-keystrokes-and-commands-with-inheritance (start-table)
+  (let ((results '()))
+    (labels  ((helper (table)
+		(let ((res (find-all-keystrokes-and-commands table)))
+		  (when res  (setf results (nconc res results)))
+		  (dolist (subtable (command-table-inherit-from
+				     (find-command-table table)))
+		    (helper subtable)))))
+      (helper start-table))
+    results))
+
 (defun sort-by-name (list)
   (sort list #'string< :key (lambda (item) (symbol-name (second item)))))
@@ -486,8 +497,9 @@
    		  &optional (sort-function #'sort-by-name))
   (formatting-table (stream)
     (loop for (keys command)
-	  in (funcall sort-function (find-all-keystrokes-and-commands
-					 command-table))
+	  in (funcall sort-function
+		      (find-all-keystrokes-and-commands-with-inheritance
+			   command-table))
      do (formatting-row (stream) 
           (formatting-cell (stream :align-x :right)
    	 (with-text-style (stream '(:sans-serif nil nil))

    

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

[climacs-cvs] CVS update: climacs/syntax.lisp climacs/slidemacs-gui.lisp climacs/pane.lisp climacs/packages.lisp climacs/lisp-syntax.lisp climacs/gui.lisp climacs/esa.lisp