From fd8084aaf925a52754e01f69f4b6c5593be0982d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 15 Jun 2016 13:21:59 -0400 Subject: [PATCH] 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 d4b5cd211e4..8146bb3c283 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 f5913928664..e92019f9345 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 -- 2.39.2