X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2699a55464f7b43171c7b0e64d095640904e9e21..8d17e7ca1fa68263a45db1e38506875a387ccc24:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d49b06a16e..0876b34d3e 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,7 +1,6 @@ -;;; help-fns.el --- Complex help functions +;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*- -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1985-1986, 1993-1994, 1998-2011 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -77,15 +76,18 @@ DEF is the function whose usage we're looking for in DOCSTRING." ;; Replace `fn' with the actual function name. (if (consp def) "anonymous" def) (match-string 1 docstring)) - (substring docstring 0 (match-beginning 0))))) + (unless (zerop (match-beginning 0)) + (substring docstring 0 (match-beginning 0)))))) +;; FIXME: Move to subr.el? (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)) + (unless (stringp docstring) (setq docstring "")) + (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) + (eq arglist t)) docstring (concat docstring (if (string-match "\n?\n\\'" docstring) @@ -96,18 +98,52 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (concat "(fn" (match-string 1 arglist) ")") (format "%S" (help-make-usage 'fn arglist)))))) +;; FIXME: Move to subr.el? (defun help-function-arglist (def) ;; Handle symbols aliased to other symbols. (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond + ((and (byte-code-function-p def) (integerp (aref def 0))) + (let* ((args-desc (aref def 0)) + (max (lsh args-desc -8)) + (min (logand args-desc 127)) + (rest (logand args-desc 128)) + (arglist ())) + (dotimes (i min) + (push (intern (concat "arg" (number-to-string (1+ i)))) arglist)) + (when (> max min) + (push '&optional arglist) + (dotimes (i (- max min)) + (push (intern (concat "arg" (number-to-string (+ 1 i min)))) + arglist))) + (unless (zerop rest) (push '&rest arglist) (push 'rest arglist)) + (nreverse arglist))) ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) + ((eq (car-safe def) 'closure) (nth 2 def)) + ((subrp def) + (let ((arity (subr-arity def)) + (arglist ())) + (dotimes (i (car arity)) + (push (intern (concat "arg" (number-to-string (1+ i)))) arglist)) + (cond + ((not (numberp (cdr arglist))) + (push '&rest arglist) + (push 'rest arglist)) + ((< (car arity) (cdr arity)) + (push '&optional arglist) + (dotimes (i (- (cdr arity) (car arity))) + (push (intern (concat "arg" (number-to-string + (+ 1 i (car arity))))) + arglist)))) + (nreverse arglist))) ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t))) +;; FIXME: Move to subr.el? (defun help-make-usage (function arglist) (cons (if (symbolp function) function 'anonymous) (mapcar (lambda (arg) @@ -118,8 +154,11 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (cdr arg)) arg) (let ((name (symbol-name arg))) - (if (string-match "\\`&" name) arg - (intern (upcase name)))))) + (cond + ((string-match "\\`&" name) arg) + ((string-match "\\`_" name) + (intern (upcase (substring name 1)))) + (t (intern (upcase name))))))) arglist))) ;; Could be this, if we make symbol-file do the work below. @@ -191,7 +230,7 @@ if the variable `help-downcase-arguments' is non-nil." doc t t 1))))) (defun help-highlight-arguments (usage doc &rest args) - (when usage + (when (and usage (string-match "^(" usage)) (with-temp-buffer (insert usage) (goto-char (point-min)) @@ -289,13 +328,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)))) @@ -348,8 +393,7 @@ suitable file is found, return nil." (pt1 (with-current-buffer (help-buffer) (point))) errtype) (setq string - (cond ((or (stringp def) - (vectorp def)) + (cond ((or (stringp def) (vectorp def)) "a keyboard macro") ((subrp def) (if (eq 'unevalled (cdr (subr-arity def))) @@ -368,6 +412,8 @@ suitable file is found, return nil." (concat beg "Lisp function")) ((eq (car-safe def) 'macro) "a Lisp macro") + ((eq (car-safe def) 'closure) + (concat beg "Lisp closure")) ((eq (car-safe def) 'autoload) (format "%s autoloaded %s" (if (commandp def) "an interactive" "an") @@ -471,7 +517,8 @@ suitable file is found, return nil." (let* ((advertised (gethash def advertised-signature-table t)) (arglist (if (listp advertised) advertised (help-function-arglist def))) - (doc (documentation function)) + (doc (condition-case err (documentation function) + (error (format "No Doc! %S" err)))) (usage (help-split-fundoc doc function))) (with-current-buffer standard-output ;; If definition is a keymap, skip arglist note. @@ -528,6 +575,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." (with-syntax-table emacs-lisp-mode-syntax-table (or (condition-case () (save-excursion + (skip-chars-forward "'") (or (not (zerop (skip-syntax-backward "_w"))) (eq (char-syntax (following-char)) ?w) (eq (char-syntax (following-char)) ?_) @@ -586,9 +634,9 @@ it is displayed along with the global value." "Describe variable (default %s): " v) "Describe variable: ") obarray - '(lambda (vv) - (or (boundp vv) - (get vv 'variable-documentation))) + (lambda (vv) + (or (get vv 'variable-documentation) + (not (keywordp vv)))) t nil nil (if (symbolp v) (symbol-name v)))) (list (if (equal val "") @@ -633,19 +681,16 @@ 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 @@ -660,7 +705,6 @@ it is displayed along with the global value." (if (< (point) (+ from 20)) (delete-region (1- from) from))))))) (terpri) - (when locus (if (bufferp locus) (princ (format "%socal in buffer %s; " @@ -746,15 +790,21 @@ it is displayed along with the global value." (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))))) + (not (file-remote-p (buffer-file-name))) + (dir-locals-find-file + (buffer-file-name)))) + (type "file")) (princ " This variable is a directory local variable") (when file - (princ (concat "\n from the file \"" - (if (consp file) - (car file) - file) - "\""))) + (if (consp file) ; result from cache + ;; If the cache element has an mtime, we + ;; assume it came from a file. + (if (nth 2 file) + (setq file (expand-file-name + dir-locals-file (car file))) + ;; Otherwise, assume it was set directly. + (setq type "directory"))) + (princ (format "\n from the %s \"%s\"" type file))) (princ ".\n")) (princ " This variable is a file local variable.\n"))) @@ -829,7 +879,7 @@ BUFFER defaults to the current buffer." (insert (cond ((null value) "default") ((char-table-p value) "deeper char-table ...") - (t (condition-case err + (t (condition-case nil (category-set-mnemonics value) (error "invalid"))))))