procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload): Expand less

Browse source
This commit is contained in:
Stefan Monnier 2016-06-01 14:54:40 -04:00
parent a76420cce2
commit 4428f5a97b
1 changed files with 72 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

95
lisp/emacs-lisp/autoload.el
View file

@ -537,32 +537,79 @@ Don't try to split prefixes that are already longer than that.")
(dolist (def defs) (dolist (def defs)
(setq tree (radix-tree-insert tree def t))) (setq tree (radix-tree-insert tree def t)))
tree)) tree))
(prefixes (list (cons "" tree)))) (prefixes nil))
(while ;; Get the root prefixes, that we should include in any case.
(let ((newprefixes nil) (radix-tree-iter-subtrees
(changes nil)) tree (lambda (prefix subtree)
(dolist (pair prefixes) (push (cons prefix subtree) prefixes)))
(let ((prefix (car pair))) ;; In some cases, the root prefixes are too short, e.g. if you define
(if (or (> (length prefix) autoload-def-prefixes-max-length) ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
(radix-tree-lookup (cdr pair) "")) (dolist (pair (prog1 prefixes (setq prefixes nil)))
;; No point splitting it any further. (let ((s (car pair)))
(push pair newprefixes) (if (or (> (length s) 2) ;Long enough!
(setq changes t) (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
(radix-tree-iter-subtrees (radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
(cdr pair) (lambda (sprefix subtree) (push pair prefixes) ;Keep it as is.
(push (cons (concat prefix sprefix) subtree) (radix-tree-iter-subtrees
newprefixes)))))) (cdr pair) (lambda (prefix subtree)
(and changes (push (cons (concat s prefix) subtree) prefixes))))))
(or (and (null (cdr prefixes)) (equal "" (caar prefixes))) ;; FIXME: The expansions done below are mostly pointless, such as
(<= (length newprefixes) ;; for `yenc', where we replace "yenc-" with an exhaustive list (5
autoload-def-prefixes-max-entries)) ;; elements).
(setq prefixes newprefixes) ;; (while
(< (length prefixes) autoload-def-prefixes-max-entries)))) ;; (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)) ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes (when prefixes
`(if (fboundp 'register-definition-prefixes) (let ((strings
(register-definition-prefixes ,file ',(mapcar #'car prefixes)))))) (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) (defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf (let ((outbuf
@ -714,8 +761,10 @@ FILE's modification time."
"define-obsolete-variable-alias" "define-obsolete-variable-alias"
"define-category" "define-key" "define-category" "define-key"
"defgroup" "defface" "defadvice" "defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly: ;; Hmm... this is getting ugly:
"define-widget" "define-widget"
"define-erc-response-handler"
"defun-rcirc-command")))) "defun-rcirc-command"))))
(push (match-string 2) defs)) (push (match-string 2) defs))
(forward-sexp 1) (forward-sexp 1)