(let ((generated-autoload-file buffer-file-name))
(autoload-generate-file-autoloads file (current-buffer))))
-(defun autoload--split-prefixes-1 (strs)
- (let ((prefixes ()))
- (dolist (str strs)
- (string-match "\\`[^-:/_]*[-:/_]*" str)
- (let* ((prefix (match-string 0 str))
- (tail (substring str (match-end 0)))
- (cell (assoc prefix prefixes)))
- (cond
- ((null cell) (push (list prefix tail) prefixes))
- ((equal (cadr cell) tail) nil)
- (t (setcdr cell (cons tail (cdr cell)))))))
- prefixes))
-
-(defun autoload--split-prefixes (prefixes)
- (apply #'nconc
- (mapcar (lambda (cell)
- (let ((prefix (car cell)))
- (mapcar (lambda (cell)
- (cons (concat prefix (car cell)) (cdr cell)))
- (autoload--split-prefixes-1 (cdr cell)))))
- prefixes)))
-
(defvar autoload-compute-prefixes t
"If non-nil, autoload will add code to register the prefixes used in a file.
Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
variables or functions that use \"foo-\" as prefix, that will not be registered.
But all other prefixes will be included.")
-(defconst autoload-defs-autoload-max-size 5
+(defconst autoload-def-prefixes-max-entries 5
"Target length of the list of definition prefixes per file.
If set too small, the prefixes will be too generic (i.e. they'll use little
memory, we'll end up looking in too many files when we need a particular
prefix), and if set too large, they will be too specific (i.e. they will
cost more memory use).")
-(defvar autoload-popular-prefixes nil)
+(defconst autoload-def-prefixes-max-length 12
+ "Target size of definition prefixes.
+Don't try to split prefixes that are already longer than that.")
+
+(require 'radix-tree)
(defun autoload--make-defs-autoload (defs file)
+
;; Remove the defs that obey the rule that file foo.el (or
;; foo-mode.el) uses "foo-" as prefix.
;; FIXME: help--symbol-completion-table still doesn't know how to use
;; Then compute a small set of prefixes that cover all the
;; remaining definitions.
- (let ((prefixes (autoload--split-prefixes-1 defs))
- (again t))
- ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes))
- (while again
- (setq again nil)
- (let ((newprefixes
- (sort
- (mapcar (lambda (cell)
- (cons cell
- (autoload--split-prefixes-1 (cdr cell))))
- prefixes)
- (lambda (x y) (< (length (cdr x)) (length (cdr y)))))))
- (setq prefixes nil)
- (while newprefixes
- (let ((x (pop newprefixes)))
- (if (or (equal '("") (cdar x))
- (and (cddr x)
- (not (member (caar x)
- autoload-popular-prefixes))
- (> (+ (length prefixes) (length newprefixes)
- (length (cdr x)))
- autoload-defs-autoload-max-size)))
- ;; Nothing to split or would split too deep.
- (push (car x) prefixes)
- ;; (message "Expand %S to %S" (caar x) (cdr x))
- (setq again t)
- (setq prefixes
- (nconc (mapcar (lambda (cell)
- (cons (concat (caar x)
- (car cell))
- (cdr cell)))
- (cdr x))
- prefixes)))))))
+ (let* ((tree (let ((tree radix-tree-empty))
+ (dolist (def defs)
+ (setq tree (radix-tree-insert tree def t)))
+ tree))
+ (prefixes nil))
+ ;; Get the root prefixes, that we should include in any case.
+ (radix-tree-iter-subtrees
+ tree (lambda (prefix subtree)
+ (push (cons prefix subtree) prefixes)))
+ ;; In some cases, the root prefixes are too short, e.g. if you define
+ ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
+ (dolist (pair (prog1 prefixes (setq prefixes nil)))
+ (let ((s (car pair)))
+ (if (or (> (length s) 2) ;Long enough!
+ (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
+ (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
+ (push pair prefixes) ;Keep it as is.
+ (radix-tree-iter-subtrees
+ (cdr pair) (lambda (prefix subtree)
+ (push (cons (concat s prefix) subtree) prefixes))))))
+ ;; FIXME: The expansions done below are mostly pointless, such as
+ ;; for `yenc', where we replace "yenc-" with an exhaustive list (5
+ ;; elements).
+ ;; (while
+ ;; (let ((newprefixes nil)
+ ;; (changes nil))
+ ;; (dolist (pair prefixes)
+ ;; (let ((prefix (car pair)))
+ ;; (if (or (> (length prefix) autoload-def-prefixes-max-length)
+ ;; (radix-tree-lookup (cdr pair) ""))
+ ;; ;; No point splitting it any further.
+ ;; (push pair newprefixes)
+ ;; (setq changes t)
+ ;; (radix-tree-iter-subtrees
+ ;; (cdr pair) (lambda (sprefix subtree)
+ ;; (push (cons (concat prefix sprefix) subtree)
+ ;; newprefixes))))))
+ ;; (and changes
+ ;; (<= (length newprefixes)
+ ;; autoload-def-prefixes-max-entries)
+ ;; (let ((new nil)
+ ;; (old nil))
+ ;; (dolist (pair prefixes)
+ ;; (unless (memq pair newprefixes) ;Not old
+ ;; (push pair old)))
+ ;; (dolist (pair newprefixes)
+ ;; (unless (memq pair prefixes) ;Not new
+ ;; (push pair new)))
+ ;; (cl-assert new)
+ ;; (message "Expanding %S to %S"
+ ;; (mapcar #'car old) (mapcar #'car new))
+ ;; t)
+ ;; (setq prefixes newprefixes)
+ ;; (< (length prefixes) autoload-def-prefixes-max-entries))))
+
;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes
- `(if (fboundp 'register-definition-prefixes)
- (register-definition-prefixes ,file ',(mapcar #'car prefixes))))))
+ (let ((strings
+ (mapcar
+ (lambda (x)
+ (let ((prefix (car x)))
+ (if (or (> (length prefix) 2) ;Long enough!
+ (string-match ".[[:punct:]]\\'" prefix))
+ prefix
+ ;; Some packages really don't follow the rules.
+ ;; Drop the most egregious cases such as the
+ ;; one-letter prefixes.
+ (let ((dropped ()))
+ (radix-tree-iter-mappings
+ (cdr x) (lambda (s _)
+ (push (concat prefix s) dropped)))
+ (message "Not registering prefix \"%s\" from %s. Affects: %S"
+ prefix file dropped)
+ nil))))
+ prefixes)))
+ `(if (fboundp 'register-definition-prefixes)
+ (register-definition-prefixes ,file ',(delq nil strings)))))))
(defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf
"define-obsolete-variable-alias"
"define-category" "define-key"
"defgroup" "defface" "defadvice"
+ "def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
+ "define-erc-response-handler"
"defun-rcirc-command"))))
(push (match-string 2) defs))
(forward-sexp 1)
t files-re))
dirs)))
(done ()) ;Files processed; to remove duplicates.
- (changed nil) ;Non-nil if some change occured.
+ (changed nil) ;Non-nil if some change occurred.
(last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.