emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: master f995fbd: * lisp/server.el (server-name): Add autoload cookie.


From: Stefan Monnier
Subject: Re: master f995fbd: * lisp/server.el (server-name): Add autoload cookie. (Bug#23576)
Date: Wed, 25 May 2016 23:01:51 -0400
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1.50 (gnu/linux)

> Is that available on master?

I just pushed it, yes.

> If not, please push, and let's start using this.

The code I pushed just populates a new hash table `definition-prefixes'.
We still need to change help-fns.el (and various other places) to make
use of it.

I've used the patch below (which makes `C-h f' use that table during
completion), but it's just the temporary result of my experimentation
with it: it's fundamentally incorrect and hence needs to be rewritten.


        Stefan


diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 040152a..0f9ab0e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -43,6 +43,43 @@ help-fns-describe-function-functions
 
 ;; Functions
 
+(defun help--load-files (files)
+  (dolist (file files)
+    ;; 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.
+    (let ((re (load-history-regexp file))
+          (done nil))
+      (dolist (x load-history)
+        (if (string-match re (car x)) (setq done t)))
+      (maphash (lambda (prefix files)
+                 (when (member file files)
+                   (if (not (cdr files))
+                       (remhash prefix definition-prefixes)
+                     (puthash prefix (remove file files)
+                              definition-prefixes))))
+               definition-prefixes)
+      (unless done
+        (load file 'noerror)))))
+
+(defun help--symbol-completion-table (string pred action)
+  ;; FIXME: To minimize the size of the definition-prefixes table,
+  ;; we should/could use the rule that "foo-bar" can likely be found in file
+  ;; foo.el (or foo-mode.el).
+  (unless (eq 'lambda action)
+    (string-match "\\`[^-:/_]*[-:/_]*" string)
+    (let* ((prefix1 (match-string 0 string))
+           (prefixes (all-completions prefix1 definition-prefixes)))
+      (dolist (prefix (prog1 prefixes (setq prefixes nil)))
+        (when (string-prefix-p prefix string)
+          (help--load-files (gethash prefix definition-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,13 +95,14 @@ describe-function
      (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
+                                'confirm nil nil (and fn (symbol-name fn))))
      (list (if (equal val "")
               fn (intern val)))))
   (or (and function (symbolp function))
       (user-error "You didn't specify a function symbol"))
-  (or (fboundp function)
+  (or (help--symbol-function function)
       (user-error "Symbol's function definition is void: %s" function))
 
   ;; We save describe-function-orig-buffer on the help xref stack, so
@@ -299,6 +337,32 @@ find-lisp-object-file-name
             (src-file (locate-library file-name t nil 'readable)))
        (and src-file (file-readable-p src-file) src-file))))))
 
+(defun help--try-load-symbol (sym)
+  ;; FIXME: Here we use the rule that "foo-bar" can be found in "foo.el", but
+  ;; we should extend it to include "foo-mode.el", and we should additionally
+  ;; use `definition-prefixes'.
+  (let ((name (symbol-name sym)))
+    (while (not (zerop (length name)))
+      (let ((file (locate-file name load-path (get-load-suffixes))))
+        (if (and file (not (assoc (file-truename file) load-history)))
+            (progn (load file) (setq name ""))
+          (setq name
+                (if (string-match "[-:/][^-:/]*\\'" name)
+                    (substring name 0 (match-beginning 0))
+                  (message "Cannot find file for symbol %s" sym)
+                  "")))))))
+
+(defun help--symbol-function (sym)
+  "Like `symbol-function' except it may try to load files to find the 
function."
+  (or (symbol-function sym)
+      (progn
+        ;; The function either doesn't exist or is not loaded yet.
+        ;; Try to find it.
+        (help--try-load-symbol sym)
+        ;; We did find some file to load, but we don't know if it did provide
+        ;; the function we're looking for.
+        (symbol-function sym))))
+
 (defun help-fns--key-bindings (function)
   (when (commandp function)
     (let ((pt2 (with-current-buffer standard-output (point)))
@@ -329,12 +393,12 @@ help-fns--key-bindings
               ;; If lots of ordinary text characters run this command,
               ;; don't mention them one by one.
               (if (< (length non-modified-keys) 10)
-                  (princ (mapconcat 'key-description keys ", "))
+                  (princ (mapconcat #'key-description keys ", "))
                 (dolist (key non-modified-keys)
                   (setq keys (delq key keys)))
                 (if keys
                     (progn
-                      (princ (mapconcat 'key-description keys ", "))
+                      (princ (mapconcat #'key-description keys ", "))
                       (princ ", and many ordinary text characters"))
                   (princ "many ordinary text characters"))))
             (when (or remapped keys non-modified-keys)
@@ -509,17 +573,16 @@ describe-function-1
              function))
         ;; Get the real definition.
         (def (if (symbolp real-function)
-                 (or (symbol-function real-function)
-                     (signal 'void-function (list real-function)))
+                 (help--symbol-function real-function)
                real-function))
         (aliased (or (symbolp def)
                      ;; Advised & aliased function.
                      (and advised (symbolp real-function))))
         (real-def (cond
                    (aliased (let ((f real-function))
-                              (while (and (fboundp f)
-                                          (symbolp (symbol-function f)))
-                                (setq f (symbol-function f)))
+                        (while (and (fboundp f)
+                                    (symbolp (symbol-function f)))
+                          (setq f (symbol-function f)))
                               f))
                    ((subrp def) (intern (subr-name def)))
                    (t def)))
@@ -706,7 +769,7 @@ describe-variable
                     (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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]