;;; 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 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:
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"))
+ (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")))
(forward-line 1)
(newline (- n (/ n 2)))))
(goto-char (point-min))
+ (setq buffer-undo-list nil)
(set-buffer-modified-p nil))))
;;;###autoload
;; Return the text we displayed.
(buffer-string))))))
-(defun help-split-fundoc (doc def)
- "Split a function docstring DOC into the actual doc and the usage info.
+(defun help-split-fundoc (docstring def)
+ "Split a function DOCSTRING into the actual doc and the usage info.
Return (USAGE . DOC) or nil if there's no usage info.
-DEF is the function whose usage we're looking for in DOC."
+DEF is the function whose usage we're looking for in DOCSTRING."
;; Functions can get the calling sequence at the end of the doc string.
;; In cases where `function' has been fset to a subr we can't search for
;; function's name in the doc string so we use `fn' as the anonymous
;; function name instead.
- (when (and doc (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc))
+ (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
(cons (format "(%s%s"
;; Replace `fn' with the actual function name.
(if (consp def) "anonymous" def)
- (match-string 1 doc))
- (substring doc 0 (match-beginning 0)))))
-
-(defun help-add-fundoc-usage (doc arglist)
- "Add the usage info to the docstring DOC.
-If DOC already has a usage info, then just return DOC unchanged.
-The usage info is built from ARGLIST. DOC can be nil.
-ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
- (unless (stringp doc) (setq doc "Not documented"))
- (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t))
- doc
- (format "%s%s%S" doc
- (if (string-match "\n?\n\\'" doc)
+ (match-string 1 docstring))
+ (substring docstring 0 (match-beginning 0)))))
+
+(defun help-add-fundoc-usage (docstring arglist)
+ "Add the usage info to DOCSTRING.
+If DOCSTRING already has a usage info, then just return it unchanged.
+The usage info is built from ARGLIST. DOCSTRING can be nil.
+ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
+ (unless (stringp docstring) (setq docstring "Not documented"))
+ (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t))
+ docstring
+ (concat docstring
+ (if (string-match "\n?\n\\'" docstring)
(if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
"\n\n")
(if (and (stringp arglist)
(string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
(concat "(fn" (match-string 1 arglist) ")")
- (help-make-usage 'fn arglist)))))
+ (format "%S" (help-make-usage 'fn arglist))))))
(defun help-function-arglist (def)
;; Handle symbols aliased to other symbols.
(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)))))
-(defface help-argument-name '((t (:inherit font-lock-variable-name-face)))
- "Face to highlight function arguments in docstrings.")
+;;;###autoload
+(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.
+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-do-arg-highlight (doc args)
- (while args
- (let ((arg (prog1 (car args) (setq args (cdr args)))))
- (setq doc (replace-regexp-in-string
- (concat "\\<\\(" arg "\\)\\(?:es\\|s\\)?\\>")
- (propertize arg 'face 'help-argument-name)
- doc t t 1))))
- doc)
+ (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
+ "\\("
+ (regexp-quote 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))
(defun help-highlight-arguments (usage doc &rest args)
(when usage
- (let ((case-fold-search nil)
- (next (not args)))
- ;; Make a list of all arguments
- (with-temp-buffer
- (insert usage)
- (goto-char (point-min))
+ (with-temp-buffer
+ (insert usage)
+ (goto-char (point-min))
+ (let ((case-fold-search nil)
+ (next (not (or args (looking-at "\\["))))
+ (opt nil))
;; Make a list of all arguments
+ (skip-chars-forward "^ ")
(while next
- (if (not (re-search-forward " \\([\\[(]?\\)\\([^] &)\.]+\\)" nil t))
+ (or opt (not (looking-at " &")) (setq opt t))
+ (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
(setq next nil)
(setq args (cons (match-string 2) args))
- (when (string= (match-string 1) "(")
+ (when (and opt (string= (match-string 1) "("))
;; A pesky CL-style optional argument with default value,
;; so let's skip over it
(search-backward "(")
(goto-char (scan-sexps (point) 1)))))
;; Highlight aguments in the USAGE string
- (setq usage (help-do-arg-highlight (buffer-string) args)))
- ;; Highlight arguments in the DOC string
- (setq doc (and doc (help-do-arg-highlight doc args)))
- ;; Return value is like the one from help-split-fundoc, but highlighted
- (cons usage doc))))
+ (setq usage (help-do-arg-highlight (buffer-string) args))
+ ;; Highlight arguments in the DOC string
+ (setq doc (and doc (help-do-arg-highlight doc args))))))
+ ;; Return value is like the one from help-split-fundoc, but highlighted
+ (cons usage doc))
;;;###autoload
(defun describe-function-1 (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)))
(when (equal file-name "loaddefs.el")
;; Find the real def site of the preloaded function.
;; This is necessary only for defaliases.
;; 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)
(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)
;; 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))
(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:"))))
+ (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")))
;; 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))
;; 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))))
+ (let ((file-name (symbol-file variable 'defvar)))
(when (equal file-name "loaddefs.el")
;; Find the real def site of the preloaded variable.
(let ((location
(provide 'help-fns)
-;;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3
+;; arch-tag: 9e10331c-ae81-4d13-965d-c4819aaab0b3
;;; help-fns.el ends here