X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/59b5723c9b613f14cd60cd3239cfdbc0d2343b18..058f8a8d55a6b20c68ee9728c537bb8ce50dfe81:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1c7a68abde..bc96601a45 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,6 +1,6 @@ ;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software +;; Copyright (C) 1985-1986, 1993-1994, 1998-2016 Free Software ;; Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -43,6 +43,11 @@ The functions will receive the function name as argument.") ;; Functions +(defvar describe-function-orig-buffer nil + "Buffer that was current when `describe-function' was invoked. +Functions on `help-fns-describe-function-functions' can use this +to get buffer-local values.") + ;;;###autoload (defun describe-function (function) "Display the full documentation of FUNCTION (a symbol)." @@ -61,18 +66,35 @@ The functions will receive the function name as argument.") (user-error "You didn't specify a function symbol")) (or (fboundp function) (user-error "Symbol's function definition is void: %s" function)) - (help-setup-xref (list #'describe-function function) - (called-interactively-p 'interactive)) - (save-excursion - (with-help-window (help-buffer) - (prin1 function) - ;; Use " is " instead of a colon so that - ;; it is easier to get out the function name using forward-sexp. - (princ " is ") - (describe-function-1 function) - (with-current-buffer standard-output - ;; Return the text we displayed. - (buffer-string))))) + + ;; We save describe-function-orig-buffer on the help xref stack, so + ;; it is restored by the back/forward buttons. 'help-buffer' + ;; expects (current-buffer) to be a help buffer when processing + ;; those buttons, so we can't change the current buffer before + ;; calling that. + (let ((describe-function-orig-buffer + (or describe-function-orig-buffer + (current-buffer)))) + + (help-setup-xref + (list (lambda (function buffer) + (let ((describe-function-orig-buffer + (if (buffer-live-p buffer) buffer))) + (describe-function function))) + function describe-function-orig-buffer) + (called-interactively-p 'interactive)) + + (save-excursion + (with-help-window (help-buffer) + (prin1 function) + ;; Use " is " instead of a colon so that + ;; it is easier to get out the function name using forward-sexp. + (princ " is ") + (describe-function-1 function) + (with-current-buffer standard-output + ;; Return the text we displayed. + (buffer-string)))) + )) ;; Could be this, if we make symbol-file do the work below. @@ -156,7 +178,7 @@ if the variable `help-downcase-arguments' is non-nil." (skip-chars-forward "^ ") (while next (or opt (not (looking-at " &")) (setq opt t)) - (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t)) + (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &).]+\\)" nil t)) (setq next nil) (setq args (cons (match-string 2) args)) (when (and opt (string= (match-string 1) "(")) @@ -275,19 +297,7 @@ suitable file is found, return nil." lib-name) file-name)) ;; The next three forms are from `find-source-lisp-file'. - (elc-file (locate-file - (concat file-name - (if (string-match "\\.el\\'" file-name) - "c" - ".elc")) - load-path nil 'readable)) - (str (when elc-file - (with-temp-buffer - (insert-file-contents-literally elc-file nil 0 256) - (buffer-string)))) - (src-file (and str - (string-match ";;; from file \\(.*\\.el\\)" str) - (match-string 1 str)))) + (src-file (locate-library file-name t nil 'readable))) (and src-file (file-readable-p src-file) src-file)))))) (defun help-fns--key-bindings (function) @@ -309,9 +319,7 @@ suitable file is found, return nil." (when remapped (princ "Its keys are remapped to ") (princ (if (symbolp remapped) - (concat (substitute-command-keys "‘") - (symbol-name remapped) - (substitute-command-keys "’")) + (format-message "`%s'" remapped) "an anonymous command")) (princ ".\n")) @@ -345,22 +353,22 @@ suitable file is found, return nil." (insert "\nThis function has a compiler macro") (if (symbolp handler) (progn - (insert (format (substitute-command-keys " ‘%s’") handler)) + (insert (format-message " `%s'" handler)) (save-excursion - (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’") + (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") nil t) (help-xref-button 1 'help-function handler))) ;; FIXME: Obsolete since 24.4. (let ((lib (get function 'compiler-macro-file))) (when (stringp lib) - (insert (format (substitute-command-keys " in ‘%s’") lib)) + (insert (format-message " in `%s'" lib)) (save-excursion - (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’") + (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") nil t) (help-xref-button 1 'help-function-cmacro function lib))))) (insert ".\n")))) -(defun help-fns--signature (function doc real-def real-function raw) +(defun help-fns--signature (function doc real-def real-function buffer) "Insert usage at point and return docstring. With highlighting." (if (keymapp function) doc ; If definition is a keymap, skip arglist note. @@ -394,10 +402,13 @@ suitable file is found, return nil." (use1 (replace-regexp-in-string "\\`(\\\\=\\\\\\\\=` \\([^\n ]*\\))\\'" "\\\\=`\\1" use t)) - (high (if raw - (cons use1 doc) - (help-highlight-arguments (substitute-command-keys use1) - (substitute-command-keys doc))))) + (high (if buffer + (let (subst-use1 subst-doc) + (with-current-buffer buffer + (setq subst-use1 (substitute-command-keys use1)) + (setq subst-doc (substitute-command-keys doc))) + (help-highlight-arguments subst-use1 subst-doc)) + (cons use1 doc)))) (let ((fill-begin (point)) (high-usage (car high)) (high-doc (cdr high))) @@ -411,13 +422,13 @@ suitable file is found, return nil." (get function 'derived-mode-parent)))) (when parent-mode - (insert (substitute-command-keys "\nParent mode: ‘")) + (insert (substitute-command-keys "\nParent mode: `")) (let ((beg (point))) (insert (format "%s" parent-mode)) (make-text-button beg (point) 'type 'help-function 'help-args (list parent-mode))) - (insert (substitute-command-keys "’.\n"))))) + (insert (substitute-command-keys "'.\n"))))) (defun help-fns--obsolete (function) ;; Ignore lambda constructs, keyboard macros, etc. @@ -433,9 +444,7 @@ suitable file is found, return nil." (when (nth 2 obsolete) (insert (format " since %s" (nth 2 obsolete)))) (insert (cond ((stringp use) (concat ";\n" use)) - (use (format (substitute-command-keys - ";\nuse ‘%s’ instead.") - use)) + (use (format-message ";\nuse `%s' instead." use)) (t ".")) "\n")))) @@ -471,9 +480,8 @@ FILE is the file where FUNCTION was probably defined." (format ";\nin Lisp code %s" interactive-only)) ((and (symbolp 'interactive-only) (not (eq interactive-only t))) - (format (substitute-command-keys - ";\nin Lisp code use ‘%s’ instead.") - interactive-only)) + (format-message ";\nin Lisp code use `%s' instead." + interactive-only)) (t ".")) "\n"))))) @@ -541,8 +549,7 @@ FILE is the file where FUNCTION was probably defined." ;; Aliases are Lisp functions, so we need to check ;; aliases before functions. (aliased - (format (substitute-command-keys "an alias for ‘%s’") - real-def)) + (format-message "an alias for `%s'" real-def)) ((autoloadp def) (format "%s autoloaded %s" (if (commandp def) "an interactive" "an") @@ -577,22 +584,21 @@ FILE is the file where FUNCTION was probably defined." (save-excursion (save-match-data (when (re-search-backward (substitute-command-keys - "alias for ‘\\([^‘’]+\\)’") + "alias for `\\([^`']+\\)'") nil t) (help-xref-button 1 'help-function real-def))))) (when file-name - (princ (substitute-command-keys " in ‘")) ;; We used to add .el to the file name, ;; but that's completely wrong when the user used load-file. - (princ (if (eq file-name 'C-source) - "C source code" - (help-fns-short-filename file-name))) - (princ (substitute-command-keys "’")) + (princ (format-message " in `%s'" + (if (eq file-name 'C-source) + "C source code" + (help-fns-short-filename file-name)))) ;; Make a hyperlink to the library. (with-current-buffer standard-output (save-excursion - (re-search-backward (substitute-command-keys "‘\\([^‘’]+\\)’") + (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") nil t) (help-xref-button 1 'help-function-def function file-name)))) (princ ".") @@ -601,7 +607,8 @@ FILE is the file where FUNCTION was probably defined." (point))) (terpri)(terpri) - (let ((doc-raw (documentation function t))) + (let ((doc-raw (documentation function t)) + (key-bindings-buffer (current-buffer))) ;; If the function is autoloaded, and its docstring has ;; key substitution constructs, load the library. @@ -612,11 +619,16 @@ FILE is the file where FUNCTION was probably defined." (help-fns--key-bindings function) (with-current-buffer standard-output - (let ((doc (help-fns--signature function doc-raw sig-key - real-function nil))) - (run-hook-with-args 'help-fns-describe-function-functions function) - (insert "\n" - (or doc "Not documented.")))))))) + (let ((doc (help-fns--signature function doc-raw sig-key + real-function key-bindings-buffer))) + (run-hook-with-args 'help-fns-describe-function-functions function) + (insert "\n" + (or doc "Not documented.")) + ;; Avoid asking the user annoying questions if she decides + ;; to save the help buffer, when her locale's codeset + ;; isn't UTF-8. + (unless (memq text-quoting-style '(straight grave)) + (set-buffer-file-coding-system 'utf-8)))))))) ;; Add defaults to `help-fns-describe-function-functions'. (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) @@ -726,16 +738,15 @@ it is displayed along with the global value." (if file-name (progn - (princ (substitute-command-keys - " is a variable defined in ‘")) - (princ (if (eq file-name 'C-source) - "C source code" - (file-name-nondirectory file-name))) - (princ (substitute-command-keys "’.\n")) + (princ (format-message + " is a variable defined in `%s'.\n" + (if (eq file-name 'C-source) + "C source code" + (file-name-nondirectory file-name)))) (with-current-buffer standard-output (save-excursion (re-search-backward (substitute-command-keys - "‘\\([^‘’]+\\)’") + "`\\([^`']+\\)'") nil t) (help-xref-button 1 'help-variable-def variable file-name))) @@ -744,7 +755,7 @@ it is displayed along with the global value." (princ "Its "))) (if valvoid (princ " is void as a variable.") - (princ "'s ")))) + (princ (substitute-command-keys "'s "))))) (unless valvoid (with-current-buffer standard-output (setq val-start-pos (point)) @@ -752,8 +763,12 @@ it is displayed along with the global value." (let ((from (point)) (line-beg (line-beginning-position)) (print-rep - (let ((print-quoted t)) - (prin1-to-string val)))) + (let ((rep + (let ((print-quoted t)) + (prin1-to-string val)))) + (if (and (symbolp val) (not (booleanp val))) + (format-message "`%s'" rep) + rep)))) (if (< (+ (length print-rep) (point) (- line-beg)) 68) (insert print-rep) (terpri) @@ -857,18 +872,21 @@ it is displayed along with the global value." ((not permanent-local)) ((bufferp locus) (setq extra-line t) - (princ " This variable's buffer-local value is permanent.\n")) + (princ + (substitute-command-keys + " This variable's buffer-local value is permanent.\n"))) (t (setq extra-line t) - (princ " This variable's value is permanent \ -if it is given a local binding.\n"))) + (princ (substitute-command-keys + " This variable's value is permanent \ +if it is given a local binding.\n")))) ;; Mention if it's an alias. (unless (eq alias variable) (setq extra-line t) - (princ (format (substitute-command-keys - " This variable is an alias for ‘%s’.\n") - alias))) + (princ (format-message + " This variable is an alias for `%s'.\n" + alias))) (when obsolete (setq extra-line t) @@ -876,9 +894,8 @@ if it is given a local binding.\n"))) (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) (princ (cond ((stringp use) (concat ";\n " use)) - (use (format (substitute-command-keys - ";\n use ‘%s’ instead.") - (car obsolete))) + (use (format-message ";\n use `%s' instead." + (car obsolete))) (t "."))) (terpri)) @@ -894,30 +911,39 @@ if it is given a local binding.\n"))) (buffer-file-name buffer))) (dir-locals-find-file (buffer-file-name buffer)))) - (dir-file t)) - (princ " This variable's value is directory-local") - (if (null file) - (princ ".\n") - (princ ", set ") - (if (consp file) ; result from cache - ;; If the cache element has an mtime, we - ;; assume it came from a file. - (if (nth 2 file) - (setq file (expand-file-name - dir-locals-file (car file))) - ;; Otherwise, assume it was set directly. - (setq file (car file) - dir-file nil))) - (princ (substitute-command-keys - (if dir-file - "by the file\n ‘" - "for the directory\n ‘"))) + (is-directory nil)) + (princ (substitute-command-keys + " This variable's value is directory-local")) + (when (consp file) ; result from cache + ;; If the cache element has an mtime, we + ;; assume it came from a file. + (if (nth 2 file) + (setq file (expand-file-name + dir-locals-file (car file))) + ;; Otherwise, assume it was set directly. + (setq file (car file) + is-directory t))) + (if (null file) + (princ ".\n") + (princ ", set ") + (let ((files (file-expand-wildcards file))) + (princ (substitute-command-keys + (cond + (is-directory "for the directory\n `") + ;; Many files matched. + ((cdr files) + (setq file (file-name-directory (car files))) + (format "by a file\n matching `%s' in the directory\n `" + dir-locals-file)) + (t (setq file (car files)) + "by the file\n `")))) (with-current-buffer standard-output (insert-text-button file 'type 'help-dir-local-var-def - 'help-args (list variable file))) - (princ (substitute-command-keys "’.\n")))) - (princ " This variable's value is file-local.\n"))) + 'help-args (list variable file)))) + (princ (substitute-command-keys "'.\n")))) + (princ (substitute-command-keys + " This variable's value is file-local.\n")))) (when (memq variable ignored-local-variables) (setq extra-line t) @@ -932,7 +958,7 @@ file-local variable.\n") (when (assq variable safe-local-variable-values) (princ (substitute-command-keys " However, you have added it to \ -‘safe-local-variable-values’.\n")))) +`safe-local-variable-values'.\n")))) (when safe-var (setq extra-line t) @@ -940,8 +966,7 @@ file-local variable.\n") (princ "if its value\n satisfies the predicate ") (princ (if (byte-code-function-p safe-var) "which is a byte-compiled expression.\n" - (format (substitute-command-keys "‘%s’.\n") - safe-var)))) + (format-message "`%s'.\n" safe-var)))) (if extra-line (terpri)) (princ "Documentation:\n") @@ -959,7 +984,7 @@ file-local variable.\n") (re-search-backward (concat "\\(" customize-label "\\)") nil t) (help-xref-button 1 'help-customize-variable variable)))) - ;; Note variable's version or package version + ;; Note variable's version or package version. (let ((output (describe-variable-custom-version-info variable))) (when output (terpri) @@ -976,7 +1001,10 @@ file-local variable.\n") ;;;###autoload (defun describe-symbol (symbol &optional buffer frame) "Display the full documentation of SYMBOL. -Will show the info of SYMBOL as a function, variable, and/or face." +Will show the info of SYMBOL as a function, variable, and/or face. +Optional arguments BUFFER and FRAME specify for which buffer and +frame to show the information about SYMBOL; they default to the +current buffer and the selected frame, respectively." (interactive (let* ((v-or-f (symbol-at-point)) (found (cl-some (lambda (x) (funcall (nth 1 x) v-or-f)) @@ -1019,15 +1047,17 @@ Will show the info of SYMBOL as a function, variable, and/or face." (let ((inhibit-read-only t) (name (caar docs)) ;Name of doc currently at BOB. (doc (cdr (cadr docs)))) ;Doc to add at BOB. - (insert doc) - (delete-region (point) (progn (skip-chars-backward " \t\n") (point))) - (insert "\n\n" - (eval-when-compile - (propertize "\n" 'face '(:height 0.1 :inverse-video t))) - "\n") - (when name - (insert (symbol-name symbol) - " is also a " name "." "\n\n"))) + (when doc + (insert doc) + (delete-region (point) + (progn (skip-chars-backward " \t\n") (point))) + (insert "\n\n" + (eval-when-compile + (propertize "\n" 'face '(:height 0.1 :inverse-video t))) + "\n") + (when name + (insert (symbol-name symbol) + " is also a " name "." "\n\n")))) (setq docs (cdr docs))) (unless single ;; Don't record the `describe-variable' item in the stack.