(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'.
;; 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
(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))
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)
;; 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")
(interactive
(let ((v (variable-at-point))
(enable-recursive-minibuffers t)
+ (orig-buffer (current-buffer))
val)
- (setq val (completing-read (if (symbolp v)
- (format
- "Describe variable (default %s): " v)
- "Describe variable: ")
- obarray
- (lambda (vv)
- (or (get vv 'variable-documentation)
- (and (boundp vv) (not (keywordp vv)))))
- t nil nil
- (if (symbolp v) (symbol-name v))))
+ (setq val (completing-read
+ (if (symbolp v)
+ (format
+ "Describe variable (default %s): " v)
+ "Describe variable: ")
+ #'help--symbol-completion-table
+ (lambda (vv)
+ ;; In case the variable only exists in the buffer
+ ;; the command we switch back to that buffer before
+ ;; we examine the variable.
+ (with-current-buffer orig-buffer
+ (or (get vv 'variable-documentation)
+ (and (boundp vv) (not (keywordp vv))))))
+ t nil nil
+ (if (symbolp v) (symbol-name v))))
(list (if (equal val "")
v (intern val)))))
(let (file-name)
(unless valvoid
(with-current-buffer standard-output
(setq val-start-pos (point))
- (princ "value is ")
- (let ((from (point))
- (line-beg (line-beginning-position))
+ (princ "value is")
+ (let ((line-beg (line-beginning-position))
(print-rep
(let ((rep
(let ((print-quoted t))
(format-message "`%s'" rep)
rep))))
(if (< (+ (length print-rep) (point) (- line-beg)) 68)
- (insert print-rep)
+ (insert " " print-rep)
(terpri)
(pp val)
- (if (< (point) (+ 68 (line-beginning-position 0)))
- (delete-region from (1+ from))
- (delete-region (1- from) from)))
+ ;; Remove trailing newline.
+ (delete-char -1))
(let* ((sv (get variable 'standard-value))
(origval (and (consp sv)
(condition-case nil
(eval (car sv))
- (error :help-eval-error)))))
+ (error :help-eval-error))))
+ from)
(when (and (consp sv)
(not (equal origval val))
(not (equal origval :help-eval-error)))
(buffer-file-name buffer)))
(dir-locals-find-file
(buffer-file-name buffer))))
- (dir-file t))
+ (is-directory nil))
(princ (substitute-command-keys
" This variable's value is directory-local"))
- (if (null file)
- (princ ".\n")
- (princ ", set ")
- (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 file (car file)
- dir-file nil)))
- (princ (substitute-command-keys
- (if dir-file
- "by the file\n `"
- "for the directory\n `")))
+ (when (consp file) ; result from cache
+ ;; If the cache element has an mtime, we
+ ;; assume it came from a file.
+ (if (nth 2 file)
+ ;; (car file) is a directory.
+ (setq file (dir-locals--all-files (car file)))
+ ;; Otherwise, assume it was set directly.
+ (setq file (car file)
+ is-directory t)))
+ (if (null file)
+ (princ ".\n")
+ (princ ", set ")
+ (princ (substitute-command-keys
+ (cond
+ (is-directory "for the directory\n `")
+ ;; Many files matched.
+ ((and (consp file) (cdr file))
+ (setq file (file-name-directory (car file)))
+ (format "by one of the\n %s files in the directory\n `"
+ dir-locals-file))
+ (t (setq file (car file))
+ "by the file\n `"))))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
- 'help-args (list variable file)))
+ 'help-args (list variable file)))
(princ (substitute-command-keys "'.\n"))))
(princ (substitute-command-keys
" This variable's value is file-local.\n"))))
(if (or (not (vectorp docs)) (/= (length docs) 95))
(error "Invalid first extra slot in this category table\n"))
(with-current-buffer standard-output
- (insert "Legend of category mnemonics (see the tail for the longer description)\n")
+ (setq-default help-button-cache (make-marker))
+ (insert "Legend of category mnemonics ")
+ (insert-button "(longer descriptions at the bottom)"
+ 'action help-button-cache
+ 'follow-link t
+ 'help-echo "mouse-2, RET: show full legend")
+ (insert "\n")
(let ((pos (point)) (items 0) lines n)
(dotimes (i 95)
(if (aref docs i) (setq items (1+ items))))
"character(s)\tcategory mnemonics\n"
"------------\t------------------")
(describe-vector table 'help-describe-category-set)
+ (set-marker help-button-cache (point))
(insert "Legend of category mnemonics:\n")
(dotimes (i 95)
(let ((elt (aref docs i)))