X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9418ab39bf970dd82b5d6f2e7b40a5d8cd134a43..1a5d0c15185986e645e8fb8080a2338d8f17d562:/lisp/help-fns.el diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d1c8b2dc47..9464c0b0d9 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -34,6 +34,7 @@ (require 'cl-lib) (require 'help-mode) +(require 'radix-tree) (defvar help-fns-describe-function-functions nil "List of functions to run in help buffer in `describe-function'. @@ -43,6 +44,61 @@ The functions will receive the function name as argument.") ;; Functions +(defvar help-definition-prefixes nil + ;; FIXME: We keep `definition-prefixes' as a hash-table so as to + ;; avoid pre-loading radix-tree and because it takes slightly less + ;; memory. But when we use this table it's more efficient to + ;; represent it as a radix tree, since the main operation is to do + ;; `radix-tree-prefixes'. Maybe we should just bite the bullet and + ;; use a radix tree for `definition-prefixes' (it's not *that* + ;; costly, really). + "Radix-tree representation replacing `definition-prefixes'.") + +(defun help-definition-prefixes () + "Return the up-to-date radix-tree form of `definition-prefixes'." + (when (> (hash-table-count definition-prefixes) 0) + (maphash (lambda (prefix files) + (let ((old (radix-tree-lookup help-definition-prefixes prefix))) + (setq help-definition-prefixes + (radix-tree-insert help-definition-prefixes + prefix (append old files))))) + definition-prefixes) + (clrhash definition-prefixes)) + help-definition-prefixes) + +(defun help--loaded-p (file) + "Try and figure out if FILE has already been loaded." + (or (let ((feature (intern-soft file))) + (and feature (featurep feature))) + (let* ((re (load-history-regexp file)) + (done nil)) + (dolist (x load-history) + (if (string-match-p re (car x)) (setq done t))) + done))) + +(defun help--load-prefixes (prefixes) + (pcase-dolist (`(,prefix . ,files) prefixes) + (setq help-definition-prefixes + (radix-tree-insert help-definition-prefixes prefix nil)) + (dolist (file files) + ;; FIXME: Should we scan help-definition-prefixes to remove + ;; other prefixes of the same file? + ;; FIXME: this regexp business is not good enough: for file + ;; `toto', it will say `toto' is loaded when in reality it was + ;; just cedet/semantic/toto that has been loaded. + (unless (help--loaded-p file) + (load file 'noerror 'nomessage))))) + +(defun help--symbol-completion-table (string pred action) + (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string))) + (help--load-prefixes prefixes)) + (let ((prefix-completions + (mapcar #'intern (all-completions string definition-prefixes)))) + (complete-with-action action obarray string + (if pred (lambda (sym) + (or (funcall pred sym) + (memq sym prefix-completions))))))) + (defvar describe-function-orig-buffer nil "Buffer that was current when `describe-function' was invoked. Functions on `help-fns-describe-function-functions' can use this @@ -58,8 +114,9 @@ to get buffer-local values.") (setq val (completing-read (if fn (format "Describe function (default %s): " fn) "Describe function: ") - obarray 'fboundp t nil nil - (and fn (symbol-name fn)))) + #'help--symbol-completion-table + #'fboundp + t nil nil (and fn (symbol-name fn)))) (list (if (equal val "") fn (intern val))))) (or (and function (symbolp function)) @@ -514,7 +571,8 @@ FILE is the file where FUNCTION was probably defined." real-function)) (aliased (or (symbolp def) ;; Advised & aliased function. - (and advised (symbolp real-function)))) + (and advised (symbolp real-function) + (not (eq 'autoload (car-safe def)))))) (real-def (cond (aliased (let ((f real-function)) (while (and (fboundp f) @@ -526,7 +584,8 @@ FILE is the file where FUNCTION was probably defined." (sig-key (if (subrp def) (indirect-function real-def) real-def)) - (file-name (find-lisp-object-file-name function def)) + (file-name (find-lisp-object-file-name function (if aliased 'defun + def))) (pt1 (with-current-buffer (help-buffer) (point))) (beg (if (and (or (byte-code-function-p def) (keymapp def) @@ -541,14 +600,14 @@ FILE is the file where FUNCTION was probably defined." ;; Print what kind of function-like object FUNCTION is. (princ (cond ((or (stringp def) (vectorp def)) "a keyboard macro") - ((subrp def) - (if (eq 'unevalled (cdr (subr-arity def))) - (concat beg "special form") - (concat beg "built-in function"))) ;; Aliases are Lisp functions, so we need to check ;; aliases before functions. (aliased (format-message "an alias for `%s'" real-def)) + ((subrp def) + (if (eq 'unevalled (cdr (subr-arity def))) + (concat beg "special form") + (concat beg "built-in function"))) ((autoloadp def) (format "%s autoloaded %s" (if (commandp def) "an interactive" "an") @@ -626,7 +685,7 @@ FILE is the file where FUNCTION was probably defined." ;; Avoid asking the user annoying questions if she decides ;; to save the help buffer, when her locale's codeset ;; isn't UTF-8. - (unless (memq text-quoting-style '(leave straight grave)) + (unless (memq text-quoting-style '(straight grave)) (set-buffer-file-coding-system 'utf-8)))))))) ;; Add defaults to `help-fns-describe-function-functions'. @@ -706,7 +765,7 @@ it is displayed along with the global value." (format "Describe variable (default %s): " v) "Describe variable: ") - obarray + #'help--symbol-completion-table (lambda (vv) ;; In case the variable only exists in the buffer ;; the command we switch back to that buffer before