(mail-extr-safe-move-sexp): Make sure this doesn't

[gnu-emacs] / lisp / help.el

diff --git a/lisp/help.el b/lisp/help.el
index 3b14a3a2fe9fcb2911f4edfc2a6e3d57fed969dd..97887b1c81c453191210229878efa353027156db 100644 (file)
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -18,8 +18,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License

-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 


@@ -39,9 +40,13 @@
   "Keymap for help mode.")
 
 (define-key global-map (char-to-string help-char) 'help-command)
   "Keymap for help mode.")
 
 (define-key global-map (char-to-string help-char) 'help-command)

+(define-key global-map [help] 'help-command)
+(define-key global-map [f1] 'help-command)

 (fset 'help-command help-map)
 
 (define-key help-map (char-to-string help-char) 'help-for-help)
 (fset 'help-command help-map)
 
 (define-key help-map (char-to-string help-char) 'help-for-help)

+(define-key help-map [help] 'help-for-help)
+(define-key help-map [f1] 'help-for-help)

 (define-key help-map "?" 'help-for-help)
 
 (define-key help-map "\C-c" 'describe-copying)
 (define-key help-map "?" 'help-for-help)
 
 (define-key help-map "\C-c" 'describe-copying)


@@ -85,6 +90,25 @@
 
 (define-key help-map "q" 'help-quit)
 
 
 (define-key help-map "q" 'help-quit)
 

+(defvar help-font-lock-keywords
+  (eval-when-compile
+    (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]"))
+      (list
+       ;;
+       ;; The symbol itself.
+       (list (concat "\\`\\(" name-char "+\\)\\(\\(:\\)\\|\\('\\)\\)")
+            '(1 (if (match-beginning 3)
+                    font-lock-function-name-face
+                  font-lock-variable-name-face)))
+       ;;
+       ;; Words inside `' which tend to be symbol names.
+       (list (concat "`\\(" sym-char sym-char "+\\)'")
+            1 'font-lock-reference-face t)
+       ;;
+       ;; CLisp `:' keywords as references.
+       (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))))
+  "Default expressions to highlight in Help mode.")
+

 (defun help-mode ()
   "Major mode for viewing help text.
 Entry to this mode runs the normal hook `help-mode-hook'.
 (defun help-mode ()
   "Major mode for viewing help text.
 Entry to this mode runs the normal hook `help-mode-hook'.


@@ -95,6 +119,9 @@ Commands:
   (use-local-map help-mode-map)
   (setq mode-name "Help")
   (setq major-mode 'help-mode)
   (use-local-map help-mode-map)
   (setq mode-name "Help")
   (setq major-mode 'help-mode)

+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '(help-font-lock-keywords))
+  (view-mode)

   (run-hooks 'help-mode-hook))
 
 (defun help-quit ()
   (run-hooks 'help-mode-hook))
 
 (defun help-quit ()


@@ -141,12 +168,29 @@ Commands:
     (and (symbolp type)
         (memq 'down (event-modifiers type))
         (read-event)))
     (and (symbolp type)
         (memq 'down (event-modifiers type))
         (read-event)))

-  (let ((defn (key-binding key)))
-    (if (or (null defn) (integerp defn))
-        (message "%s is undefined" (key-description key))
-      (message "%s runs the command %s"
-              (key-description key)
-              (if (symbolp defn) defn (prin1-to-string defn))))))
+  (save-excursion
+    (let ((modifiers (event-modifiers (aref key 0)))
+         window position)
+      ;; For a mouse button event, go to the button it applies to
+      ;; to get the right key bindings.  And go to the right place
+      ;; in case the keymap depends on where you clicked.
+      (if (or (memq 'click modifiers) (memq 'down modifiers)
+             (memq 'drag modifiers))
+         (setq window (posn-window (event-start (aref key 0)))
+               position (posn-point (event-start (aref key 0)))))
+      (if (windowp window)
+         (progn
+           (set-buffer (window-buffer window))
+           (goto-char position)))
+      ;; Ok, now look up the key and name the command.
+      (let ((defn (key-binding key)))
+       (if (or (null defn) (integerp defn))
+           (message "%s is undefined" (key-description key))
+         (message (if (windowp window)
+                      "%s at that spot runs the command %s"
+                    "%s runs the command %s")
+                  (key-description key)
+                  (if (symbolp defn) defn (prin1-to-string defn))))))))

 
 (defun print-help-return-message (&optional function)
   "Display or return message saying how to restore windows after help command.
 
 (defun print-help-return-message (&optional function)
   "Display or return message saying how to restore windows after help command.


@@ -190,8 +234,33 @@ If FUNCTION is nil, applies `message' to it, thus printing it."
                       (substitute-command-keys first-message)
                     "")
                   (if first-message "  " "")
                       (substitute-command-keys first-message)
                     "")
                   (if first-message "  " "")

-                  (substitute-command-keys
-                   "\\[scroll-other-window] to scroll the help."))))))
+                  ;; If the help buffer will go in a separate frame,
+                  ;; it's no use mentioning a command to scroll, so don't.
+                  (if (or (member (buffer-name standard-output)
+                                  special-display-buffer-names)
+                          (assoc (buffer-name standard-output)
+                                 special-display-buffer-names)
+                          (memq t (mapcar '(lambda (elt)
+                                             (if (consp elt)
+                                                 (setq elt (car elt)))
+                                             (string-match elt (buffer-name standard-output)))
+                                          special-display-regexps)))
+                      nil
+                    (if (or (member (buffer-name standard-output)
+                                    same-window-buffer-names)
+                            (assoc (buffer-name standard-output)
+                                   same-window-buffer-names)
+                            (memq t (mapcar '(lambda (elt)
+                                               (if (consp elt)
+                                                   (setq elt (car elt)))
+                                               (string-match elt (buffer-name standard-output)))
+                                            same-window-regexps)))
+                        ;; Say how to scroll this window.
+                        (substitute-command-keys
+                         "\\[scroll-up] to scroll the help.")
+                      ;; Say how to scroll some other window.
+                      (substitute-command-keys
+                       "\\[scroll-other-window] to scroll the help."))))))))

 
 (defun describe-key (key)
   "Display documentation of the function invoked by KEY.  KEY is a string."
 
 (defun describe-key (key)
   "Display documentation of the function invoked by KEY.  KEY is a string."


@@ -204,19 +273,39 @@ If FUNCTION is nil, applies `message' to it, thus printing it."
     (and (symbolp type)
         (memq 'down (event-modifiers type))
         (read-event)))
     (and (symbolp type)
         (memq 'down (event-modifiers type))
         (read-event)))

-  (let ((defn (key-binding key)))
-    (if (or (null defn) (integerp defn))
-        (message "%s is undefined" (key-description key))
-      (with-output-to-temp-buffer "*Help*"
-       (prin1 defn)
-       (princ ":\n")
-       (if (documentation defn)
-           (princ (documentation defn))
-         (princ "not documented"))
-       (save-excursion
-         (set-buffer standard-output)
-         (help-mode))
-       (print-help-return-message)))))
+  (save-excursion
+    (let ((modifiers (event-modifiers (aref key 0)))
+         window position)
+      ;; For a mouse button event, go to the button it applies to
+      ;; to get the right key bindings.  And go to the right place
+      ;; in case the keymap depends on where you clicked.
+      (if (or (memq 'click modifiers) (memq 'down modifiers)
+             (memq 'drag modifiers))
+         (setq window (posn-window (event-start (aref key 0)))
+               position (posn-point (event-start (aref key 0)))))
+      (if (windowp window)
+         (progn
+           (set-buffer (window-buffer window))
+           (goto-char position)))
+      (let ((defn (key-binding key)))
+       (if (or (null defn) (integerp defn))
+           (message "%s is undefined" (key-description key))
+         (with-output-to-temp-buffer "*Help*"
+           (princ (key-description key))
+           (if (windowp window)
+               (princ " at that spot"))
+           (princ " runs the command ")
+           (prin1 defn)
+           (princ ":\n")
+           (let ((doc (documentation defn)))
+             (if doc
+                 (progn (terpri)
+                        (princ doc))
+               (princ "not documented")))
+           (save-excursion
+             (set-buffer standard-output)
+             (help-mode))
+           (print-help-return-message)))))))

 
 (defun describe-mode ()
   "Display documentation of current major mode and minor modes.
 
 (defun describe-mode ()
   "Display documentation of current major mode and minor modes.


@@ -226,6 +315,7 @@ describes the minor mode."
   (interactive)
   (with-output-to-temp-buffer "*Help*"
     (let ((minor-modes minor-mode-alist)
   (interactive)
   (with-output-to-temp-buffer "*Help*"
     (let ((minor-modes minor-mode-alist)

+         (first t)

          (locals (buffer-local-variables)))
       (while minor-modes
        (let* ((minor-mode (car (car minor-modes)))
          (locals (buffer-local-variables)))
       (while minor-modes
        (let* ((minor-mode (car (car minor-modes)))


@@ -245,10 +335,17 @@ describes the minor mode."
                                      0 (match-beginning 0)))))
                (while (and indicator (symbolp indicator))
                  (setq indicator (symbol-value indicator)))
                                      0 (match-beginning 0)))))
                (while (and indicator (symbolp indicator))
                  (setq indicator (symbol-value indicator)))

-               (princ (format "%s minor mode (indicator%s):\n"
-                              pretty-minor-mode indicator))
+               (if first
+                   (princ "The minor modes are described first,
+followed by the major mode, which is described on the last page.\n\f\n"))
+               (setq first nil)
+               (princ (format "%s minor mode (%s):\n"
+                              pretty-minor-mode
+                              (if indicator
+                                  (format "indicator%s" indicator)
+                                "no indicator")))

                (princ (documentation minor-mode))
                (princ (documentation minor-mode))

-               (princ "\n\n"))))
+               (princ "\n\f\n"))))

        (setq minor-modes (cdr minor-modes))))
     (princ mode-name)
     (princ " mode:\n")
        (setq minor-modes (cdr minor-modes))))
     (princ mode-name)
     (princ " mode:\n")


@@ -294,14 +391,16 @@ describes the minor mode."
 The prefix described consists of all but the last event
 of the key sequence that ran this command."
   (interactive)
 The prefix described consists of all but the last event
 of the key sequence that ran this command."
   (interactive)

-  (let* ((key (this-command-keys))
-        (prefix (make-vector (1- (length key)) nil))
-        i)
-    (setq i 0)
-    (while (< i (length prefix))
-      (aset prefix i (aref key i))
-      (setq i (1+ i)))
-    (describe-bindings prefix)))
+  (let* ((key (this-command-keys)))
+    (describe-bindings
+     (if (stringp key)
+        (substring key 0 (1- (length key)))
+       (let ((prefix (make-vector (1- (length key)) nil))
+            (i 0))
+        (while (< i (length prefix))
+          (aset prefix i (aref key i))
+          (setq i (1+ i)))
+        prefix)))))

 ;; Make C-h after a prefix, when not specifically bound, 
 ;; run describe-prefix-bindings.
 (setq prefix-help-command 'describe-prefix-bindings)
 ;; Make C-h after a prefix, when not specifically bound, 
 ;; run describe-prefix-bindings.
 (setq prefix-help-command 'describe-prefix-bindings)


@@ -391,11 +490,18 @@ C-w print information on absence of warranty for GNU Emacs."
                (and (symbolp obj) (fboundp obj) obj))))
        (error nil))
       (condition-case ()
                (and (symbolp obj) (fboundp obj) obj))))
        (error nil))
       (condition-case ()

-         (save-excursion
-           (forward-sexp -1)
-           (skip-chars-forward "'")
-           (let ((obj (read (current-buffer))))
-             (and (symbolp obj) (fboundp obj) obj)))
+         (let ((stab (syntax-table)))
+           (unwind-protect
+               (save-excursion
+                 (set-syntax-table emacs-lisp-mode-syntax-table)
+                 (or (not (zerop (skip-syntax-backward "_w")))
+                     (eq (char-syntax (following-char)) ?w)
+                     (eq (char-syntax (following-char)) ?_)
+                     (forward-sexp -1))
+                 (skip-chars-forward "'")
+                 (let ((obj (read (current-buffer))))
+                   (and (symbolp obj) (fboundp obj) obj)))
+             (set-syntax-table stab)))

        (error nil))))
 
 (defun describe-function-find-file (function)
        (error nil))))
 
 (defun describe-function-find-file (function)


@@ -423,6 +529,7 @@ C-w print information on absence of warranty for GNU Emacs."
     (prin1 function)
     (princ ": ")
     (let* ((def (symbol-function function))
     (prin1 function)
     (princ ": ")
     (let* ((def (symbol-function function))

+          file-name

           (beg (if (commandp def) "an interactive " "a ")))
       (princ (cond ((or (stringp def)
                        (vectorp def))
           (beg (if (commandp def) "an interactive " "a ")))
       (princ (cond ((or (stringp def)
                        (vectorp def))


@@ -440,21 +547,21 @@ C-w print information on absence of warranty for GNU Emacs."
                   ((eq (car-safe def) 'mocklisp)
                    "a mocklisp function")
                   ((eq (car-safe def) 'autoload)
                   ((eq (car-safe def) 'mocklisp)
                    "a mocklisp function")
                   ((eq (car-safe def) 'autoload)

+                   (setq file-name (nth 1 def))

                    (format "%s autoloaded Lisp %s"
                            (if (commandp def) "an interactive" "an")
                            (if (nth 4 def) "macro" "function")
                    (format "%s autoloaded Lisp %s"
                            (if (commandp def) "an interactive" "an")
                            (if (nth 4 def) "macro" "function")

-;;; Including the file name made this line too long.
-;;;                        (nth 1 def)

                            ))
                   (t "")))
                            ))
                   (t "")))

-      (let ((file (describe-function-find-file function)))
-       (if file
-           (progn
-             (princ " in `")
-             ;; We used to add .el to the file name,
-             ;; but that's completely wrong when the user used load-file.
-             (princ file)
-             (princ "'"))))
+      (or file-name
+         (setq file-name (describe-function-find-file function)))
+      (if file-name
+         (progn
+           (princ " in `")
+           ;; We used to add .el to the file name,
+           ;; but that's completely wrong when the user used load-file.
+           (princ file-name)
+           (princ "'")))

       (princ ".")
       (terpri)
       (let ((arglist (cond ((byte-code-function-p def)
       (princ ".")
       (terpri)
       (let ((arglist (cond ((byte-code-function-p def)


@@ -471,11 +578,11 @@ C-w print information on absence of warranty for GNU Emacs."
                                       (intern (upcase (symbol-name arg)))))
                                   arglist)))
              (terpri))))
                                       (intern (upcase (symbol-name arg)))))
                                   arglist)))
              (terpri))))

-      (if (documentation function)
-         (progn (terpri)
-                (princ (documentation function)))
-       (princ "not documented"))
-      )
+      (let ((doc (documentation function)))
+       (if doc
+           (progn (terpri)
+                  (princ doc))
+         (princ "not documented"))))

     (print-help-return-message)
     (save-excursion
       (set-buffer standard-output)
     (print-help-return-message)
     (save-excursion
       (set-buffer standard-output)


@@ -485,11 +592,18 @@ C-w print information on absence of warranty for GNU Emacs."
 
 (defun variable-at-point ()
   (condition-case ()
 
 (defun variable-at-point ()
   (condition-case ()

-      (save-excursion
-       (forward-sexp -1)
-       (skip-chars-forward "'")
-       (let ((obj (read (current-buffer))))
-         (and (symbolp obj) (boundp obj) obj)))
+      (let ((stab (syntax-table)))
+       (unwind-protect
+           (save-excursion
+             (set-syntax-table emacs-lisp-mode-syntax-table)
+             (or (not (zerop (skip-syntax-backward "_w")))
+                 (eq (char-syntax (following-char)) ?w)
+                 (eq (char-syntax (following-char)) ?_)
+                 (forward-sexp -1))
+             (skip-chars-forward "'")
+             (let ((obj (read (current-buffer))))
+               (and (symbolp obj) (boundp obj) obj)))
+         (set-syntax-table stab)))

     (error nil)))
 
 (defun describe-variable (variable)
     (error nil)))
 
 (defun describe-variable (variable)


@@ -524,9 +638,7 @@ Returns the documentation as a string, also."
     (princ "Documentation:")
     (terpri)
     (let ((doc (documentation-property variable 'variable-documentation)))
     (princ "Documentation:")
     (terpri)
     (let ((doc (documentation-property variable 'variable-documentation)))

-      (if doc
-         (princ (substitute-command-keys doc))
-       (princ "not documented as a variable.")))
+      (princ (or doc "not documented as a variable.")))

     (print-help-return-message)
     (save-excursion
       (set-buffer standard-output)
     (print-help-return-message)
     (save-excursion
       (set-buffer standard-output)


@@ -554,24 +666,15 @@ Argument is a command definition, usually a symbol with a function definition."
       (message "%s is not on any key" definition)))
   nil)
 
       (message "%s is not on any key" definition)))
   nil)
 

-(defun command-apropos (string)
-  "Like apropos but lists only symbols that are names of commands
-\(interactively callable functions).  Argument REGEXP is a regular expression
-that is matched against command symbol names.  Returns list of symbols and
-documentation found."
-  (interactive "sCommand apropos (regexp): ")
-  (let ((message
-        (let ((standard-output (get-buffer-create "*Help*")))
-          (print-help-return-message 'identity))))
-    (if (apropos string t 'commandp t)
-       (and message (message message)))))
-
-(defun locate-library (library &optional nosuffix)
-  "Show the full path name of Emacs library LIBRARY.
+(defun locate-library (library &optional nosuffix path)
+  "Show the precise file name of Emacs library LIBRARY.

 This command searches the directories in `load-path' like `M-x load-library'
 to find the file that `M-x load-library RET LIBRARY RET' would load.
 Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'
 This command searches the directories in `load-path' like `M-x load-library'
 to find the file that `M-x load-library RET LIBRARY RET' would load.
 Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'

-to the specified name LIBRARY (a la calling `load' instead of `load-library')."
+to the specified name LIBRARY.
+
+If the optional third arg PATH is specified, that list of directories
+is used instead of `load-path'."

   (interactive "sLocate library: ")
   (catch 'answer
     (mapcar
   (interactive "sLocate library: ")
   (catch 'answer
     (mapcar


@@ -584,8 +687,22 @@ to the specified name LIBRARY (a la calling `load' instead of `load-library')."
                   (progn
                     (message "Library is file %s" try)
                     (throw 'answer try)))))
                   (progn
                     (message "Library is file %s" try)
                     (throw 'answer try)))))

-        (if nosuffix '("") '(".elc" ".el" ""))))
-     load-path)
+        (if nosuffix
+            '("")
+          (let ((basic '(".elc" ".el" ""))
+                (compressed '(".Z" ".gz" "")))
+            ;; If autocompression mode is on,
+            ;; consider all combinations of library suffixes
+            ;; and compression suffixes.
+            (if (rassq 'jka-compr-handler file-name-handler-alist)
+                (apply 'nconc
+                       (mapcar '(lambda (compelt)
+                                  (mapcar '(lambda (baselt)
+                                             (concat baselt compelt))
+                                          basic))
+                               compressed))
+              basic)))))
+     (or path load-path))

     (message "No library %s in search path" library)
     nil))
 
     (message "No library %s in search path" library)
     nil))