;;; 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
;; 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:
(forward-line 1)
(newline (- n (/ n 2)))))
(goto-char (point-min))
+ (setq buffer-undo-list nil)
(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))
-
\f
;; Functions
(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)
(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."
(if (eobp)
(insert-file-contents-literally
(expand-file-name internal-doc-file-name doc-directory)))
- (search-forward (concat "\1f" name "\n"))
- (re-search-backward "\1fS\\(.*\\)")
- (let ((file (match-string 1)))
+ (let ((file (catch 'loop
+ (while t
+ (let ((pnt (search-forward (concat "\1f" name "\n"))))
+ (re-search-backward "\1fS\\(.*\\)")
+ (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 '((((supports :slant italic)) :inherit italic))
"Face to highlight argument names in *Help* buffers."
:group 'help)
(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], `x'
+ "\\>") ; end of word
+ (help-default-arg-highlight arg)
+ doc t t 1)))))
(defun help-highlight-arguments (usage doc &rest args)
(when usage
;; 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)
(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.
(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.
;; 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."
+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
(and (symbolp obj) (boundp obj) obj))))
(error nil))
(let* ((str (find-tag-default))
- (obj (if str (read str))))
- (and (symbolp obj) (boundp obj) obj))
+ (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
(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)))))
(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)
+ (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 <RET> features <RET>
+ ;; (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)
;; 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)
(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)
(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