--- a/lisp/help.el	Mon Aug 13 10:33:19 2007 +0200
+++ b/lisp/help.el	Mon Aug 13 10:34:13 2007 +0200
@@ -350,13 +350,15 @@
       defn)
     ))
 
-(defun describe-key-briefly (key)
-  "Print the name of the function KEY invokes.  KEY is a string."
-  (interactive "kDescribe key briefly: ")
-  (let (defn menup)
+(defun describe-key-briefly (key &optional insert)
+  "Print the name of the function KEY invokes.  KEY is a string.
+If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
+  (interactive "kDescribe key briefly: \nP")
+  (let ((standard-output (if insert (current-buffer) t))
+	defn menup)
     (setq defn (key-or-menu-binding key 'menup))
     (if (or (null defn) (integerp defn))
-        (message "%s is undefined" (key-description key))
+        (princ (format "%s is undefined" (key-description key)))
       ;; If it's a keyboard macro which trivially invokes another command,
       ;; document that instead.
       (if (or (stringp defn) (vectorp defn))
@@ -364,15 +366,20 @@
 			 defn)))
       (let ((last-event (and (vectorp key)
 			     (aref key (1- (length key))))))
-	(message (if (or (button-press-event-p last-event)
-			 (button-release-event-p last-event))
-		     (gettext "%s at that spot runs the command %s")
-		   (gettext "%s runs the command %s"))
-		 ;; This used to say 'This menu item' but it could also
-		 ;; be a scrollbar event.  We can't distinguish at the
-		 ;; moment.
-		 (if menup "This item" (key-description key))
-		 (format (if (symbolp defn) "`%s'" "%s") defn))))))
+	(princ (format (cond (insert
+			      "%s (%s)")
+			     ((or (button-press-event-p last-event)
+				  (button-release-event-p last-event))
+			      (gettext "%s at that spot runs the command %s"))
+			     (t
+			      (gettext "%s runs the command %s")))
+		       ;; This used to say 'This menu item' but it
+		       ;; could also be a scrollbar event.  We can't
+		       ;; distinguish at the moment.
+		       (if menup
+			   (if insert "item" "This item")
+			 (key-description key))
+		       (if (symbolp defn) defn (prin1-to-string defn))))))))
 
 ;; #### this is a horrible piece of shit function that should
 ;; not exist.  In FSF 19.30 this function has gotten three times
@@ -462,44 +469,51 @@
 ;; a help message and then prompting for input in the minibuffer --
 ;; this macro usually selects the help buffer, which is not what you
 ;; want in those situations.
-(defmacro with-displaying-help-buffer (name &rest body)
+
+;; #### Should really be a macro to eliminate the requirement of
+;; caller to code a lambda form in THUNK -- mrb
+
+;; #### BEFORE you rush to make this a macro, think about backward
+;; compatibility.  The right way would be to create a macro with
+;; another name (which is a shame, because w-d-h-b is a perfect name
+;; for a macro) that uses with-displaying-help-buffer internally.
+
+(defun with-displaying-help-buffer (thunk &optional name)
   "Form which makes a help buffer with given NAME and evaluates BODY there.
 The actual name of the buffer is generated by the function `help-buffer-name'."
-  `(let* ((winconfig (current-window-configuration))
-	  (was-one-window (one-window-p))
-	  (buffer-name (help-buffer-name ,name))
-	  (help-not-visible
-	   (not (and (windows-of-buffer buffer-name) ;shortcut
-		     (member (selected-frame)
-			     (mapcar 'window-frame
-				     (windows-of-buffer buffer-name)))))))
-     (help-register-and-maybe-prune-excess buffer-name)
-     (prog1 (with-output-to-temp-buffer buffer-name
-	      (prog1 ,@body
-		(save-excursion
-		  (set-buffer standard-output)
-		  (help-mode))))
-       (let ((helpwin (get-buffer-window buffer-name)))
-	 (when helpwin
-	   (with-current-buffer (window-buffer helpwin)
-	     ;; If the *Help* buffer is already displayed on this
-	     ;; frame, don't override the previous configuration
-	     (when help-not-visible
-	       (set-frame-property (selected-frame)
-				   'help-window-config winconfig)))
-	   (when help-selects-help-window
-	     (select-window helpwin))
-	   (cond ((eq helpwin (selected-window))
-		  (display-message 'command
-		    (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help.")))
-		 (was-one-window
-		  (display-message 'command
-		    (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help.")))
-		 (t
-		  (display-message 'command
-		    (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))))))))
-(put 'with-displaying-help-buffer 'lisp-indent-function 1)
-(put 'with-displaying-help-buffer 'edebug-form-spec '(form body))
+  (let* ((winconfig (current-window-configuration))
+	 (was-one-window (one-window-p))
+	 (buffer-name (help-buffer-name name))
+	 (help-not-visible
+	  (not (and (windows-of-buffer buffer-name) ;shortcut
+		    (memq (selected-frame)
+			  (mapcar 'window-frame
+				  (windows-of-buffer buffer-name)))))))
+    (help-register-and-maybe-prune-excess buffer-name)
+    (prog1 (with-output-to-temp-buffer buffer-name
+	     (prog1 (funcall thunk)
+	       (save-excursion
+		 (set-buffer standard-output)
+		 (help-mode))))
+      (let ((helpwin (get-buffer-window buffer-name)))
+	(when helpwin
+	  (with-current-buffer (window-buffer helpwin)
+	    ;; If the *Help* buffer is already displayed on this
+	    ;; frame, don't override the previous configuration
+	    (when help-not-visible
+	      (set-frame-property (selected-frame)
+				  'help-window-config winconfig)))
+	  (when help-selects-help-window
+	    (select-window helpwin))
+	  (cond ((eq helpwin (selected-window))
+		 (display-message 'command
+		   (substitute-command-keys "Type \\[help-mode-quit] to remove help window, \\[scroll-up] to scroll the help.")))
+		(was-one-window
+		 (display-message 'command
+		   (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help.")))
+		(t
+		 (display-message 'command
+		   (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help.")))))))))
 
 (defun describe-key (key)
   "Display documentation of the function invoked by KEY.
@@ -510,31 +524,33 @@
 	(key-string (key-description key)))
     (if (or (null defn) (integerp defn))
         (message "%s is undefined" key-string)
-      (with-displaying-help-buffer (format "key `%s'" key-string)
-	(princ key-string)
-	(princ " runs ")
-	(if (symbolp defn)
-	    (princ (format "`%s'" defn))
-	  (princ defn))
-	(princ "\n\n")
-	(cond ((or (stringp defn) (vectorp defn))
-	       (let ((cmd (key-binding defn)))
-		 (if (not cmd)
-		     (princ "a keyboard macro")
-		   (progn
-		     (princ "a keyboard macro which runs the command ")
-		     (princ cmd)
-		     (princ ":\n\n")
-		     (if (documentation cmd) (princ (documentation cmd)))))))
-	      ((and (consp defn) (not (eq 'lambda (car-safe defn))))
-	       (let ((describe-function-show-arglist nil))
-		 (describe-function-1 (car defn))))
-	      ((symbolp defn)
-	       (describe-function-1 defn))
-	      ((documentation defn)
-	       (princ (documentation defn)))
-	      (t
-	       (princ "not documented")))))))
+      (with-displaying-help-buffer
+       (lambda ()
+	 (princ key-string)
+	 (princ " runs ")
+	 (if (symbolp defn)
+	     (princ (format "`%s'" defn))
+	   (princ defn))
+	 (princ "\n\n")
+	 (cond ((or (stringp defn) (vectorp defn))
+		(let ((cmd (key-binding defn)))
+		  (if (not cmd)
+		      (princ "a keyboard macro")
+		    (progn
+		      (princ "a keyboard macro which runs the command ")
+		      (princ cmd)
+		      (princ ":\n\n")
+		      (if (documentation cmd) (princ (documentation cmd)))))))
+	       ((and (consp defn) (not (eq 'lambda (car-safe defn))))
+		(let ((describe-function-show-arglist nil))
+		  (describe-function-1 (car defn))))
+	       ((symbolp defn)
+		(describe-function-1 defn))
+	       ((documentation defn)
+		(princ (documentation defn)))
+	       (t
+		(princ "not documented"))))
+       (format "key `%s'" key-string)))))
 
 (defun describe-mode ()
   "Display documentation of current major mode and minor modes.
@@ -542,38 +558,40 @@
 \(listed in `minor-mode-alist') must also be a function whose documentation
 describes the minor mode."
   (interactive)
-  (with-displaying-help-buffer (format "%s mode" mode-name)
-    ;; XEmacs change: print the major-mode documentation before
-    ;; the minor modes.
-    (princ mode-name)
-    (princ " mode:\n")
-    (princ (documentation major-mode))
-    (princ "\n\n----\n\n")
-    (let ((minor-modes minor-mode-alist))
-      (while minor-modes
-	(let* ((minor-mode (car (car minor-modes)))
-	       (indicator (car (cdr (car minor-modes)))))
-	  ;; Document a minor mode if it is listed in minor-mode-alist,
-	  ;; bound locally in this buffer, non-nil, and has a function
-	  ;; definition.
-	  (if (and (boundp minor-mode)
-		   (symbol-value minor-mode)
-		   (fboundp minor-mode))
-	      (let ((pretty-minor-mode minor-mode))
-		(if (string-match "-mode\\'" (symbol-name minor-mode))
-		    (setq pretty-minor-mode
-			  (capitalize
-			   (substring (symbol-name minor-mode)
-				      0 (match-beginning 0)))))
-		(while (and (consp indicator) (extentp (car indicator)))
-		  (setq indicator (cdr indicator)))
-		(while (and indicator (symbolp indicator))
-		  (setq indicator (symbol-value indicator)))
-		(princ (format "%s minor mode (indicator%s):\n"
-			       pretty-minor-mode indicator))
-		(princ (documentation minor-mode))
-		(princ "\n\n----\n\n"))))
-	(setq minor-modes (cdr minor-modes))))))
+  (with-displaying-help-buffer
+   (lambda ()
+     ;; XEmacs change: print the major-mode documentation before
+     ;; the minor modes.
+     (princ mode-name)
+     (princ " mode:\n")
+     (princ (documentation major-mode))
+     (princ "\n\n----\n\n")
+     (let ((minor-modes minor-mode-alist))
+       (while minor-modes
+	 (let* ((minor-mode (car (car minor-modes)))
+		(indicator (car (cdr (car minor-modes)))))
+	   ;; Document a minor mode if it is listed in minor-mode-alist,
+	   ;; bound locally in this buffer, non-nil, and has a function
+	   ;; definition.
+	   (if (and (boundp minor-mode)
+		    (symbol-value minor-mode)
+		    (fboundp minor-mode))
+	       (let ((pretty-minor-mode minor-mode))
+		 (if (string-match "-mode\\'" (symbol-name minor-mode))
+		     (setq pretty-minor-mode
+			   (capitalize
+			    (substring (symbol-name minor-mode)
+				       0 (match-beginning 0)))))
+		 (while (and (consp indicator) (extentp (car indicator)))
+		   (setq indicator (cdr indicator)))
+		 (while (and indicator (symbolp indicator))
+		   (setq indicator (symbol-value indicator)))
+		 (princ (format "%s minor mode (indicator%s):\n"
+				pretty-minor-mode indicator))
+		 (princ (documentation minor-mode))
+		 (princ "\n\n----\n\n"))))
+	 (setq minor-modes (cdr minor-modes)))))
+   (format "%s mode" mode-name)))
 
 ;; So keyboard macro definitions are documented correctly
 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
@@ -626,10 +644,10 @@
 If the second argument (prefix arg, interactively) is non-null
 then only the mouse bindings are displayed."
   (interactive (list nil current-prefix-arg))
-  (let (buf)
-    (with-displaying-help-buffer (format "bindings for %s" major-mode)
-      (setq buf (describe-bindings-1 prefix mouse-only-p)))
-    buf))
+  (with-displaying-help-buffer
+   (lambda ()
+     (describe-bindings-1 prefix mouse-only-p))
+   (format "bindings for %s" major-mode)))
 
 (defun describe-bindings-1 (&optional prefix mouse-only-p)
   (let ((heading (if mouse-only-p
@@ -680,11 +698,13 @@
     (while (< i (length prefix))
       (aset prefix i (aref key i))
       (setq i (1+ i)))
-    (with-displaying-help-buffer (format "%s prefix" (key-description prefix))
-      (princ "Key bindings starting with ")
-      (princ (key-description prefix))
-      (princ ":\n\n")
-      (describe-bindings-1 prefix nil))))
+    (with-displaying-help-buffer
+     (lambda ()
+       (princ "Key bindings starting with ")
+       (princ (key-description prefix))
+       (princ ":\n\n")
+       (describe-bindings-1 prefix nil))
+     (format "%s prefix" (key-description prefix)))))
 
 ;; Make C-h after a prefix, when not specifically bound,
 ;; run describe-prefix-bindings.
@@ -695,8 +715,10 @@
   (interactive)
   (if (and (boundp 'Installation-string)
 	   (stringp Installation-string))
-      (with-displaying-help-buffer "Installation"
-	(princ Installation-string))
+      (with-displaying-help-buffer
+       (lambda ()
+	 (princ Installation-string))
+       "Installation")
     (error "No Installation information available.")))
 
 (defun view-emacs-news ()
@@ -745,37 +767,39 @@
 The number of keys shown is controlled by `view-lossage-key-count'.
 The number of messages shown is controlled by `view-lossage-message-count'."
   (interactive)
-  (with-displaying-help-buffer "lossage"
-    (princ (key-description (recent-keys view-lossage-key-count)))
-    (save-excursion
-      (set-buffer standard-output)
-      (goto-char (point-min))
-      (insert "Recent keystrokes:\n\n")
-      (while (progn (move-to-column 50) (not (eobp)))
-	(search-forward " " nil t)
-	(insert "\n")))
-    ;; XEmacs addition: copy the messages from " *Message-Log*",
-    ;; reversing their order and handling multiline messages
-    ;; correctly.
-    (princ "\n\n\nRecent minibuffer messages (most recent first):\n\n")
-    (save-excursion
-      (let ((buffer (get-buffer-create " *Message-Log*"))
-	    (count 0)
-	    oldpoint extent)
-	(goto-char (point-max buffer) buffer)
-	(set-buffer standard-output)
-	(while (and (not (bobp buffer))
-		    (< count view-lossage-message-count))
-	  (setq oldpoint (point buffer))
-	  (setq extent (extent-at oldpoint buffer
-				  'message-multiline nil 'before))
-	  ;; If the message was multiline, move all the way to the
-	  ;; beginning.
-	  (if extent
-	      (goto-char (extent-start-position extent) buffer)
-	    (forward-line -1 buffer))
-	  (insert-buffer-substring buffer (point buffer) oldpoint)
-	  (incf count))))))
+  (with-displaying-help-buffer
+   (lambda ()
+     (princ (key-description (recent-keys view-lossage-key-count)))
+     (save-excursion
+       (set-buffer standard-output)
+       (goto-char (point-min))
+       (insert "Recent keystrokes:\n\n")
+       (while (progn (move-to-column 50) (not (eobp)))
+	 (search-forward " " nil t)
+	 (insert "\n")))
+     ;; XEmacs addition: copy the messages from " *Message-Log*",
+     ;; reversing their order and handling multiline messages
+     ;; correctly.
+     (princ "\n\n\nRecent minibuffer messages (most recent first):\n\n")
+     (save-excursion
+       (let ((buffer (get-buffer-create " *Message-Log*"))
+	     (count 0)
+	     oldpoint extent)
+	 (goto-char (point-max buffer) buffer)
+	 (set-buffer standard-output)
+	 (while (and (not (bobp buffer))
+		     (< count view-lossage-message-count))
+	   (setq oldpoint (point buffer))
+	   (setq extent (extent-at oldpoint buffer
+				   'message-multiline nil 'before))
+	   ;; If the message was multiline, move all the way to the
+	   ;; beginning.
+	   (if extent
+	       (goto-char (extent-start-position extent) buffer)
+	     (forward-line -1 buffer))
+	   (insert-buffer-substring buffer (point buffer) oldpoint)
+	   (incf count)))))
+   "lossage"))
 
 (define-function 'help 'help-for-help)
 
@@ -914,8 +938,12 @@
                         (gettext "Describe function: "))
                     obarray 'fboundp t nil 'function-history))))
       (list (if (equal val "") fn (intern val)))))
-  (with-displaying-help-buffer (format "function `%s'" function)
-    (describe-function-1 function)))
+  (with-displaying-help-buffer
+   (lambda ()
+     (describe-function-1 function)
+     ;; Return the text we displayed.
+     (buffer-string nil nil standard-output))
+    (format "function `%s'" function)))
 
 (defun function-obsolete-p (function)
   "Return non-nil if FUNCTION is obsolete."
@@ -1199,77 +1227,79 @@
                        (gettext "Describe variable: "))
                    obarray 'boundp t nil 'variable-history))))
      (list (if (equal val "") v (intern val)))))
-  (with-displaying-help-buffer (format "variable `%s'" variable)
-    (let ((origvar variable)
-	  aliases)
-      (let ((print-escape-newlines t))
-	(princ (format "`%s' is " (symbol-name variable)))
-	(while (variable-alias variable)
-	  (let ((newvar (variable-alias variable)))
-	    (if aliases
-		;; I18N3 Need gettext due to concat
-		(setq aliases
-		      (concat aliases
-			      (format "\n     which is an alias for `%s',"
-				      (symbol-name newvar))))
-	      (setq aliases
-		    (format "an alias for `%s',"
-			    (symbol-name newvar))))
-	    (setq variable newvar)))
-	(if aliases
-	    (princ (format "%s" aliases)))
-	(princ (built-in-variable-doc variable))
-	(princ ".\n")
-	(let ((file-name (describe-symbol-find-file variable)))
-	     (if file-name
-		 (princ (format "  -- loaded from \"%s\"\n" file-name))))
-	(princ "\nValue: ")
-	(if (not (boundp variable))
-	    (princ "void\n")
-	  (prin1 (symbol-value variable))
-	  (terpri))
-	(terpri)
-	(cond ((local-variable-p variable (current-buffer))
-	       (let* ((void (cons nil nil))
-		      (def (condition-case nil
-			       (default-value variable)
-			     (error void))))
-		 (princ "This value is specific to the current buffer.\n")
-		 (if (local-variable-p variable nil)
-		     (princ "(Its value is local to each buffer.)\n"))
-		 (terpri)
-		 (if (if (eq def void)
-			 (boundp variable)
-		       (not (eq (symbol-value variable) def)))
-		     ;; #### I18N3 doesn't localize properly!
-		     (progn (princ "Default-value: ")
-			    (if (eq def void)
-				(princ "void\n")
-			      (prin1 def)
-			      (terpri))
-			    (terpri)))))
-	      ((local-variable-p variable (current-buffer) t)
-	       (princ "Setting it would make its value buffer-local.\n\n"))))
-      (princ "Documentation:")
-      (terpri)
-      (let ((doc (documentation-property variable 'variable-documentation))
-	    (obsolete (variable-obsoleteness-doc origvar))
-	    (compatible (variable-compatibility-doc origvar)))
-	(when obsolete
-	  (princ obsolete)
-	  (terpri)
-	  (terpri))
-	(when compatible
-	  (princ compatible)
-	  (terpri)
-	  (terpri))
-	;; don't bother to print anything if variable is obsolete and aliased.
-	(when (or (not obsolete) (not aliases))
-	  (if doc
-	      ;; note: documentation-property calls substitute-command-keys.
-	      (princ doc)
-	    (princ "not documented as a variable."))))
-      (terpri))))
+  (with-displaying-help-buffer
+   (lambda ()
+     (let ((origvar variable)
+	   aliases)
+       (let ((print-escape-newlines t))
+	 (princ (format "`%s' is " (symbol-name variable)))
+	 (while (variable-alias variable)
+	   (let ((newvar (variable-alias variable)))
+	     (if aliases
+		 ;; I18N3 Need gettext due to concat
+		 (setq aliases
+		       (concat aliases
+			       (format "\n     which is an alias for `%s',"
+				       (symbol-name newvar))))
+	       (setq aliases
+		     (format "an alias for `%s',"
+			     (symbol-name newvar))))
+	     (setq variable newvar)))
+	 (if aliases
+	     (princ (format "%s" aliases)))
+	 (princ (built-in-variable-doc variable))
+	 (princ ".\n")
+	 (let ((file-name (describe-symbol-find-file variable)))
+	   (if file-name
+	       (princ (format "  -- loaded from \"%s\"\n" file-name))))
+	 (princ "\nValue: ")
+	 (if (not (boundp variable))
+	     (princ "void\n")
+	   (prin1 (symbol-value variable))
+	   (terpri))
+	 (terpri)
+	 (cond ((local-variable-p variable (current-buffer))
+		(let* ((void (cons nil nil))
+		       (def (condition-case nil
+				(default-value variable)
+			      (error void))))
+		  (princ "This value is specific to the current buffer.\n")
+		  (if (local-variable-p variable nil)
+		      (princ "(Its value is local to each buffer.)\n"))
+		  (terpri)
+		  (if (if (eq def void)
+			  (boundp variable)
+			(not (eq (symbol-value variable) def)))
+		      ;; #### I18N3 doesn't localize properly!
+		      (progn (princ "Default-value: ")
+			     (if (eq def void)
+				 (princ "void\n")
+			       (prin1 def)
+			       (terpri))
+			     (terpri)))))
+	       ((local-variable-p variable (current-buffer) t)
+		(princ "Setting it would make its value buffer-local.\n\n"))))
+       (princ "Documentation:")
+       (terpri)
+       (let ((doc (documentation-property variable 'variable-documentation))
+	     (obsolete (variable-obsoleteness-doc origvar))
+	     (compatible (variable-compatibility-doc origvar)))
+	 (when obsolete
+	   (princ obsolete)
+	   (terpri)
+	   (terpri))
+	 (when compatible
+	   (princ compatible)
+	   (terpri)
+	   (terpri))
+	 ;; don't bother to print anything if variable is obsolete and aliased.
+	 (when (or (not obsolete) (not aliases))
+	   (if doc
+	       ;; note: documentation-property calls substitute-command-keys.
+	       (princ doc)
+	     (princ "not documented as a variable."))))
+       (terpri)))
+   (format "variable `%s'" variable)))
 
 (defun sorted-key-descriptions (keys &optional separator)
   "Sort and separate the key descriptions for KEYS.
@@ -1280,11 +1310,12 @@
 			    (< (length x) (length y))))
 	     (or separator ", ")))
 
-(defun where-is (definition)
+(defun where-is (definition &optional insert)
   "Print message listing key sequences that invoke specified command.
 Argument is a command definition, usually a symbol with a function definition.
 When run interactively, it defaults to any function found by
-`function-at-point'."
+`function-at-point'.
+If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
   (interactive
    (let ((fn (function-at-point))
 	 (enable-recursive-minibuffers t)
@@ -1293,11 +1324,18 @@
 		(if fn (format "Where is command (default %s): " fn)
 		  "Where is command: ")))
      (list (if (equal (symbol-name val) "")
-	       fn val))))
+	       fn val)
+	   current-prefix-arg)))
   (let ((keys (where-is-internal definition)))
     (if keys
-	(message "%s is on %s" definition (sorted-key-descriptions keys))
-      (message "%s is not on any keys" definition)))
+	(if insert
+	    (princ (format "%s (%s)" (sorted-key-descriptions keys)
+			   definition) (current-buffer))
+	  (message "%s is on %s" definition (sorted-key-descriptions keys)))
+      (if insert
+	  (princ (format (if (commandp definition) "M-x %s RET"
+			   "M-: (%s ...)") definition) (current-buffer))
+	(message "%s is not on any keys" definition))))
   nil)
 
 ;; `locate-library' moved to "packages.el"
@@ -1309,9 +1347,11 @@
   "Describe the syntax specifications in the syntax table.
 The descriptions are inserted in a buffer, which is then displayed."
   (interactive)
-  (with-displaying-help-buffer (format "syntax-table for %s" major-mode)
-    ;; defined in syntax.el
-    (describe-syntax-table (syntax-table) standard-output)))
+  (with-displaying-help-buffer
+   (lambda ()
+     ;; defined in syntax.el
+     (describe-syntax-table (syntax-table) standard-output))
+   (format "syntax-table for %s" major-mode)))
 
 (defun list-processes ()
   "Display a list of all processes.