aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2016-06-15 13:21:59 -0400
committerStefan Monnier2016-06-15 13:21:59 -0400
commitfd8084aaf925a52754e01f69f4b6c5593be0982d (patch)
tree50d311438e7f263c7a7a5cf833a49135adfda61c
parent40e0ef481160d0a0b2290d47c012cc50021a8a82 (diff)
downloademacs-fd8084aaf925a52754e01f69f4b6c5593be0982d.tar.gz
emacs-fd8084aaf925a52754e01f69f4b6c5593be0982d.zip
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 d4b5cd211e4..8146bb3c283 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -103,6 +103,47 @@
103 (if (integerp val) `(t . ,val) val) 103 (if (integerp val) `(t . ,val) val)
104 i)))) 104 i))))
105 105
106;; (defun radix-tree--trim (tree string i)
107;; (if (= i (length string))
108;; tree
109;; (pcase tree
110;; (`((,prefix . ,ptree) . ,rtree)
111;; (let* ((ni (+ i (length prefix)))
112;; (cmp (compare-strings prefix nil nil string i ni))
113;; ;; FIXME: We could compute nrtree more efficiently
114;; ;; whenever cmp is not -1 or 1.
115;; (nrtree (radix-tree--trim rtree string i)))
116;; (if (eq t cmp)
117;; (pcase (radix-tree--trim ptree string ni)
118;; (`nil nrtree)
119;; (`((,pprefix . ,pptree))
120;; `((,(concat prefix pprefix) . ,pptree) . ,nrtree))
121;; (nptree `((,prefix . ,nptree) . ,nrtree)))
122;; (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
123;; (cond
124;; ((equal (+ n i) (length string))
125;; `((,prefix . ,ptree) . ,nrtree))
126;; (t nrtree))))))
127;; (val val))))
128
129(defun radix-tree--prefixes (tree string i prefixes)
130 (pcase tree
131 (`((,prefix . ,ptree) . ,rtree)
132 (let* ((ni (+ i (length prefix)))
133 (cmp (compare-strings prefix nil nil string i ni))
134 ;; FIXME: We could compute prefixes more efficiently
135 ;; whenever cmp is not -1 or 1.
136 (prefixes (radix-tree--prefixes rtree string i prefixes)))
137 (if (eq t cmp)
138 (radix-tree--prefixes ptree string ni prefixes)
139 prefixes)))
140 (val
141 (if (null val)
142 prefixes
143 (cons (cons (substring string 0 i)
144 (if (eq (car-safe val) t) (cdr val) val))
145 prefixes)))))
146
106(defun radix-tree--subtree (tree string i) 147(defun radix-tree--subtree (tree string i)
107 (if (equal (length string) i) tree 148 (if (equal (length string) i) tree
108 (pcase tree 149 (pcase tree
@@ -143,6 +184,16 @@ If not found, return nil."
143 "Return the subtree of TREE rooted at the prefix STRING." 184 "Return the subtree of TREE rooted at the prefix STRING."
144 (radix-tree--subtree tree string 0)) 185 (radix-tree--subtree tree string 0))
145 186
187;; (defun radix-tree-trim (tree string)
188;; "Return a TREE which only holds entries \"related\" to STRING.
189;; \"Related\" is here defined as entries where there's a `string-prefix-p' relation
190;; between STRING and the key."
191;; (radix-tree-trim tree string 0))
192
193(defun radix-tree-prefixes (tree string)
194 "Return an alist of all bindings in TREE for prefixes of STRING."
195 (radix-tree--prefixes tree string 0 nil))
196
146(eval-and-compile 197(eval-and-compile
147 (pcase-defmacro radix-tree-leaf (vpat) 198 (pcase-defmacro radix-tree-leaf (vpat)
148 ;; FIXME: We'd like to use a negative pattern (not consp), but pcase 199 ;; FIXME: We'd like to use a negative pattern (not consp), but pcase
@@ -181,8 +232,15 @@ PREFIX is only used internally."
181 232
182(defun radix-tree-count (tree) 233(defun radix-tree-count (tree)
183 (let ((i 0)) 234 (let ((i 0))
184 (radix-tree-iter-mappings tree (lambda (_ _) (setq i (1+ i)))) 235 (radix-tree-iter-mappings tree (lambda (_k _v) (setq i (1+ i))))
185 i)) 236 i))
186 237
238(defun radix-tree-from-map (map)
239 ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
240 (require 'map)
241 (let ((rt nil))
242 (map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
243 rt))
244
187(provide 'radix-tree) 245(provide 'radix-tree)
188;;; radix-tree.el ends here 246;;; radix-tree.el ends here
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f5913928664..e92019f9345 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -34,6 +34,7 @@
34 34
35(require 'cl-lib) 35(require 'cl-lib)
36(require 'help-mode) 36(require 'help-mode)
37(require 'radix-tree)
37 38
38(defvar help-fns-describe-function-functions nil 39(defvar help-fns-describe-function-functions nil
39 "List of functions to run in help buffer in `describe-function'. 40 "List of functions to run in help buffer in `describe-function'.
@@ -43,6 +44,61 @@ The functions will receive the function name as argument.")
43 44
44;; Functions 45;; Functions
45 46
47(defvar help-definition-prefixes nil
48 ;; FIXME: We keep `definition-prefixes' as a hash-table so as to
49 ;; avoid pre-loading radix-tree and because it takes slightly less
50 ;; memory. But when we use this table it's more efficient to
51 ;; represent it as a radix tree, since the main operation is to do
52 ;; `radix-tree-prefixes'. Maybe we should just bite the bullet and
53 ;; use a radix tree for `definition-prefixes' (it's not *that*
54 ;; costly, really).
55 "Radix-tree representation replacing `definition-prefixes'.")
56
57(defun help-definition-prefixes ()
58 "Return the up-to-date radix-tree form of `definition-prefixes'."
59 (when (> (hash-table-count definition-prefixes) 0)
60 (maphash (lambda (prefix files)
61 (let ((old (radix-tree-lookup help-definition-prefixes prefix)))
62 (setq help-definition-prefixes
63 (radix-tree-insert help-definition-prefixes
64 prefix (append old files)))))
65 definition-prefixes)
66 (clrhash definition-prefixes))
67 help-definition-prefixes)
68
69(defun help--loaded-p (file)
70 "Try and figure out if FILE has already been loaded."
71 (or (let ((feature (intern-soft file)))
72 (and feature (featurep feature)))
73 (let* ((re (load-history-regexp file))
74 (done nil))
75 (dolist (x load-history)
76 (if (string-match-p re (car x)) (setq done t)))
77 done)))
78
79(defun help--load-prefixes (prefixes)
80 (pcase-dolist (`(,prefix . ,files) prefixes)
81 (setq help-definition-prefixes
82 (radix-tree-insert help-definition-prefixes prefix nil))
83 (dolist (file files)
84 ;; FIXME: Should we scan help-definition-prefixes to remove
85 ;; other prefixes of the same file?
86 ;; FIXME: this regexp business is not good enough: for file
87 ;; `toto', it will say `toto' is loaded when in reality it was
88 ;; just cedet/semantic/toto that has been loaded.
89 (unless (help--loaded-p file)
90 (load file 'noerror 'nomessage)))))
91
92(defun help--symbol-completion-table (string pred action)
93 (let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
94 (help--load-prefixes prefixes))
95 (let ((prefix-completions
96 (mapcar #'intern (all-completions string definition-prefixes))))
97 (complete-with-action action obarray string
98 (if pred (lambda (sym)
99 (or (funcall pred sym)
100 (memq sym prefix-completions)))))))
101
46(defvar describe-function-orig-buffer nil 102(defvar describe-function-orig-buffer nil
47 "Buffer that was current when `describe-function' was invoked. 103 "Buffer that was current when `describe-function' was invoked.
48Functions on `help-fns-describe-function-functions' can use this 104Functions on `help-fns-describe-function-functions' can use this
@@ -58,8 +114,9 @@ to get buffer-local values.")
58 (setq val (completing-read (if fn 114 (setq val (completing-read (if fn
59 (format "Describe function (default %s): " fn) 115 (format "Describe function (default %s): " fn)
60 "Describe function: ") 116 "Describe function: ")
61 obarray 'fboundp t nil nil 117 #'help--symbol-completion-table
62 (and fn (symbol-name fn)))) 118 #'fboundp
119 t nil nil (and fn (symbol-name fn))))
63 (list (if (equal val "") 120 (list (if (equal val "")
64 fn (intern val))))) 121 fn (intern val)))))
65 (or (and function (symbolp function)) 122 (or (and function (symbolp function))
@@ -706,7 +763,7 @@ it is displayed along with the global value."
706 (format 763 (format
707 "Describe variable (default %s): " v) 764 "Describe variable (default %s): " v)
708 "Describe variable: ") 765 "Describe variable: ")
709 obarray 766 #'help--symbol-completion-table
710 (lambda (vv) 767 (lambda (vv)
711 ;; In case the variable only exists in the buffer 768 ;; In case the variable only exists in the buffer
712 ;; the command we switch back to that buffer before 769 ;; the command we switch back to that buffer before