X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7ee71cf1bc284849a47bea2fc2f8227ae48bd0bb..16f45d1b8d556362a0668f192e4453f126946b1c:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index 3b14a3a2fe..97887b1c81 100644 --- 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 -;; 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: @@ -39,9 +40,13 @@ "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) +(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) @@ -85,6 +90,25 @@ (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'. @@ -95,6 +119,9 @@ Commands: (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 () @@ -141,12 +168,29 @@ Commands: (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. @@ -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 - "\\[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." @@ -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))) - (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. @@ -226,6 +315,7 @@ describes the minor mode." (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))) @@ -245,10 +335,17 @@ describes the minor mode." 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 "\n\n")))) + (princ "\n\f\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) - (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) @@ -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 () - (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) @@ -423,6 +529,7 @@ C-w print information on absence of warranty for GNU Emacs." (prin1 function) (princ ": ") (let* ((def (symbol-function function)) + file-name (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) + (setq file-name (nth 1 def)) (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 ""))) - (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) @@ -471,11 +578,11 @@ C-w print information on absence of warranty for GNU Emacs." (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) @@ -485,11 +592,18 @@ C-w print information on absence of warranty for GNU Emacs." (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) @@ -524,9 +638,7 @@ Returns the documentation as a string, also." (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) @@ -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) -(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' -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 @@ -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))))) - (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))