[climacs-cvs] CVS climacs - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

12 May 2006

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv19824
Modified Files:
    gui.lisp window-commands.lisp 
Log Message:
Don't scribble over ESA's command tables; instead, define a 
climacs-help-table to contain customizations of commands.

--- /project/climacs/cvsroot/climacs/gui.lisp	2006/05/04 19:03:46	1.212
+++ /project/climacs/cvsroot/climacs/gui.lisp	2006/05/12 10:31:56	1.213
@@ -104,6 +104,14 @@
 ;;; windows
 (make-command-table 'window-table :errorp nil)
+;;; customization of help.  FIXME: this might be better done by having
+;;; the functions that the ESA commands call be customizeable generic
+;;; functions; however, while they're not, scribbling over the ESA
+;;; command tables is a bad thing.
+(make-command-table 'climacs-help-table :inherit-from '(help-table)
+                    :errorp nil)
+
+
 (defvar *bg-color* +white+)
 (defvar *fg-color* +black+)
 (defvar *info-bg-color* +gray85+)
@@ -119,7 +127,7 @@
   (:command-table (global-climacs-table
    	   :inherit-from (global-esa-table
    			  keyboard-macro-table
-				  help-table
+				  climacs-help-table
    			  base-table
    			  buffer-table
    			  case-table
@@ -172,7 +180,7 @@
        (vertically (:scroll-bars nil)
     climacs-window
     minibuffer)))
-  (:top-level (esa-top-level)))
+  (:top-level (esa-top-level :prompt "M-x ")))
(defmethod frame-standard-input ((frame climacs))
   (get-frame-pane frame 'minibuffer))
@@ -507,7 +515,7 @@
                                                   :stream out-stream))
             (display-message "Unbound gesture: ~A" gesture-name))))))
-(define-command (com-describe-command :name t :command-table help-table)
+(define-command (com-describe-command :name t :command-table climacs-help-table)
     ((command 'command-name))
   "Display documentation for the given command."
   (unless command
@@ -519,16 +527,16 @@
                                 :stream out-stream)))
(set-key 'com-describe-binding
-         'help-table
+         'climacs-help-table
          '((#\h :control) (#\k)))
(set-key '(com-describe-command nil)
-         'help-table
+         'climacs-help-table
          '((#\h :control) (#\f)))
(define-presentation-to-command-translator describe-command
-    (command-name com-describe-command help-table
+    (command-name com-describe-command climacs-help-table
                   :gesture :select
                   :documentation "Describe command")
     (object)
-    (list object))
\ No newline at end of file
+    (list object))
--- /project/climacs/cvsroot/climacs/window-commands.lisp	2006/03/30 16:10:18	1.6
+++ /project/climacs/cvsroot/climacs/window-commands.lisp	2006/05/12 10:31:56	1.7
@@ -103,7 +103,7 @@
    (full-redisplay current-window)
    new-pane))))
-(define-command (com-describe-bindings :name t :command-table help-table)
+(define-command (com-describe-bindings :name t :command-table climacs-help-table)
     ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?"))
   (let* ((window (current-window))
     (buffer (buffer (current-window)))
@@ -115,7 +115,7 @@
    		   #'esa::sort-by-keystrokes
    		   #'esa::sort-by-name))))
-(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b)))
+(set-key `(com-describe-bindings ,*numeric-argument-p*) 'climacs-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

    