Commit e971ce6d authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent 1ee91bf8
......@@ -183,10 +183,12 @@ expression, in which case we want to handle forms differently."
(args (pcase car
((or `defun `defmacro
`defun* `defmacro* `cl-defun `cl-defmacro
`define-overloadable-function) (nth 2 form))
`define-overloadable-function)
(nth 2 form))
(`define-skeleton '(&optional str arg))
((or `define-generic-mode `define-derived-mode
`define-compilation-mode) nil)
`define-compilation-mode)
nil)
(_ t)))
(body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
(doc (if (stringp (car body)) (pop body))))
......@@ -202,7 +204,8 @@ expression, in which case we want to handle forms differently."
define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode
define-minor-mode)) t)
define-minor-mode))
t)
(eq (car-safe (car body)) 'interactive))
,(if macrop ''macro nil))))
......@@ -313,7 +316,7 @@ The variable `autoload-print-form-outbuf' specifies the buffer to
put the output in."
(cond
;; If the form is a sequence, recurse.
((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
;; Symbols at the toplevel are meaningless.
((symbolp form) nil)
(t
......@@ -413,6 +416,16 @@ make it writable."
(defun autoload-insert-section-header (outbuf autoloads load-name file time)
"Insert the section-header line,
which lists the file name and which functions are in it, etc."
;; (cl-assert ;Make sure we don't insert it in the middle of another section.
;; (save-excursion
;; (or (not (re-search-backward
;; (concat "\\("
;; (regexp-quote generate-autoload-section-header)
;; "\\)\\|\\("
;; (regexp-quote generate-autoload-section-trailer)
;; "\\)")
;; nil t))
;; (match-end 2))))
(insert generate-autoload-section-header)
(prin1 `(autoloads ,autoloads ,load-name ,file ,time)
outbuf)
......@@ -471,7 +484,7 @@ which lists the file name and which functions are in it, etc."
;; without checking its content. This makes it generate wrong load
;; names for cases like lisp/term which is not added to load-path.
(setq dir (expand-file-name (pop names) dir)))
(t (setq name (mapconcat 'identity names "/")))))
(t (setq name (mapconcat #'identity names "/")))))
(if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
(substring name 0 (match-beginning 0))
name)))
......@@ -487,8 +500,93 @@ Return non-nil in the case where no autoloads were added at point."
(let ((generated-autoload-file buffer-file-name))
(autoload-generate-file-autoloads file (current-buffer))))
(defvar print-readably)
(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
"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)
(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
;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
;;(let ((prefix
;; (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
;; (dolist (def (prog1 defs (setq defs nil)))
;; (unless (string-prefix-p prefix def)
;; (push def defs))))
;; 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)))))))
;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes
`(if (fboundp 'register-definition-prefixes)
(register-definition-prefixes ,file ',(mapcar #'car prefixes))))))
(defun autoload--setup-output (otherbuf outbuf absfile load-name)
(let ((outbuf
......@@ -566,11 +664,11 @@ FILE's modification time."
(let (load-name
(print-length nil)
(print-level nil)
(print-readably t) ; This does something in Lucid Emacs.
(float-output-format nil)
(visited (get-file-buffer file))
(otherbuf nil)
(absfile (expand-file-name file))
(defs '())
;; nil until we found a cookie.
output-start)
(when
......@@ -629,13 +727,73 @@ FILE's modification time."
;; Don't read the comment.
(forward-line 1))
(t
;; Avoid (defvar <foo>) by requiring a trailing space.
;; Also, ignore this prefix business
;; for ;;;###tramp-autoload and friends.
(when (and (equal generate-autoload-cookie ";;;###autoload")
(looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
(not (member
(match-string 1)
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
"define-category" "define-key"
"defgroup" "defface" "defadvice"
;; Hmm... this is getting ugly:
"define-widget"
"defun-rcirc-command"))))
(push (match-string 2) defs))
(forward-sexp 1)
(forward-line 1))))))
(when (and autoload-compute-prefixes defs)
;; This output needs to always go in the main loaddefs.el,
;; regardless of generated-autoload-file.
;; FIXME: the files that don't have autoload cookies but
;; do have definitions end up listed twice in loaddefs.el:
;; once for their register-definition-prefixes and once in
;; the list of "files without any autoloads".
(let ((form (autoload--make-defs-autoload defs load-name)))
(cond
((null form)) ;All defs obey the default rule, yay!
((not otherbuf)
(unless output-start
(setq output-start (autoload--setup-output
nil outbuf absfile load-name)))
(let ((autoload-print-form-outbuf
(marker-buffer output-start)))
(autoload-print-form form)))
(t
(let* ((other-output-start
;; To force the output to go to the main loaddefs.el
;; rather than to generated-autoload-file,
;; there are two cases: if outbuf is non-nil,
;; then passing otherbuf=nil is enough, but if
;; outbuf is nil, that won't cut it, so we
;; locally bind generated-autoload-file.
(let ((generated-autoload-file
(default-value 'generated-autoload-file)))
(autoload--setup-output nil outbuf absfile load-name)))
(autoload-print-form-outbuf
(marker-buffer other-output-start)))
(autoload-print-form form)
(with-current-buffer (marker-buffer other-output-start)
(save-excursion
;; Insert the section-header line which lists
;; the file name and which functions are in it, etc.
(goto-char other-output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
(marker-buffer other-output-start)
"actual autoloads are elsewhere" load-name relfile
(nth 5 (file-attributes absfile)))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer)))))))
(when output-start
(let ((secondary-autoloads-file-buf
(if otherbuf (current-buffer))))
(with-current-buffer (marker-buffer output-start)
(cl-assert (> (point) output-start))
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
......@@ -827,12 +985,13 @@ write its autoloads into the specified file instead."
(dolist (suf (get-load-suffixes))
(unless (string-match "\\.elc" suf) (push suf tmp)))
(concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply 'nconc
(files (apply #'nconc
(mapcar (lambda (dir)
(directory-files (expand-file-name dir)
t files-re))
dirs)))
(done ())
(done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occured.
(last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.
......@@ -850,7 +1009,7 @@ write its autoloads into the specified file instead."
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
(setq files (delete (file-relative-name buffer-file-name)
(mapcar 'file-relative-name files)))
(mapcar #'file-relative-name files)))
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
......@@ -878,6 +1037,7 @@ write its autoloads into the specified file instead."
;; If the file is actually excluded.
(member (expand-file-name file) autoload-excludes))
;; Remove the obsolete section.
(setq changed t)
(autoload-remove-section (match-beginning 0)))
((not (time-less-p (let ((oldtime (nth 4 form)))
(if (member oldtime
......@@ -889,6 +1049,7 @@ write its autoloads into the specified file instead."
;; File hasn't changed.
nil)
(t
(setq changed t)
(autoload-remove-section (match-beginning 0))
(if (autoload-generate-file-autoloads
;; Passing `current-buffer' makes it insert at point.
......@@ -908,7 +1069,8 @@ write its autoloads into the specified file instead."
(autoload-generate-file-autoloads file nil buffer-file-name))
(push file no-autoloads)
(if (time-less-p no-autoloads-time file-time)
(setq no-autoloads-time file-time)))))
(setq no-autoloads-time file-time)))
(t (setq changed t))))
(when no-autoloads
;; Sort them for better readability.
......@@ -922,8 +1084,12 @@ write its autoloads into the specified file instead."
autoload--non-timestamp))
(insert generate-autoload-section-trailer)))
(let ((version-control 'never))
(save-buffer))
;; Don't modify the file if its content has not been changed, so `make'
;; dependencies don't trigger unnecessarily.
(when changed
(let ((version-control 'never))
(save-buffer)))
;; In case autoload entries were added to other files because of
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
......@@ -955,7 +1121,7 @@ should be non-nil)."
(push (expand-file-name file) autoload-excludes)))))))
(let ((args command-line-args-left))
(setq command-line-args-left nil)
(apply 'update-directory-autoloads args)))
(apply #'update-directory-autoloads args)))
(provide 'autoload)
......
......@@ -161,6 +161,12 @@
;; In case loaddefs hasn't been generated yet.
(file-error (load "ldefs-boot.el")))
(let ((new (make-hash-table :test 'equal)))
;; Now that loaddefs has populated definition-prefixes, purify its contents.
(maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
definition-prefixes)
(setq definition-prefixes new))
(load "emacs-lisp/nadvice")
(load "emacs-lisp/cl-preloaded")
(load "minibuffer") ;After loaddefs, for define-minor-mode.
......
......@@ -5150,6 +5150,17 @@ as a list.")
;;; Misc.
(defvar definition-prefixes (make-hash-table :test 'equal)
"Hash table mapping prefixes to the files in which they're used.
This can be used to automatically fetch not-yet-loaded definitions.")
(defun register-definition-prefixes (file prefixes)
"Register that FILE uses PREFIXES."
(dolist (prefix prefixes)
(puthash prefix (cons file (gethash prefix definition-prefixes))
definition-prefixes)))
(defconst menu-bar-separator '("--")
"Separator for menus.")
......
......@@ -121,7 +121,7 @@ You should set this to t when using a non-system shell.\n\n"))))
(add-hook 'after-init-hook 'w32-check-shell-configuration)
;; Override setting chosen at startup.
(defun set-default-process-coding-system ()
(defun w32-set-default-process-coding-system ()
;; Most programs on Windows will accept Unix line endings on input
;; (and some programs ported from Unix require it) but most will
;; produce DOS line endings on output.
......@@ -142,8 +142,9 @@ You should set this to t when using a non-system shell.\n\n"))))
. ,(if (default-value 'enable-multibyte-characters)
'(undecided-dos . undecided-dos)
'(raw-text-dos . raw-text-dos)))))
(add-hook 'before-init-hook 'set-default-process-coding-system)
(define-obsolete-function-alias 'set-default-process-coding-system
#'w32-set-default-process-coding-system "26.1")
(add-hook 'before-init-hook #'w32-set-default-process-coding-system)
;;; Basic support functions for managing Emacs's locale setting
......@@ -217,7 +218,7 @@ names."
(setq start (match-end 0)))
name)))
(defun set-w32-system-coding-system (coding-system)
(defun w32-set-system-coding-system (coding-system)
"Set the coding system used by the Windows system to CODING-SYSTEM.
This is used for things like passing font names with non-ASCII
characters in them to the system. For a list of possible values of
......@@ -233,6 +234,8 @@ This function is provided for backward compatibility, since
default))))
(check-coding-system coding-system)
(setq locale-coding-system coding-system))
(define-obsolete-function-alias 'set-w32-system-coding-system
#'w32-set-system-coding-system "26.1")
;; locale-coding-system was introduced to do the same thing as
;; w32-system-coding-system. Use that instead.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment