[Emacs-diffs] master fd8084a: Automatically find vars and functions via definition-prefixes

[Stefan Monnier]

branch: master
commit fd8084aaf925a52754e01f69f4b6c5593be0982d
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    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.
---
 lisp/emacs-lisp/radix-tree.el |   60 ++++++++++++++++++++++++++++++++++++++-
 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 d4b5cd2..8146bb3 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 f591392..e92019f 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