summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2016-06-15 13:21:59 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2016-06-15 13:21:59 -0400
commitfd8084aaf925a52754e01f69f4b6c5593be0982d (patch)
tree50d311438e7f263c7a7a5cf833a49135adfda61c
parent40e0ef481160d0a0b2290d47c012cc50021a8a82 (diff)
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.
-rw-r--r--lisp/emacs-lisp/radix-tree.el60
-rw-r--r--lisp/help-fns.el63
2 files changed, 119 insertions, 4 deletions
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index d4b5cd211e..8146bb3c28 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -103,6 +103,47 @@
(if (integerp val) `(t . ,val) val)
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)
(if (equal (length string) i) tree
(pcase tree
@@ -143,6 +184,16 @@ If not found, return nil."
"Return the subtree of TREE rooted at the prefix STRING."
(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
(pcase-defmacro radix-tree-leaf (vpat)
;; 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)
(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))
+(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)
;;; radix-tree.el ends here
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f591392866..e92019f934 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))
@@ -706,7 +763,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