;;; 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, 1999, 2000, 2001, 2002,
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
+;; Package: emacs
;; This file is part of GNU Emacs.
;;; Code:
-(require 'help-mode)
-
;; Functions
;;;###autoload
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)
(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)
"\\(?:-[a-z0-9-]+\\)?" ; for ARG-xxx, ARG-n
"\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (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)
"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.
"^;;; 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))
((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))))
(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)
(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)
(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 <RET> features <RET>
- ;; (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; "
(not (file-remote-p (buffer-file-name)))
(dir-locals-find-file (buffer-file-name)))))
(princ " This variable is a directory local variable")
- (if file (princ (concat "\n from the file \"" file "\"")))
+ (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 ")
(terpri)
(princ output))))
- (save-excursion
- (set-buffer standard-output)
+ (with-current-buffer standard-output
;; Return the text we displayed.
(buffer-string))))))))
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
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)))
(insert "\nThe parent category table is:")
(describe-vector table 'help-describe-category-set))))))
+\f
+;;; 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 "\1f" 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 "\1f" 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 "\1f" 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
HCoop / bpt / emacs.git / blobdiff