;;; 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:
(forward-line 1)
(newline (- n (/ n 2)))))
(goto-char (point-min))
+ (setq buffer-undo-list nil)
(set-buffer-modified-p nil))))
;;;###autoload
(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-default-arg-highlight (arg)
"Default function to highlight arguments in *Help* buffers.
-It returns ARG in lowercase italics, if the display supports it;
-else ARG is returned in uppercase normal."
- (let ((attrs '(:slant italic)))
- (if (display-supports-face-attributes-p attrs)
- (propertize (downcase arg) 'face attrs)
- arg)))
+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)
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
;; This is heuristic, but covers all common cases
;; except ARG1-ARG2
(concat "\\<" ; beginning of word
- "\\(?:[a-z-]+-\\)?" ; for xxx-ARG
+ "\\(?:[a-z-]*-\\)?" ; for xxx-ARG
"\\("
- arg
+ (regexp-quote arg)
"\\)"
"\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs
"\\(?:-[a-z-]+\\)?" ; for ARG-xxx
(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