X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/048fa48b8d0919db129218cbfb1259b73f4ff9e6..434520fa3dbbd0d726bb76369c4cad73ff19cbeb:/lisp/help-fns.el?ds=sidebyside diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e8655e8f97..8df079433f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,7 +1,7 @@ ;;; help-fns.el --- Complex help functions -;; Copyright (C) 1985, 86, 93, 94, 98, 1999, 2000, 01, 02, 03, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, +;; 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal @@ -20,8 +20,8 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -35,99 +35,6 @@ (require 'help-mode) - -;;;###autoload -(defun help-with-tutorial (&optional arg) - "Select the Emacs learn-by-doing tutorial. -If there is a tutorial version written in the language -of the selected language environment, that version is used. -If there's no tutorial in that language, `TUTORIAL' is selected. -With ARG, you are asked to choose which language." - (interactive "P") - (let ((lang (if arg - (let ((minibuffer-setup-hook minibuffer-setup-hook)) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help) - (read-language-name 'tutorial "Language: " "English")) - (if (get-language-info current-language-environment 'tutorial) - current-language-environment - "English"))) - file filename) - (setq filename (get-language-info lang 'tutorial)) - (setq file (expand-file-name (concat "~/" filename))) - (delete-other-windows) - (if (get-file-buffer file) - (switch-to-buffer (get-file-buffer file)) - (switch-to-buffer (create-file-buffer file)) - (setq buffer-file-name file) - (setq default-directory (expand-file-name "~/")) - (setq buffer-auto-save-file-name nil) - (insert-file-contents (expand-file-name filename data-directory)) - (hack-local-variables) - (goto-char (point-min)) - (search-forward "\n<<") - (beginning-of-line) - ;; Convert the <<...>> line to the proper [...] line, - ;; or just delete the <<...>> line if a [...] line follows. - (cond ((save-excursion - (forward-line 1) - (looking-at "\\[")) - (delete-region (point) (progn (forward-line 1) (point)))) - ((looking-at "<>") - (replace-match "[Middle of page left blank for didactic purposes. Text continues below]")) - (t - (looking-at "<<") - (replace-match "[") - (search-forward ">>") - (replace-match "]"))) - (beginning-of-line) - (let ((n (- (window-height (selected-window)) - (count-lines (point-min) (point)) - 6))) - (if (< n 8) - (progn - ;; For a short gap, we don't need the [...] line, - ;; so delete it. - (delete-region (point) (progn (end-of-line) (point))) - (newline n)) - ;; Some people get confused by the large gap. - (newline (/ n 2)) - - ;; Skip the [...] line (don't delete it). - (forward-line 1) - (newline (- n (/ n 2))))) - (goto-char (point-min)) - (set-buffer-modified-p nil)))) - -;;;###autoload -(defun locate-library (library &optional nosuffix path interactive-call) - "Show the precise file name of Emacs library LIBRARY. -This command searches the directories in `load-path' like `\\[load-library]' -to find the file that `\\[load-library] RET LIBRARY RET' would load. -Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' -to the specified name LIBRARY. - -If the optional third arg PATH is specified, that list of directories -is used instead of `load-path'. - -When called from a program, the file name is normaly returned as a -string. When run interactively, the argument INTERACTIVE-CALL is t, -and the file name is displayed in the echo area." - (interactive (list (completing-read "Locate library: " - 'locate-file-completion - (cons load-path load-suffixes)) - nil nil - t)) - (let ((file (locate-file library - (or path load-path) - (append (unless nosuffix load-suffixes) '(""))))) - (if interactive-call - (if file - (message "Library is file %s" (abbreviate-file-name file)) - (message "No library %s in search path" library))) - file)) - - ;; Functions ;;;###autoload @@ -140,7 +47,8 @@ and the file name is displayed in the echo area." (setq val (completing-read (if fn (format "Describe function (default %s): " fn) "Describe function: ") - obarray 'fboundp t nil nil (symbol-name fn))) + obarray 'fboundp t nil nil + (and fn (symbol-name fn)))) (list (if (equal val "") fn (intern val))))) (if (null function) @@ -216,6 +124,14 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (intern (upcase name)))))) arglist))) +;; Could be this, if we make symbol-file do the work below. +;; (defun help-C-file-name (subr-or-var kind) +;; "Return the name of the C file where SUBR-OR-VAR is defined. +;; KIND should be `var' for a variable or `subr' for a subroutine." +;; (symbol-file (if (symbolp subr-or-var) subr-or-var +;; (subr-name subr-or-var)) +;; (if (eq kind 'var) 'defvar 'defun))) +;;;###autoload (defun help-C-file-name (subr-or-var kind) "Return the name of the C file where SUBR-OR-VAR is defined. KIND should be `var' for a variable or `subr' for a subroutine." @@ -228,18 +144,23 @@ KIND should be `var' for a variable or `subr' for a subroutine." (if (eobp) (insert-file-contents-literally (expand-file-name internal-doc-file-name doc-directory))) - (search-forward (concat "" name "\n")) - (re-search-backward "S\\(.*\\)") - (let ((file (match-string 1))) + (let ((file (catch 'loop + (while t + (let ((pnt (search-forward (concat "" name "\n")))) + (re-search-backward "S\\(.*\\)") + (let ((file (match-string 1))) + (if (member file build-files) + (throw 'loop file) + (goto-char pnt)))))))) (if (string-match "\\.\\(o\\|obj\\)\\'" file) (setq file (replace-match ".c" t t file))) (if (string-match "\\.c\\'" file) (concat "src/" file) file))))) -;;;###autoload -(defface help-argument-name '((t :inherit italic)) - "Face to highlight argument names in *Help* buffers.") +(defface help-argument-name '((((supports :slant italic)) :inherit italic)) + "Face to highlight argument names in *Help* buffers." + :group 'help) (defun help-default-arg-highlight (arg) "Default function to highlight arguments in *Help* buffers. @@ -254,22 +175,21 @@ face (according to `face-differs-from-default-p')." (defun help-do-arg-highlight (doc args) (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table) (modify-syntax-entry ?\- "w") - (while args - (let ((arg (prog1 (car args) (setq args (cdr args))))) - (setq doc (replace-regexp-in-string - ;; This is heuristic, but covers all common cases - ;; except ARG1-ARG2 - (concat "\\<" ; beginning of word - "\\(?:[a-z-]+-\\)?" ; for xxx-ARG - "\\(" - arg - "\\)" - "\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs - "\\(?:-[a-z-]+\\)?" ; for ARG-xxx - "\\>") ; end of word - (help-default-arg-highlight arg) - doc t t 1)))) - doc)) + (dolist (arg args doc) + (setq doc (replace-regexp-in-string + ;; This is heuristic, but covers all common cases + ;; except ARG1-ARG2 + (concat "\\<" ; beginning of word + "\\(?:[a-z-]*-\\)?" ; for xxx-ARG + "\\(" + (regexp-quote arg) + "\\)" + "\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs + "\\(?:-[a-z0-9-]+\\)?" ; for ARG-xxx, ARG-n + "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), , [x], `x' + "\\>") ; end of word + (help-default-arg-highlight arg) + doc t t 1))))) (defun help-highlight-arguments (usage doc &rest args) (when usage @@ -298,6 +218,20 @@ face (according to `face-differs-from-default-p')." ;; Return value is like the one from help-split-fundoc, but highlighted (cons usage doc)) +;;;###autoload +(defun describe-simplify-lib-file-name (file) + "Simplify a library name FILE to a relative name, and make it a source file." + (if file + ;; Try converting the absolute file name to a library name. + (let ((libname (file-name-nondirectory file))) + ;; Now convert that back to a file name and see if we get + ;; the original one. If so, they are equivalent. + (if (equal file (locate-file libname load-path '(""))) + (if (string-match "[.]elc\\'" libname) + (substring libname 0 -1) + libname) + file)))) + ;;;###autoload (defun describe-function-1 (function) (let* ((def (if (symbolp function) @@ -349,7 +283,8 @@ face (according to `face-differs-from-default-p')." (if (re-search-backward "alias for `\\([^`']+\\)'" nil t) (help-xref-button 1 'help-function def))))) (or file-name - (setq file-name (symbol-file function))) + (setq file-name (symbol-file function 'defun))) + (setq file-name (describe-simplify-lib-file-name file-name)) (when (equal file-name "loaddefs.el") ;; Find the real def site of the preloaded function. ;; This is necessary only for defaliases. @@ -382,35 +317,40 @@ face (according to `face-differs-from-default-p')." (princ ".") (terpri) (when (commandp function) - (let* ((remapped (command-remapping function)) - (keys (where-is-internal - (or remapped function) overriding-local-map nil nil)) - non-modified-keys) - ;; Which non-control non-meta keys run this command? - (dolist (key keys) - (if (member (event-modifiers (aref key 0)) '(nil (shift))) - (push key non-modified-keys))) - (when remapped - (princ "It is remapped to `") - (princ (symbol-name remapped)) - (princ "'")) - - (when keys - (princ (if remapped " which is bound to " "It is bound to ")) - ;; FIXME: This list can be very long (f.ex. for self-insert-command). - ;; If there are many, remove them from KEYS. - (if (< (length non-modified-keys) 10) - (princ (mapconcat 'key-description keys ", ")) - (dolist (key non-modified-keys) - (setq keys (delq key keys))) - (if keys - (progn - (princ (mapconcat 'key-description keys ", ")) - (princ ", and many ordinary text characters")) - (princ "many ordinary text characters")))) - (when (or remapped keys non-modified-keys) - (princ ".") - (terpri)))) + (if (and (eq function 'self-insert-command) + (eq (key-binding "a") 'self-insert-command) + (eq (key-binding "b") 'self-insert-command) + (eq (key-binding "c") 'self-insert-command)) + (princ "It is bound to many ordinary text characters.\n") + (let* ((remapped (command-remapping function)) + (keys (where-is-internal + (or remapped function) overriding-local-map nil nil)) + non-modified-keys) + ;; Which non-control non-meta keys run this command? + (dolist (key keys) + (if (member (event-modifiers (aref key 0)) '(nil (shift))) + (push key non-modified-keys))) + (when remapped + (princ "It is remapped to `") + (princ (symbol-name remapped)) + (princ "'")) + + (when keys + (princ (if remapped " which is bound to " "It is bound to ")) + ;; If lots of ordinary text characters run this command, + ;; don't mention them one by one. + (if (< (length non-modified-keys) 10) + (princ (mapconcat 'key-description keys ", ")) + (dolist (key non-modified-keys) + (setq keys (delq key keys))) + (if keys + (progn + (princ (mapconcat 'key-description keys ", ")) + (princ ", and many ordinary text characters")) + (princ "many ordinary text characters")))) + (when (or remapped keys non-modified-keys) + (princ ".") + (terpri))))) (let* ((arglist (help-function-arglist def)) (doc (documentation function)) (usage (help-split-fundoc doc function))) @@ -436,7 +376,9 @@ face (according to `face-differs-from-default-p')." (format "\nMacro: %s" (format-kbd-macro def))) (t "[Missing arglist. Please make a bug report.]"))) (high (help-highlight-arguments use doc))) - (insert (car high) "\n") + (let ((fill-begin (point))) + (insert (car high) "\n") + (fill-region fill-begin (point))) (setq doc (cdr high)))) (let ((obsolete (and ;; function might be a lambda construct. @@ -457,21 +399,30 @@ face (according to `face-differs-from-default-p')." ;; Variables ;;;###autoload -(defun variable-at-point () +(defun variable-at-point (&optional any-symbol) "Return the bound variable symbol found around point. -Return 0 if there is no such symbol." - (condition-case () - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (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)))) - (or (and (symbolp obj) (boundp obj) obj) - 0)))) - (error 0))) +Return 0 if there is no such symbol. +If ANY-SYMBOL is non-nil, don't insist the symbol be bound." + (or (condition-case () + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + (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)))) + (error nil)) + (let* ((str (find-tag-default)) + (sym (if str (intern-soft str)))) + (if (and sym (or any-symbol (boundp sym))) + sym + (save-match-data + (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str)) + (setq sym (intern-soft (match-string 1 str))) + (and (or any-symbol (boundp sym)) sym))))) + 0)) ;;;###autoload (defun describe-variable (variable &optional buffer) @@ -487,7 +438,11 @@ it is displayed along with the global value." (format "Describe variable (default %s): " v) "Describe variable: ") - obarray 'boundp t nil nil + obarray + '(lambda (vv) + (or (boundp vv) + (get vv 'variable-documentation))) + t nil nil (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val))))) @@ -498,23 +453,69 @@ it is displayed along with the global value." (let* ((valvoid (not (with-current-buffer buffer (boundp variable)))) ;; Extract the value before setting up the output buffer, ;; in case `buffer' *is* the output buffer. - (val (unless valvoid (buffer-local-value variable buffer)))) + (val (unless valvoid (buffer-local-value variable buffer))) + val-start-pos) (help-setup-xref (list #'describe-variable variable buffer) (interactive-p)) (with-output-to-temp-buffer (help-buffer) (with-current-buffer buffer (prin1 variable) + ;; Make a hyperlink to the library if appropriate. (Don't + ;; change the format of the buffer's initial line in case + ;; anything expects the current format.) + (let ((file-name (symbol-file variable 'defvar))) + (setq file-name (describe-simplify-lib-file-name file-name)) + (when (equal file-name "loaddefs.el") + ;; Find the real def site of the preloaded variable. + (let ((location + (condition-case nil + (find-variable-noselect variable file-name) + (error nil)))) + (when location + (with-current-buffer (car location) + (when (cdr location) + (goto-char (cdr location))) + (when (re-search-backward + "^;;; Generated autoloads from \\(.*\\)" nil t) + (setq file-name (match-string 1))))))) + (when (and (null file-name) + (integerp (get variable 'variable-documentation))) + ;; It's a variable not defined in Elisp but in C. + (setq file-name + (if (get-buffer " *DOC*") + (help-C-file-name variable 'var) + 'C-source))) + (if file-name + (progn + (princ " is a variable defined in `") + (princ (if (eq file-name 'C-source) "C source code" file-name)) + (princ "'.\n") + (with-current-buffer standard-output + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-variable-def + variable file-name))) + (if valvoid + (princ "It is void as a variable.") + (princ "Its "))) + (if valvoid + (princ " is void as a variable.") + (princ "'s ")))) (if valvoid - (princ " is void") + nil (with-current-buffer standard-output - (princ "'s value is ") + (setq val-start-pos (point)) + (princ "value is ") (terpri) (let ((from (point))) (pp val) - (help-xref-on-pp from (point)) + ;; Hyperlinks in variable's value are quite frequently + ;; inappropriate e.g C-h v features + ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) (delete-region (1- from) from))))) (terpri) + (when (local-variable-p variable) (princ (format "%socal in buffer %s; " (if (get variable 'permanent-local) @@ -532,52 +533,63 @@ it is displayed along with the global value." ;; sensible size before prettyprinting. -- fx (let ((from (point))) (pp val) - (help-xref-on-pp from (point)) + ;; See previous comment for this function. + ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) - (delete-region (1- from) from)))))) - (terpri)) + (delete-region (1- from) from))))))) + ;; Add a note for variables that have been make-var-buffer-local. + (when (and (local-variable-if-set-p variable) + (or (not (local-variable-p variable)) + (with-temp-buffer + (local-variable-if-set-p variable)))) + (princ "\nAutomatically becomes buffer-local when set in any fashion.\n")) (terpri) + + ;; If the value is large, move it to the end. (with-current-buffer standard-output (when (> (count-lines (point-min) (point-max)) 10) ;; Note that setting the syntax table like below ;; makes forward-sexp move over a `'s' at the end ;; of a symbol. (set-syntax-table emacs-lisp-mode-syntax-table) - (goto-char (point-min)) - (if valvoid - (forward-line 1) - (forward-sexp 1) - (delete-region (point) (progn (end-of-line) (point))) - (insert " value is shown below.\n\n") - (save-excursion - (insert "\n\nValue:")))) - ;; Add a note for variables that have been make-var-buffer-local. - (when (and (local-variable-if-set-p variable) - (or (not (local-variable-p variable)) - (with-temp-buffer - (local-variable-if-set-p variable)))) + (goto-char val-start-pos) + (delete-region (point) (progn (end-of-line) (point))) (save-excursion - (forward-line -1) - (insert "Automatically becomes buffer-local when set in any fashion.\n")))) + (insert "\n\nValue:") + (set (make-local-variable 'help-button-cache) + (point-marker))) + (insert "value is shown ") + (insert-button "below" + 'action help-button-cache + 'follow-link t + 'help-echo "mouse-2, RET: show value") + (insert ".\n\n"))) + ;; Mention if it's an alias (let* ((alias (condition-case nil (indirect-variable variable) (error variable))) (obsolete (get variable 'byte-obsolete-variable)) + (safe-var (get variable 'safe-local-variable)) (doc (or (documentation-property variable 'variable-documentation) (documentation-property alias 'variable-documentation)))) (unless (eq alias variable) - (princ (format "This variable is an alias for `%s'." alias)) - (terpri) - (terpri)) + (princ (format "\nThis variable is an alias for `%s'.\n" alias))) (when obsolete - (princ "This variable is obsolete") + (princ "\nThis variable is obsolete") (if (cdr obsolete) (princ (format " since %s" (cdr obsolete)))) (princ ";") (terpri) (princ (if (stringp (car obsolete)) (car obsolete) (format "use `%s' instead." (car obsolete)))) - (terpri) (terpri)) + (when safe-var + (princ "This variable is safe as a file local variable ") + (princ "if its value\nsatisfies the predicate ") + (princ (if (byte-code-function-p safe-var) + "which is byte-compiled expression.\n" + (format "`%s'.\n" safe-var))) + (terpri)) + (princ "Documentation:\n") (princ (or doc "Not documented as a variable."))) ;; Make a link to customize if this variable can be customized. (if (custom-variable-p variable) @@ -590,39 +602,6 @@ it is displayed along with the global value." (re-search-backward (concat "\\(" customize-label "\\)") nil t) (help-xref-button 1 'help-customize-variable variable))))) - ;; Make a hyperlink to the library if appropriate. (Don't - ;; change the format of the buffer's initial line in case - ;; anything expects the current format.) - (let ((file-name (symbol-file (cons 'defvar variable)))) - (when (equal file-name "loaddefs.el") - ;; Find the real def site of the preloaded variable. - (let ((location - (condition-case nil - (find-variable-noselect variable file-name) - (error nil)))) - (when location - (with-current-buffer (car location) - (goto-char (cdr location)) - (when (re-search-backward - "^;;; Generated autoloads from \\(.*\\)" nil t) - (setq file-name (match-string 1))))))) - (when (and (null file-name) - (integerp (get variable 'variable-documentation))) - ;; It's a variable not defined in Elisp but in C. - (setq file-name - (if (get-buffer " *DOC*") - (help-C-file-name variable 'var) - 'C-source))) - (when file-name - (princ "\n\nDefined in `") - (princ (if (eq file-name 'C-source) "C source code" file-name)) - (princ "'.") - (with-current-buffer standard-output - (save-excursion - (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-variable-def - variable file-name))))) - (print-help-return-message) (save-excursion (set-buffer standard-output) @@ -674,12 +653,12 @@ BUFFER should be a buffer or a buffer name." (dotimes (i 95) (let ((elt (aref docs i))) (when elt - (insert (+ i ?\ ) ": " elt "\n")))) + (insert (+ i ?\s) ": " elt "\n")))) (while (setq table (char-table-parent table)) (insert "\nThe parent category table is:") (describe-vector table 'help-describe-category-set)))))))) (provide 'help-fns) -;;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 +;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 ;;; help-fns.el ends here