X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ae940284fa77a6928f5162b7de859e67bdc7506c..233ba4d924933cb56129bd7511e6137b7c0b8e3e:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 80f9c1f960..12b77672a5 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,10 +1,11 @@ ;;; help-fns.el --- Complex help functions -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, -;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1993-1994, 1998-2011 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -31,8 +32,6 @@ ;;; Code: -(require 'help-mode) - ;; Functions ;;;###autoload @@ -51,7 +50,8 @@ fn (intern val))))) (if (null function) (message "You didn't specify a function") - (help-setup-xref (list #'describe-function function) (interactive-p)) + (help-setup-xref (list #'describe-function function) + (called-interactively-p 'interactive)) (save-excursion (with-help-window (help-buffer) (prin1 function) @@ -157,19 +157,18 @@ KIND should be `var' for a variable or `subr' for a subroutine." (concat "src/" file) file))))) -(defface help-argument-name '((((supports :slant italic)) :inherit italic)) - "Face to highlight argument names in *Help* buffers." - :group 'help) +(defcustom help-downcase-arguments nil + "If non-nil, argument names in *Help* buffers are downcased." + :type 'boolean + :group 'help + :version "23.2") -(defun help-default-arg-highlight (arg) - "Default function to highlight arguments in *Help* buffers. -It returns ARG in face `help-argument-name'; ARG is also -downcased if it displays differently than the default -face (according to `face-differs-from-default-p')." - (propertize (if (face-differs-from-default-p 'help-argument-name) - (downcase arg) - arg) - 'face 'help-argument-name)) +(defun help-highlight-arg (arg) + "Highlight ARG as an argument name for a *Help* buffer. +Return ARG in face `help-argument-name'; ARG is also downcased +if the variable `help-downcase-arguments' is non-nil." + (propertize (if help-downcase-arguments (downcase arg) arg) + 'face 'help-argument-name)) (defun help-do-arg-highlight (doc args) (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table) @@ -187,7 +186,7 @@ face (according to `face-differs-from-default-p')." "\\(?:-[a-z0-9-]+\\)?" ; for ARG-xxx, ARG-n "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), , [x], `x' "\\>") ; end of word - (help-default-arg-highlight arg) + (help-highlight-arg arg) doc t t 1))))) (defun help-highlight-arguments (usage doc &rest args) @@ -232,8 +231,8 @@ face (according to `face-differs-from-default-p')." "Guess the file that defined the Lisp object OBJECT, of type TYPE. OBJECT should be a symbol associated with a function, variable, or face; alternatively, it can be a function definition. -If TYPE is `variable', search for a variable definition. -If TYPE is `face', search for a face definition. +If TYPE is `defvar', search for a variable definition. +If TYPE is `defface', search for a face definition. If TYPE is the value returned by `symbol-function' for a function symbol, search for a function definition. @@ -263,15 +262,16 @@ suitable file is found, return nil." (condition-case nil (find-function-search-for-symbol object nil file-name) (error nil)))) - (when location + (when (cdr location) (with-current-buffer (car location) (goto-char (cdr location)) (when (re-search-backward "^;;; Generated autoloads from \\(.*\\)" nil t) (setq file-name (locate-file - (match-string-no-properties 1) - load-path nil 'readable)))))))) + (file-name-sans-extension + (match-string-no-properties 1)) + load-path '(".el" ".elc") 'readable)))))))) (cond ((and (not file-name) (subrp type)) @@ -288,13 +288,19 @@ suitable file is found, return nil." ((not (stringp file-name)) ;; If we don't have a file-name string by now, we lost. nil) + ;; Now, `file-name' should have become an absolute file name. + ;; For files loaded from ~/.emacs.elc, try ~/.emacs. + ((let (fn) + (and (string-equal file-name + (expand-file-name ".emacs.elc" "~")) + (file-readable-p (setq fn (expand-file-name ".emacs" "~"))) + fn))) + ;; When the Elisp source file can be found in the install + ;; directory, return the name of that file. ((let ((lib-name (if (string-match "[.]elc\\'" file-name) (substring-no-properties file-name 0 -1) file-name))) - ;; When the Elisp source file can be found in the install - ;; directory return the name of that file - `file-name' should - ;; have become an absolute file name ny now. (or (and (file-readable-p lib-name) lib-name) ;; The library might be compressed. (and (file-readable-p (concat lib-name ".gz")) lib-name)))) @@ -406,7 +412,7 @@ suitable file is found, return nil." (with-current-buffer standard-output (save-excursion (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-function-def real-function file-name)))) + (help-xref-button 1 'help-function-def function file-name)))) (princ ".") (with-current-buffer (help-buffer) (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) @@ -453,14 +459,31 @@ suitable file is found, return nil." (fill-region-as-paragraph pt2 (point)) (unless (looking-back "\n\n") (terpri))))) - (let* ((arglist (help-function-arglist def)) + ;; Note that list* etc do not get this property until + ;; cl-hack-byte-compiler runs, after bytecomp is loaded. + (when (and (symbolp function) + (eq (get function 'byte-compile) + 'cl-byte-compile-compiler-macro)) + (princ "This function has a compiler macro") + (let ((lib (get function 'compiler-macro-file))) + (when (stringp lib) + (princ (format " in `%s'" lib)) + (with-current-buffer standard-output + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-function-cmacro function lib))))) + (princ ".\n\n")) + (let* ((advertised (gethash def advertised-signature-table t)) + (arglist (if (listp advertised) + advertised (help-function-arglist def))) (doc (documentation function)) (usage (help-split-fundoc doc function))) (with-current-buffer standard-output ;; If definition is a keymap, skip arglist note. (unless (keymapp function) + (if usage (setq doc (cdr usage))) (let* ((use (cond - (usage (setq doc (cdr usage)) (car usage)) + ((and usage (not (listp advertised))) (car usage)) ((listp arglist) (format "%S" (help-make-usage function arglist))) ((stringp arglist) arglist) @@ -591,7 +614,7 @@ it is displayed along with the global value." (setq val (symbol-value variable) locus (variable-binding-locus variable))))) (help-setup-xref (list #'describe-variable variable buffer) - (interactive-p)) + (called-interactively-p 'interactive)) (with-help-window (help-buffer) (with-current-buffer buffer (prin1 variable) @@ -615,21 +638,30 @@ it is displayed along with the global value." (if valvoid (princ " is void as a variable.") (princ "'s ")))) - (if valvoid - nil + (unless valvoid (with-current-buffer standard-output (setq val-start-pos (point)) (princ "value is ") - (terpri) (let ((from (point))) + (terpri) (pp val) - ;; 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))))) + (if (< (point) (+ 68 (line-beginning-position 0))) + (delete-region from (1+ from)) + (delete-region (1- from) from)) + (let* ((sv (get variable 'standard-value)) + (origval (and (consp sv) + (condition-case nil + (eval (car sv)) + (error :help-eval-error))))) + (when (and (consp sv) + (not (equal origval val)) + (not (equal origval :help-eval-error))) + (princ "\nOriginal value was \n") + (setq from (point)) + (pp origval) + (if (< (point) (+ from 20)) + (delete-region (1- from) from))))))) (terpri) - (when locus (if (bufferp locus) (princ (format "%socal in buffer %s; " @@ -710,6 +742,37 @@ it is displayed along with the global value." (use (format ";\n use `%s' instead." (car obsolete))) (t "."))) (terpri)) + + (when (member (cons variable val) file-local-variables-alist) + (setq extra-line t) + (if (member (cons variable val) dir-local-variables-alist) + (let ((file (and (buffer-file-name) + (not (file-remote-p (buffer-file-name))) + (dir-locals-find-file (buffer-file-name))))) + (princ " This variable is a directory local variable") + (when file + (princ (concat "\n from the file \"" + (if (consp file) + (car file) + file) + "\""))) + (princ ".\n")) + (princ " This variable is a file local variable.\n"))) + + (when (memq variable ignored-local-variables) + (setq extra-line t) + (princ " This variable is ignored when used as a file local \ +variable.\n")) + + ;; Can be both risky and safe, eg auto-fill-function. + (when (risky-local-variable-p variable) + (setq extra-line t) + (princ " This variable is potentially risky when used as a \ +file local variable.\n") + (when (assq variable safe-local-variable-values) + (princ " However, you have added it to \ +`safe-local-variable-values'.\n"))) + (when safe-var (setq extra-line t) (princ " This variable is safe as a file local variable ") @@ -741,8 +804,7 @@ it is displayed along with the global value." (terpri) (princ output)))) - (save-excursion - (set-buffer standard-output) + (with-current-buffer standard-output ;; Return the text we displayed. (buffer-string)))))))) @@ -754,7 +816,8 @@ The descriptions are inserted in a help buffer, which is then displayed. BUFFER defaults to the current buffer." (interactive) (setq buffer (or buffer (current-buffer))) - (help-setup-xref (list #'describe-syntax buffer) (interactive-p)) + (help-setup-xref (list #'describe-syntax buffer) + (called-interactively-p 'interactive)) (with-help-window (help-buffer) (let ((table (with-current-buffer buffer (syntax-table)))) (with-current-buffer standard-output @@ -779,7 +842,8 @@ If BUFFER is non-nil, then describe BUFFER's category table instead. BUFFER should be a buffer or a buffer name." (interactive) (setq buffer (or buffer (current-buffer))) - (help-setup-xref (list #'describe-categories buffer) (interactive-p)) + (help-setup-xref (list #'describe-categories buffer) + (called-interactively-p 'interactive)) (with-help-window (help-buffer) (let* ((table (with-current-buffer buffer (category-table))) (docs (char-table-extra-slot table 0))) @@ -824,7 +888,111 @@ BUFFER should be a buffer or a buffer name." (insert "\nThe parent category table is:") (describe-vector table 'help-describe-category-set)))))) + +;;; Replacements for old lib-src/ programs. Don't seem especially useful. + +;; Replaces lib-src/digest-doc.c. +;;;###autoload +(defun doc-file-to-man (file) + "Produce an nroff buffer containing the doc-strings from the DOC file." + (interactive (list (read-file-name "Name of DOC file: " doc-directory + internal-doc-file-name t))) + (or (file-readable-p file) + (error "Cannot read file `%s'" file)) + (pop-to-buffer (generate-new-buffer "*man-doc*")) + (setq buffer-undo-list t) + (insert ".TH \"Command Summary for GNU Emacs\"\n" + ".AU Richard M. Stallman\n") + (insert-file-contents file) + (let (notfirst) + (while (search-forward "" nil 'move) + (if (looking-at "S") + (delete-region (1- (point)) (line-end-position)) + (delete-char -1) + (if notfirst + (insert "\n.DE\n") + (setq notfirst t)) + (insert "\n.SH ") + (insert (if (looking-at "F") "Function " "Variable ")) + (delete-char 1) + (forward-line 1) + (insert ".DS L\n")))) + (insert "\n.DE\n") + (setq buffer-undo-list nil) + (nroff-mode)) + +;; Replaces lib-src/sorted-doc.c. +;;;###autoload +(defun doc-file-to-info (file) + "Produce a texinfo buffer with sorted doc-strings from the DOC file." + (interactive (list (read-file-name "Name of DOC file: " doc-directory + internal-doc-file-name t))) + (or (file-readable-p file) + (error "Cannot read file `%s'" file)) + (let ((i 0) type name doc alist) + (with-temp-buffer + (insert-file-contents file) + ;; The characters "@{}" need special treatment. + (while (re-search-forward "[@{}]" nil t) + (backward-char) + (insert "@") + (forward-char 1)) + (goto-char (point-min)) + (while (search-forward "" nil t) + (unless (looking-at "S") + (setq type (char-after) + name (buffer-substring (1+ (point)) (line-end-position)) + doc (buffer-substring (line-beginning-position 2) + (if (search-forward "" nil 'move) + (1- (point)) + (point))) + alist (cons (list name type doc) alist)) + (backward-char 1)))) + (pop-to-buffer (generate-new-buffer "*info-doc*")) + (setq buffer-undo-list t) + ;; Write the output header. + (insert "\\input texinfo @c -*-texinfo-*-\n" + "@setfilename emacsdoc.info\n" + "@settitle Command Summary for GNU Emacs\n" + "@finalout\n" + "\n@node Top\n" + "@unnumbered Command Summary for GNU Emacs\n\n" + "@table @asis\n\n" + "@iftex\n" + "@global@let@ITEM@item\n" + "@def@item{@filbreak@vskip5pt@ITEM}\n" + "@font@tensy cmsy10 scaled @magstephalf\n" + "@font@teni cmmi10 scaled @magstephalf\n" + "@def\\{{@tensy@char110}}\n" ; this backslash goes with cmr10 + "@def|{{@tensy@char106}}\n" + "@def@{{{@tensy@char102}}\n" + "@def@}{{@tensy@char103}}\n" + "@def<{{@teni@char62}}\n" + "@def>{{@teni@char60}}\n" + "@chardef@@64\n" + "@catcode43=12\n" + "@tableindent-0.2in\n" + "@end iftex\n") + ;; Sort the array by name; within each name, by type (functions first). + (setq alist (sort alist (lambda (e1 e2) + (if (string-equal (car e1) (car e2)) + (<= (cadr e1) (cadr e2)) + (string-lessp (car e1) (car e2)))))) + ;; Print each function. + (dolist (e alist) + (insert "\n@item " + (if (char-equal (cadr e) ?\F) "Function" "Variable") + " @code{" (car e) "}\n@display\n" + (nth 2 e) + "\n@end display\n") + ;; Try to avoid a save size overflow in the TeX output routine. + (if (zerop (setq i (% (1+ i) 100))) + (insert "\n@end table\n@table @asis\n"))) + (insert "@end table\n" + "@bye\n") + (setq buffer-undo-list nil) + (texinfo-mode))) + (provide 'help-fns) -;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3 ;;; help-fns.el ends here