diff options
| author | Stefan Monnier | 2016-06-15 13:21:59 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2016-06-15 13:21:59 -0400 |
| commit | fd8084aaf925a52754e01f69f4b6c5593be0982d (patch) | |
| tree | 50d311438e7f263c7a7a5cf833a49135adfda61c | |
| parent | 40e0ef481160d0a0b2290d47c012cc50021a8a82 (diff) | |
| download | emacs-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.el | 60 | ||||
| -rw-r--r-- | lisp/help-fns.el | 63 |
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. |
| 48 | Functions on `help-fns-describe-function-functions' can use this | 104 | Functions 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 |