aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2016-05-25 22:58:18 -0400
committerStefan Monnier2016-05-25 22:58:18 -0400
commite971ce6de27f982720ef312637e1d40da80e8d1f (patch)
tree6ddb289c64ff223328de649b4411c7398bb4bc72
parent1ee91bf89176251f6e399c8436dca0248cdd6f6b (diff)
downloademacs-e971ce6de27f982720ef312637e1d40da80e8d1f.tar.gz
emacs-e971ce6de27f982720ef312637e1d40da80e8d1f.zip
Make autoloads populate a new definition-prefixes table
* lisp/subr.el (definition-prefixes): New hash table. (register-definition-prefixes): New function. * lisp/emacs-lisp/autoload.el (autoload-compute-prefixes): New var. (autoload--split-prefixes-1, autoload--split-prefixes) (autoload--make-defs-autoload): New functions. (autoload-defs-autoload-max-size, autoload-popular-prefixes): New vars. (autoload-generate-file-autoloads): Obey autoload-compute-prefixes. (update-directory-autoloads): Don't touch loaddefs.el if the set of autoloads hasn't changed (i.e. if only the timestamp would change). * lisp/loadup.el: Purify definition-prefixes. * lisp/w32-fns.el: Keep name space clean. (w32-set-default-process-coding-system): Rename from set-default-process-coding-system. (w32-set-system-coding-system): Rename from set-w32-system-coding-system.
-rw-r--r--lisp/emacs-lisp/autoload.el196
-rw-r--r--lisp/loadup.el6
-rw-r--r--lisp/subr.el11
-rw-r--r--lisp/w32-fns.el11
4 files changed, 205 insertions, 19 deletions
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index aedee8c7636..80f5c28f3ec 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -183,10 +183,12 @@ expression, in which case we want to handle forms differently."
183 (args (pcase car 183 (args (pcase car
184 ((or `defun `defmacro 184 ((or `defun `defmacro
185 `defun* `defmacro* `cl-defun `cl-defmacro 185 `defun* `defmacro* `cl-defun `cl-defmacro
186 `define-overloadable-function) (nth 2 form)) 186 `define-overloadable-function)
187 (nth 2 form))
187 (`define-skeleton '(&optional str arg)) 188 (`define-skeleton '(&optional str arg))
188 ((or `define-generic-mode `define-derived-mode 189 ((or `define-generic-mode `define-derived-mode
189 `define-compilation-mode) nil) 190 `define-compilation-mode)
191 nil)
190 (_ t))) 192 (_ t)))
191 (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) 193 (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
192 (doc (if (stringp (car body)) (pop body)))) 194 (doc (if (stringp (car body)) (pop body))))
@@ -202,7 +204,8 @@ expression, in which case we want to handle forms differently."
202 define-global-minor-mode 204 define-global-minor-mode
203 define-globalized-minor-mode 205 define-globalized-minor-mode
204 easy-mmode-define-minor-mode 206 easy-mmode-define-minor-mode
205 define-minor-mode)) t) 207 define-minor-mode))
208 t)
206 (eq (car-safe (car body)) 'interactive)) 209 (eq (car-safe (car body)) 'interactive))
207 ,(if macrop ''macro nil)))) 210 ,(if macrop ''macro nil))))
208 211
@@ -313,7 +316,7 @@ The variable `autoload-print-form-outbuf' specifies the buffer to
313put the output in." 316put the output in."
314 (cond 317 (cond
315 ;; If the form is a sequence, recurse. 318 ;; If the form is a sequence, recurse.
316 ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form))) 319 ((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
317 ;; Symbols at the toplevel are meaningless. 320 ;; Symbols at the toplevel are meaningless.
318 ((symbolp form) nil) 321 ((symbolp form) nil)
319 (t 322 (t
@@ -413,6 +416,16 @@ make it writable."
413(defun autoload-insert-section-header (outbuf autoloads load-name file time) 416(defun autoload-insert-section-header (outbuf autoloads load-name file time)
414 "Insert the section-header line, 417 "Insert the section-header line,
415which lists the file name and which functions are in it, etc." 418which lists the file name and which functions are in it, etc."
419 ;; (cl-assert ;Make sure we don't insert it in the middle of another section.
420 ;; (save-excursion
421 ;; (or (not (re-search-backward
422 ;; (concat "\\("
423 ;; (regexp-quote generate-autoload-section-header)
424 ;; "\\)\\|\\("
425 ;; (regexp-quote generate-autoload-section-trailer)
426 ;; "\\)")
427 ;; nil t))
428 ;; (match-end 2))))
416 (insert generate-autoload-section-header) 429 (insert generate-autoload-section-header)
417 (prin1 `(autoloads ,autoloads ,load-name ,file ,time) 430 (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
418 outbuf) 431 outbuf)
@@ -471,7 +484,7 @@ which lists the file name and which functions are in it, etc."
471 ;; without checking its content. This makes it generate wrong load 484 ;; without checking its content. This makes it generate wrong load
472 ;; names for cases like lisp/term which is not added to load-path. 485 ;; names for cases like lisp/term which is not added to load-path.
473 (setq dir (expand-file-name (pop names) dir))) 486 (setq dir (expand-file-name (pop names) dir)))
474 (t (setq name (mapconcat 'identity names "/"))))) 487 (t (setq name (mapconcat #'identity names "/")))))
475 (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) 488 (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
476 (substring name 0 (match-beginning 0)) 489 (substring name 0 (match-beginning 0))
477 name))) 490 name)))
@@ -487,8 +500,93 @@ Return non-nil in the case where no autoloads were added at point."
487 (let ((generated-autoload-file buffer-file-name)) 500 (let ((generated-autoload-file buffer-file-name))
488 (autoload-generate-file-autoloads file (current-buffer)))) 501 (autoload-generate-file-autoloads file (current-buffer))))
489 502
490(defvar print-readably) 503(defun autoload--split-prefixes-1 (strs)
491 504 (let ((prefixes ()))
505 (dolist (str strs)
506 (string-match "\\`[^-:/_]*[-:/_]*" str)
507 (let* ((prefix (match-string 0 str))
508 (tail (substring str (match-end 0)))
509 (cell (assoc prefix prefixes)))
510 (cond
511 ((null cell) (push (list prefix tail) prefixes))
512 ((equal (cadr cell) tail) nil)
513 (t (setcdr cell (cons tail (cdr cell)))))))
514 prefixes))
515
516(defun autoload--split-prefixes (prefixes)
517 (apply #'nconc
518 (mapcar (lambda (cell)
519 (let ((prefix (car cell)))
520 (mapcar (lambda (cell)
521 (cons (concat prefix (car cell)) (cdr cell)))
522 (autoload--split-prefixes-1 (cdr cell)))))
523 prefixes)))
524
525(defvar autoload-compute-prefixes t
526 "If non-nil, autoload will add code to register the prefixes used in a file.
527Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
528variables or functions that use \"foo-\" as prefix, that will not be registered.
529But all other prefixes will be included.")
530
531(defconst autoload-defs-autoload-max-size 5
532 "Target length of the list of definition prefixes per file.
533If set too small, the prefixes will be too generic (i.e. they'll use little
534memory, we'll end up looking in too many files when we need a particular
535prefix), and if set too large, they will be too specific (i.e. they will
536cost more memory use).")
537
538(defvar autoload-popular-prefixes nil)
539
540(defun autoload--make-defs-autoload (defs file)
541 ;; Remove the defs that obey the rule that file foo.el (or
542 ;; foo-mode.el) uses "foo-" as prefix.
543 ;; FIXME: help--symbol-completion-table still doesn't know how to use
544 ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
545 ;;(let ((prefix
546 ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
547 ;; (dolist (def (prog1 defs (setq defs nil)))
548 ;; (unless (string-prefix-p prefix def)
549 ;; (push def defs))))
550
551 ;; Then compute a small set of prefixes that cover all the
552 ;; remaining definitions.
553 (let ((prefixes (autoload--split-prefixes-1 defs))
554 (again t))
555 ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes))
556 (while again
557 (setq again nil)
558 (let ((newprefixes
559 (sort
560 (mapcar (lambda (cell)
561 (cons cell
562 (autoload--split-prefixes-1 (cdr cell))))
563 prefixes)
564 (lambda (x y) (< (length (cdr x)) (length (cdr y)))))))
565 (setq prefixes nil)
566 (while newprefixes
567 (let ((x (pop newprefixes)))
568 (if (or (equal '("") (cdar x))
569 (and (cddr x)
570 (not (member (caar x)
571 autoload-popular-prefixes))
572 (> (+ (length prefixes) (length newprefixes)
573 (length (cdr x)))
574 autoload-defs-autoload-max-size)))
575 ;; Nothing to split or would split too deep.
576 (push (car x) prefixes)
577 ;; (message "Expand %S to %S" (caar x) (cdr x))
578 (setq again t)
579 (setq prefixes
580 (nconc (mapcar (lambda (cell)
581 (cons (concat (caar x)
582 (car cell))
583 (cdr cell)))
584 (cdr x))
585 prefixes)))))))
586 ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
587 (when prefixes
588 `(if (fboundp 'register-definition-prefixes)
589 (register-definition-prefixes ,file ',(mapcar #'car prefixes))))))
492 590
493(defun autoload--setup-output (otherbuf outbuf absfile load-name) 591(defun autoload--setup-output (otherbuf outbuf absfile load-name)
494 (let ((outbuf 592 (let ((outbuf
@@ -566,11 +664,11 @@ FILE's modification time."
566 (let (load-name 664 (let (load-name
567 (print-length nil) 665 (print-length nil)
568 (print-level nil) 666 (print-level nil)
569 (print-readably t) ; This does something in Lucid Emacs.
570 (float-output-format nil) 667 (float-output-format nil)
571 (visited (get-file-buffer file)) 668 (visited (get-file-buffer file))
572 (otherbuf nil) 669 (otherbuf nil)
573 (absfile (expand-file-name file)) 670 (absfile (expand-file-name file))
671 (defs '())
574 ;; nil until we found a cookie. 672 ;; nil until we found a cookie.
575 output-start) 673 output-start)
576 (when 674 (when
@@ -629,13 +727,73 @@ FILE's modification time."
629 ;; Don't read the comment. 727 ;; Don't read the comment.
630 (forward-line 1)) 728 (forward-line 1))
631 (t 729 (t
730 ;; Avoid (defvar <foo>) by requiring a trailing space.
731 ;; Also, ignore this prefix business
732 ;; for ;;;###tramp-autoload and friends.
733 (when (and (equal generate-autoload-cookie ";;;###autoload")
734 (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
735 (not (member
736 (match-string 1)
737 '("define-obsolete-function-alias"
738 "define-obsolete-variable-alias"
739 "define-category" "define-key"
740 "defgroup" "defface" "defadvice"
741 ;; Hmm... this is getting ugly:
742 "define-widget"
743 "defun-rcirc-command"))))
744 (push (match-string 2) defs))
632 (forward-sexp 1) 745 (forward-sexp 1)
633 (forward-line 1)))))) 746 (forward-line 1))))))
634 747
748 (when (and autoload-compute-prefixes defs)
749 ;; This output needs to always go in the main loaddefs.el,
750 ;; regardless of generated-autoload-file.
751 ;; FIXME: the files that don't have autoload cookies but
752 ;; do have definitions end up listed twice in loaddefs.el:
753 ;; once for their register-definition-prefixes and once in
754 ;; the list of "files without any autoloads".
755 (let ((form (autoload--make-defs-autoload defs load-name)))
756 (cond
757 ((null form)) ;All defs obey the default rule, yay!
758 ((not otherbuf)
759 (unless output-start
760 (setq output-start (autoload--setup-output
761 nil outbuf absfile load-name)))
762 (let ((autoload-print-form-outbuf
763 (marker-buffer output-start)))
764 (autoload-print-form form)))
765 (t
766 (let* ((other-output-start
767 ;; To force the output to go to the main loaddefs.el
768 ;; rather than to generated-autoload-file,
769 ;; there are two cases: if outbuf is non-nil,
770 ;; then passing otherbuf=nil is enough, but if
771 ;; outbuf is nil, that won't cut it, so we
772 ;; locally bind generated-autoload-file.
773 (let ((generated-autoload-file
774 (default-value 'generated-autoload-file)))
775 (autoload--setup-output nil outbuf absfile load-name)))
776 (autoload-print-form-outbuf
777 (marker-buffer other-output-start)))
778 (autoload-print-form form)
779 (with-current-buffer (marker-buffer other-output-start)
780 (save-excursion
781 ;; Insert the section-header line which lists
782 ;; the file name and which functions are in it, etc.
783 (goto-char other-output-start)
784 (let ((relfile (file-relative-name absfile)))
785 (autoload-insert-section-header
786 (marker-buffer other-output-start)
787 "actual autoloads are elsewhere" load-name relfile
788 (nth 5 (file-attributes absfile)))
789 (insert ";;; Generated autoloads from " relfile "\n")))
790 (insert generate-autoload-section-trailer)))))))
791
635 (when output-start 792 (when output-start
636 (let ((secondary-autoloads-file-buf 793 (let ((secondary-autoloads-file-buf
637 (if otherbuf (current-buffer)))) 794 (if otherbuf (current-buffer))))
638 (with-current-buffer (marker-buffer output-start) 795 (with-current-buffer (marker-buffer output-start)
796 (cl-assert (> (point) output-start))
639 (save-excursion 797 (save-excursion
640 ;; Insert the section-header line which lists the file name 798 ;; Insert the section-header line which lists the file name
641 ;; and which functions are in it, etc. 799 ;; and which functions are in it, etc.
@@ -827,12 +985,13 @@ write its autoloads into the specified file instead."
827 (dolist (suf (get-load-suffixes)) 985 (dolist (suf (get-load-suffixes))
828 (unless (string-match "\\.elc" suf) (push suf tmp))) 986 (unless (string-match "\\.elc" suf) (push suf tmp)))
829 (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))) 987 (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
830 (files (apply 'nconc 988 (files (apply #'nconc
831 (mapcar (lambda (dir) 989 (mapcar (lambda (dir)
832 (directory-files (expand-file-name dir) 990 (directory-files (expand-file-name dir)
833 t files-re)) 991 t files-re))
834 dirs))) 992 dirs)))
835 (done ()) 993 (done ()) ;Files processed; to remove duplicates.
994 (changed nil) ;Non-nil if some change occured.
836 (last-time) 995 (last-time)
837 ;; Files with no autoload cookies or whose autoloads go to other 996 ;; Files with no autoload cookies or whose autoloads go to other
838 ;; files because of file-local autoload-generated-file settings. 997 ;; files because of file-local autoload-generated-file settings.
@@ -850,7 +1009,7 @@ write its autoloads into the specified file instead."
850 (save-excursion 1009 (save-excursion
851 ;; Canonicalize file names and remove the autoload file itself. 1010 ;; Canonicalize file names and remove the autoload file itself.
852 (setq files (delete (file-relative-name buffer-file-name) 1011 (setq files (delete (file-relative-name buffer-file-name)
853 (mapcar 'file-relative-name files))) 1012 (mapcar #'file-relative-name files)))
854 1013
855 (goto-char (point-min)) 1014 (goto-char (point-min))
856 (while (search-forward generate-autoload-section-header nil t) 1015 (while (search-forward generate-autoload-section-header nil t)
@@ -878,6 +1037,7 @@ write its autoloads into the specified file instead."
878 ;; If the file is actually excluded. 1037 ;; If the file is actually excluded.
879 (member (expand-file-name file) autoload-excludes)) 1038 (member (expand-file-name file) autoload-excludes))
880 ;; Remove the obsolete section. 1039 ;; Remove the obsolete section.
1040 (setq changed t)
881 (autoload-remove-section (match-beginning 0))) 1041 (autoload-remove-section (match-beginning 0)))
882 ((not (time-less-p (let ((oldtime (nth 4 form))) 1042 ((not (time-less-p (let ((oldtime (nth 4 form)))
883 (if (member oldtime 1043 (if (member oldtime
@@ -889,6 +1049,7 @@ write its autoloads into the specified file instead."
889 ;; File hasn't changed. 1049 ;; File hasn't changed.
890 nil) 1050 nil)
891 (t 1051 (t
1052 (setq changed t)
892 (autoload-remove-section (match-beginning 0)) 1053 (autoload-remove-section (match-beginning 0))
893 (if (autoload-generate-file-autoloads 1054 (if (autoload-generate-file-autoloads
894 ;; Passing `current-buffer' makes it insert at point. 1055 ;; Passing `current-buffer' makes it insert at point.
@@ -908,7 +1069,8 @@ write its autoloads into the specified file instead."
908 (autoload-generate-file-autoloads file nil buffer-file-name)) 1069 (autoload-generate-file-autoloads file nil buffer-file-name))
909 (push file no-autoloads) 1070 (push file no-autoloads)
910 (if (time-less-p no-autoloads-time file-time) 1071 (if (time-less-p no-autoloads-time file-time)
911 (setq no-autoloads-time file-time))))) 1072 (setq no-autoloads-time file-time)))
1073 (t (setq changed t))))
912 1074
913 (when no-autoloads 1075 (when no-autoloads
914 ;; Sort them for better readability. 1076 ;; Sort them for better readability.
@@ -922,8 +1084,12 @@ write its autoloads into the specified file instead."
922 autoload--non-timestamp)) 1084 autoload--non-timestamp))
923 (insert generate-autoload-section-trailer))) 1085 (insert generate-autoload-section-trailer)))
924 1086
925 (let ((version-control 'never)) 1087 ;; Don't modify the file if its content has not been changed, so `make'
926 (save-buffer)) 1088 ;; dependencies don't trigger unnecessarily.
1089 (when changed
1090 (let ((version-control 'never))
1091 (save-buffer)))
1092
927 ;; In case autoload entries were added to other files because of 1093 ;; In case autoload entries were added to other files because of
928 ;; file-local autoload-generated-file settings. 1094 ;; file-local autoload-generated-file settings.
929 (autoload-save-buffers)))) 1095 (autoload-save-buffers))))
@@ -955,7 +1121,7 @@ should be non-nil)."
955 (push (expand-file-name file) autoload-excludes))))))) 1121 (push (expand-file-name file) autoload-excludes)))))))
956 (let ((args command-line-args-left)) 1122 (let ((args command-line-args-left))
957 (setq command-line-args-left nil) 1123 (setq command-line-args-left nil)
958 (apply 'update-directory-autoloads args))) 1124 (apply #'update-directory-autoloads args)))
959 1125
960(provide 'autoload) 1126(provide 'autoload)
961 1127
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 53fc2215a90..db3c36d1f01 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -161,6 +161,12 @@
161 ;; In case loaddefs hasn't been generated yet. 161 ;; In case loaddefs hasn't been generated yet.
162 (file-error (load "ldefs-boot.el"))) 162 (file-error (load "ldefs-boot.el")))
163 163
164(let ((new (make-hash-table :test 'equal)))
165 ;; Now that loaddefs has populated definition-prefixes, purify its contents.
166 (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
167 definition-prefixes)
168 (setq definition-prefixes new))
169
164(load "emacs-lisp/nadvice") 170(load "emacs-lisp/nadvice")
165(load "emacs-lisp/cl-preloaded") 171(load "emacs-lisp/cl-preloaded")
166(load "minibuffer") ;After loaddefs, for define-minor-mode. 172(load "minibuffer") ;After loaddefs, for define-minor-mode.
diff --git a/lisp/subr.el b/lisp/subr.el
index 438f00a6f13..b5d6f6fa01b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5150,6 +5150,17 @@ as a list.")
5150 5150
5151 5151
5152;;; Misc. 5152;;; Misc.
5153
5154(defvar definition-prefixes (make-hash-table :test 'equal)
5155 "Hash table mapping prefixes to the files in which they're used.
5156This can be used to automatically fetch not-yet-loaded definitions.")
5157
5158(defun register-definition-prefixes (file prefixes)
5159 "Register that FILE uses PREFIXES."
5160 (dolist (prefix prefixes)
5161 (puthash prefix (cons file (gethash prefix definition-prefixes))
5162 definition-prefixes)))
5163
5153(defconst menu-bar-separator '("--") 5164(defconst menu-bar-separator '("--")
5154 "Separator for menus.") 5165 "Separator for menus.")
5155 5166
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 690a9902087..4815f4b8c21 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -121,7 +121,7 @@ You should set this to t when using a non-system shell.\n\n"))))
121(add-hook 'after-init-hook 'w32-check-shell-configuration) 121(add-hook 'after-init-hook 'w32-check-shell-configuration)
122 122
123;; Override setting chosen at startup. 123;; Override setting chosen at startup.
124(defun set-default-process-coding-system () 124(defun w32-set-default-process-coding-system ()
125 ;; Most programs on Windows will accept Unix line endings on input 125 ;; Most programs on Windows will accept Unix line endings on input
126 ;; (and some programs ported from Unix require it) but most will 126 ;; (and some programs ported from Unix require it) but most will
127 ;; produce DOS line endings on output. 127 ;; produce DOS line endings on output.
@@ -142,8 +142,9 @@ You should set this to t when using a non-system shell.\n\n"))))
142 . ,(if (default-value 'enable-multibyte-characters) 142 . ,(if (default-value 'enable-multibyte-characters)
143 '(undecided-dos . undecided-dos) 143 '(undecided-dos . undecided-dos)
144 '(raw-text-dos . raw-text-dos))))) 144 '(raw-text-dos . raw-text-dos)))))
145 145(define-obsolete-function-alias 'set-default-process-coding-system
146(add-hook 'before-init-hook 'set-default-process-coding-system) 146 #'w32-set-default-process-coding-system "26.1")
147(add-hook 'before-init-hook #'w32-set-default-process-coding-system)
147 148
148 149
149;;; Basic support functions for managing Emacs's locale setting 150;;; Basic support functions for managing Emacs's locale setting
@@ -217,7 +218,7 @@ names."
217 (setq start (match-end 0))) 218 (setq start (match-end 0)))
218 name))) 219 name)))
219 220
220(defun set-w32-system-coding-system (coding-system) 221(defun w32-set-system-coding-system (coding-system)
221 "Set the coding system used by the Windows system to CODING-SYSTEM. 222 "Set the coding system used by the Windows system to CODING-SYSTEM.
222This is used for things like passing font names with non-ASCII 223This is used for things like passing font names with non-ASCII
223characters in them to the system. For a list of possible values of 224characters in them to the system. For a list of possible values of
@@ -233,6 +234,8 @@ This function is provided for backward compatibility, since
233 default)))) 234 default))))
234 (check-coding-system coding-system) 235 (check-coding-system coding-system)
235 (setq locale-coding-system coding-system)) 236 (setq locale-coding-system coding-system))
237(define-obsolete-function-alias 'set-w32-system-coding-system
238 #'w32-set-system-coding-system "26.1")
236 239
237;; locale-coding-system was introduced to do the same thing as 240;; locale-coding-system was introduced to do the same thing as
238;; w32-system-coding-system. Use that instead. 241;; w32-system-coding-system. Use that instead.