mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-03 18:41:25 -08:00
Automatically find vars and functions via definition-prefixes
* lisp/help-fns.el (help-definition-prefixes): New var and function. (help--loaded-p, help--load-prefixes, help--symbol-completion-table): New functions. (describe-function, describe-variable): Use them. * lisp/emacs-lisp/radix-tree.el (radix-tree--prefixes) (radix-tree-prefixes, radix-tree-from-map): New functions.
This commit is contained in:
parent
40e0ef4811
commit
fd8084aaf9
2 changed files with 119 additions and 4 deletions
|
|
@ -103,6 +103,47 @@
|
||||||
(if (integerp val) `(t . ,val) val)
|
(if (integerp val) `(t . ,val) val)
|
||||||
i))))
|
i))))
|
||||||
|
|
||||||
|
;; (defun radix-tree--trim (tree string i)
|
||||||
|
;; (if (= i (length string))
|
||||||
|
;; tree
|
||||||
|
;; (pcase tree
|
||||||
|
;; (`((,prefix . ,ptree) . ,rtree)
|
||||||
|
;; (let* ((ni (+ i (length prefix)))
|
||||||
|
;; (cmp (compare-strings prefix nil nil string i ni))
|
||||||
|
;; ;; FIXME: We could compute nrtree more efficiently
|
||||||
|
;; ;; whenever cmp is not -1 or 1.
|
||||||
|
;; (nrtree (radix-tree--trim rtree string i)))
|
||||||
|
;; (if (eq t cmp)
|
||||||
|
;; (pcase (radix-tree--trim ptree string ni)
|
||||||
|
;; (`nil nrtree)
|
||||||
|
;; (`((,pprefix . ,pptree))
|
||||||
|
;; `((,(concat prefix pprefix) . ,pptree) . ,nrtree))
|
||||||
|
;; (nptree `((,prefix . ,nptree) . ,nrtree)))
|
||||||
|
;; (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
|
||||||
|
;; (cond
|
||||||
|
;; ((equal (+ n i) (length string))
|
||||||
|
;; `((,prefix . ,ptree) . ,nrtree))
|
||||||
|
;; (t nrtree))))))
|
||||||
|
;; (val val))))
|
||||||
|
|
||||||
|
(defun radix-tree--prefixes (tree string i prefixes)
|
||||||
|
(pcase tree
|
||||||
|
(`((,prefix . ,ptree) . ,rtree)
|
||||||
|
(let* ((ni (+ i (length prefix)))
|
||||||
|
(cmp (compare-strings prefix nil nil string i ni))
|
||||||
|
;; FIXME: We could compute prefixes more efficiently
|
||||||
|
;; whenever cmp is not -1 or 1.
|
||||||
|
(prefixes (radix-tree--prefixes rtree string i prefixes)))
|
||||||
|
(if (eq t cmp)
|
||||||
|
(radix-tree--prefixes ptree string ni prefixes)
|
||||||
|
prefixes)))
|
||||||
|
(val
|
||||||
|
(if (null val)
|
||||||
|
prefixes
|
||||||
|
(cons (cons (substring string 0 i)
|
||||||
|
(if (eq (car-safe val) t) (cdr val) val))
|
||||||
|
prefixes)))))
|
||||||
|
|
||||||
(defun radix-tree--subtree (tree string i)
|
(defun radix-tree--subtree (tree string i)
|
||||||
(if (equal (length string) i) tree
|
(if (equal (length string) i) tree
|
||||||
(pcase tree
|
(pcase tree
|
||||||
|
|
@ -143,6 +184,16 @@ If not found, return nil."
|
||||||
"Return the subtree of TREE rooted at the prefix STRING."
|
"Return the subtree of TREE rooted at the prefix STRING."
|
||||||
(radix-tree--subtree tree string 0))
|
(radix-tree--subtree tree string 0))
|
||||||
|
|
||||||
|
;; (defun radix-tree-trim (tree string)
|
||||||
|
;; "Return a TREE which only holds entries \"related\" to STRING.
|
||||||
|
;; \"Related\" is here defined as entries where there's a `string-prefix-p' relation
|
||||||
|
;; between STRING and the key."
|
||||||
|
;; (radix-tree-trim tree string 0))
|
||||||
|
|
||||||
|
(defun radix-tree-prefixes (tree string)
|
||||||
|
"Return an alist of all bindings in TREE for prefixes of STRING."
|
||||||
|
(radix-tree--prefixes tree string 0 nil))
|
||||||
|
|
||||||
(eval-and-compile
|
(eval-and-compile
|
||||||
(pcase-defmacro radix-tree-leaf (vpat)
|
(pcase-defmacro radix-tree-leaf (vpat)
|
||||||
;; FIXME: We'd like to use a negative pattern (not consp), but pcase
|
;; FIXME: We'd like to use a negative pattern (not consp), but pcase
|
||||||
|
|
@ -181,8 +232,15 @@ PREFIX is only used internally."
|
||||||
|
|
||||||
(defun radix-tree-count (tree)
|
(defun radix-tree-count (tree)
|
||||||
(let ((i 0))
|
(let ((i 0))
|
||||||
(radix-tree-iter-mappings tree (lambda (_ _) (setq i (1+ i))))
|
(radix-tree-iter-mappings tree (lambda (_k _v) (setq i (1+ i))))
|
||||||
i))
|
i))
|
||||||
|
|
||||||
|
(defun radix-tree-from-map (map)
|
||||||
|
;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
|
||||||
|
(require 'map)
|
||||||
|
(let ((rt nil))
|
||||||
|
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
|
||||||
|
rt))
|
||||||
|
|
||||||
(provide 'radix-tree)
|
(provide 'radix-tree)
|
||||||
;;; radix-tree.el ends here
|
;;; radix-tree.el ends here
|
||||||
|
|
|
||||||
|
|
@ -34,6 +34,7 @@
|
||||||
|
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(require 'help-mode)
|
(require 'help-mode)
|
||||||
|
(require 'radix-tree)
|
||||||
|
|
||||||
(defvar help-fns-describe-function-functions nil
|
(defvar help-fns-describe-function-functions nil
|
||||||
"List of functions to run in help buffer in `describe-function'.
|
"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
|
;; 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
|
(defvar describe-function-orig-buffer nil
|
||||||
"Buffer that was current when `describe-function' was invoked.
|
"Buffer that was current when `describe-function' was invoked.
|
||||||
Functions on `help-fns-describe-function-functions' can use this
|
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
|
(setq val (completing-read (if fn
|
||||||
(format "Describe function (default %s): " fn)
|
(format "Describe function (default %s): " fn)
|
||||||
"Describe function: ")
|
"Describe function: ")
|
||||||
obarray 'fboundp t nil nil
|
#'help--symbol-completion-table
|
||||||
(and fn (symbol-name fn))))
|
#'fboundp
|
||||||
|
t nil nil (and fn (symbol-name fn))))
|
||||||
(list (if (equal val "")
|
(list (if (equal val "")
|
||||||
fn (intern val)))))
|
fn (intern val)))))
|
||||||
(or (and function (symbolp function))
|
(or (and function (symbolp function))
|
||||||
|
|
@ -706,7 +763,7 @@ it is displayed along with the global value."
|
||||||
(format
|
(format
|
||||||
"Describe variable (default %s): " v)
|
"Describe variable (default %s): " v)
|
||||||
"Describe variable: ")
|
"Describe variable: ")
|
||||||
obarray
|
#'help--symbol-completion-table
|
||||||
(lambda (vv)
|
(lambda (vv)
|
||||||
;; In case the variable only exists in the buffer
|
;; In case the variable only exists in the buffer
|
||||||
;; the command we switch back to that buffer before
|
;; the command we switch back to that buffer before
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue