From 6ef058cec2331e5135ce8e4c73983dec695afa15 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 31 Jul 2022 19:57:55 +0200 Subject: Allow specifying that loaddefs files shouldn't not be compiled * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--rubric): Allow specifying that we shouldn't include a no-compile cookie (bug#53024). --- lisp/emacs-lisp/loaddefs-gen.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 261e44aeced..36b0b1e9cdf 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -459,7 +459,7 @@ don't include." (push name prefs))))) (loaddefs-generate--make-prefixes prefs load-name))) -(defun loaddefs-generate--rubric (file &optional type feature) +(defun loaddefs-generate--rubric (file &optional type feature compile) "Return a string giving the appropriate autoload rubric for FILE. TYPE (default \"autoloads\") is a string stating the type of information contained in FILE. TYPE \"package\" acts like the default, @@ -467,7 +467,9 @@ but adds an extra line to the output to modify `load-path'. If FEATURE is non-nil, FILE will provide a feature. FEATURE may be a string naming the feature, otherwise it will be based on -FILE's name." +FILE's name. + +If COMPILE, don't include a \"don't compile\" cookie." (let ((lp (and (equal type "package") (setq type "autoloads")))) (with-temp-buffer (generate-lisp-file-heading @@ -481,6 +483,7 @@ FILE's name." (insert " \n;;; End of scraped data\n\n") (generate-lisp-file-trailer file :provide (and (stringp feature) feature) + :compile compile :inhibit-provide (not feature)) (buffer-string)))) -- cgit v1.2.3 From d634cb09547eb5ffba105b6c90410fd843bf029d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 1 Aug 2022 00:38:33 -0700 Subject: Omit some (current-time) calls * lisp/emacs-lisp/ert.el (ert-write-junit-test-summary-report): * lisp/emacs-lisp/shortdoc.el (file): * lisp/find-lisp.el (find-lisp-find-dired-insert-file): * lisp/progmodes/hideif.el (hide-ifdefs): * lisp/tar-mode.el (tar-subfile-save-buffer): Prefer nil or omitted arg to (current-time) where this is better or more-efficient. --- lisp/emacs-lisp/ert.el | 2 +- lisp/emacs-lisp/shortdoc.el | 2 +- lisp/find-lisp.el | 2 +- lisp/progmodes/hideif.el | 3 +-- lisp/tar-mode.el | 2 +- 5 files changed, 5 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 49b54c2d00f..c8ff6b68144 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1692,7 +1692,7 @@ test packages depend on each other, it might be helpful.") (string-match-p "^Running 0 tests" logfile-contents)) (insert (format " \n" id test-report - (ert--format-time-iso8601 (current-time)))) + (ert--format-time-iso8601 nil))) (insert (format " \n" (file-name-nondirectory test-report))) (insert (format " \n" diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 315afd4312b..d187af9ac83 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -503,7 +503,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (set-file-modes :no-value "(set-file-modes \"/tmp/foo\" #o644)") (set-file-times - :no-value (set-file-times "/tmp/foo" (current-time))) + :no-value (set-file-times "/tmp/foo")) "File Modes" (set-default-file-modes :no-value "(set-default-file-modes #o755)") diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index 0a712c0b811..e825d9cba04 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -281,7 +281,7 @@ It is a function which takes two arguments, the directory and its parent." (set-buffer buffer) (insert find-lisp-line-indent (find-lisp-format file (file-attributes file 'string) (list "") - (current-time)))) + nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Lifted from ls-lisp. We don't want to require it, because that diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index f2ada676ab7..d09e1f4cdfe 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -2521,8 +2521,7 @@ Turn off hiding by calling `show-ifdefs'." (or hide-ifdef-read-only hif-outside-read-only)) (and hide-ifdef-verbose (message "Hiding done, %.1f seconds elapsed" - (float-time (time-subtract (current-time) - hide-start-time))))))) + (float-time (time-subtract nil hide-start-time))))))) (defun show-ifdefs (&optional start end) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index d7a09789699..20ad6e1e46a 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1377,7 +1377,7 @@ to make your changes permanent." ;; Maybe update the datestamp. (when tar-update-datestamp (tar-alter-one-field tar-time-offset - (concat (tar-octal-time (current-time)) " ")))) + (concat (tar-octal-time nil) " ")))) ;; After doing the insertion, add any necessary final padding. (tar-pad-to-blocksize)) (set-buffer-modified-p t) ; mark the tar file as modified -- cgit v1.2.3 From 9d8a6c82838f2f24e76a67379b02956aa668d7cf Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 1 Aug 2022 19:11:01 +0000 Subject: Fix the bytecode incompatibility due to the change to 'narrow-to-region'. * src/editfns.c (narrow_to_region_internal): New function, which contains the body previously in 'Fnarrow_to_region' but accepts a third argument. (Fnarrow_to_region): Use the new function. Update the docstring. (Fwiden): Update the docstring. * src/lisp.h: Prototype of the new function. * src/xdisp.c (handle_fontified_prop): Use the new function instead of 'Fnarrow_to_region'. * src/process.c (Finternal_default_process_filter): * src/lread.c (readevalloop): Remove the third argument to 'Fnarrow_to_region'. * src/bytecode.c (exec_byte_code): * lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): * lisp/emacs-lisp/bytecomp.el: Restore the statu quo ante. * etc/NEWS: Remove the entry about the new optional argument. * doc/lispref/positions.texi (Narrowing): Update the documentation. --- doc/lispref/positions.texi | 15 ++++++------- etc/NEWS | 7 ------ lisp/emacs-lisp/bytecomp.el | 4 ++-- lisp/emacs-lisp/comp.el | 5 ++++- src/bytecode.c | 4 ++-- src/editfns.c | 52 ++++++++++++++++++++++++++------------------- src/lisp.h | 1 + src/lread.c | 2 +- src/process.c | 2 +- src/xdisp.c | 3 ++- 10 files changed, 50 insertions(+), 45 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 3a9a152f8dd..e08ee76ed9a 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -995,7 +995,7 @@ the entire buffer regardless of any narrowing. types of text, consider using an alternative facility described in @ref{Swapping Text}. -@deffn Command narrow-to-region start end &optional lock +@deffn Command narrow-to-region start end This function sets the accessible portion of the current buffer to start at @var{start} and end at @var{end}. Both arguments should be character positions. @@ -1003,10 +1003,9 @@ positions. In an interactive call, @var{start} and @var{end} are set to the bounds of the current region (point and the mark, with the smallest first). -When @var{lock} is non-@code{nil}, calls to @code{widen}, or to -@code{narrow-to-region} with an optional argument @var{lock} -@code{nil}, do not produce any effect until the end of the current -body form. +Note that, in rare circumstances, Emacs may decide to leave, for +performance reasons, the accessible portion of the buffer unchanged +after a call to @code{narrow-to-region}. @end deffn @deffn Command narrow-to-page &optional move-count @@ -1032,9 +1031,9 @@ It is equivalent to the following expression: @end example @end deffn -However, when @code{widen} is called inside a body form in which -@code{narrow-to-region} was called with an optional argument -@code{lock} non-@code{nil}, it does not produce any effect. +Note that, in rare circumstances, Emacs may decide to leave, for +performance reasons, the accessible portion of the buffer unchanged +after a call to @code{widen}. @defun buffer-narrowed-p This function returns non-@code{nil} if the buffer is narrowed, and diff --git a/etc/NEWS b/etc/NEWS index 963aa22c680..b011413cbc3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2560,13 +2560,6 @@ things to be saved. ** New function 'string-equal-ignore-case'. This compares strings ignoring case differences. -+++ -** New argument LOCK of 'narrow-to-region'. -If 'narrow-to-region' is called from Lisp with the new optional -argument LOCK non-nil, then calls to 'widen' and calls to -'narrow-to-region' with the optional argument LOCK nil or omitted do -not produce any effect until the end of the current body form. - ** Themes --- diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ecd77f7517..b4954eee9ff 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -767,7 +767,7 @@ Each element is (INDEX . VALUE)") (byte-defop 122 0 byte-char-syntax) (byte-defop 123 -1 byte-buffer-substring) (byte-defop 124 -1 byte-delete-region) -(byte-defop 125 -2 byte-narrow-to-region) +(byte-defop 125 -1 byte-narrow-to-region) (byte-defop 126 1 byte-widen) (byte-defop 127 0 byte-end-of-line) @@ -3833,7 +3833,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler setcdr 2) (byte-defop-compiler buffer-substring 2) (byte-defop-compiler delete-region 2) -(byte-defop-compiler narrow-to-region 2-3) +(byte-defop-compiler narrow-to-region 2) (byte-defop-compiler (% byte-rem) 2) (byte-defop-compiler aset 3) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 4354ea03a4e..5ee10fcbca2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1915,7 +1915,10 @@ and the annotation emission." (byte-char-syntax auto) (byte-buffer-substring auto) (byte-delete-region auto) - (byte-narrow-to-region auto) + (byte-narrow-to-region + (comp-emit-set-call (comp-call 'narrow-to-region + (comp-slot) + (comp-slot+1)))) (byte-widen (comp-emit-set-call (comp-call 'widen))) (byte-end-of-line auto) diff --git a/src/bytecode.c b/src/bytecode.c index 2b1eccdc518..d75767bb0c5 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1480,8 +1480,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { - Lisp_Object v2 = POP, v1 = POP; - TOP = Fnarrow_to_region (TOP, v1, v2); + Lisp_Object v1 = POP; + TOP = Fnarrow_to_region (TOP, v1); NEXT; } diff --git a/src/editfns.c b/src/editfns.c index 79af27d24da..35b2415e8b1 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -2660,9 +2660,10 @@ DEFUN ("widen", Fwiden, Swiden, 0, 0, "", doc: /* Remove restrictions (narrowing) from current buffer. This allows the buffer's full text to be seen and edited. -When called from Lisp inside a body form in which `narrow-to-region' -was called with an optional argument LOCK non-nil, this function does -not produce any effect. */) +Note that, when the current buffer contains one or more lines whose +length is above `long-line-threshold', Emacs may decide to leave, for +performance reasons, the accessible portion of the buffer unchanged +after this function is called. */) (void) { if (! NILP (Vrestrictions_locked)) @@ -2689,22 +2690,11 @@ unwind_locked_zv (Lisp_Object point_max) SET_BUF_ZV (current_buffer, XFIXNUM (point_max)); } -DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 3, "r", - doc: /* Restrict editing in this buffer to the current region. -The rest of the text becomes temporarily invisible and untouchable -but is not deleted; if you save the buffer in a file, the invisible -text is included in the file. \\[widen] makes all visible again. -See also `save-restriction'. - -When calling from Lisp, pass two arguments START and END: -positions (integers or markers) bounding the text that should -remain visible. - -When called from Lisp with the optional argument LOCK non-nil, -calls to `widen', or to `narrow-to-region' with an optional -argument LOCK nil, do not produce any effect until the end of -the current body form. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object lock) +/* Internal function for Fnarrow_to_region, meant to be used with a + third argument 'true', in which case it should be followed by "specbind + (Qrestrictions_locked, Qt)". */ +Lisp_Object +narrow_to_region_internal (Lisp_Object start, Lisp_Object end, bool lock) { EMACS_INT s = fix_position (start), e = fix_position (end); @@ -2713,7 +2703,7 @@ the current body form. */) EMACS_INT tem = s; s = e; e = tem; } - if (! NILP (lock)) + if (lock) { if (!(BEGV <= s && s <= e && e <= ZV)) args_out_of_range (start, end); @@ -2727,8 +2717,6 @@ the current body form. */) SET_BUF_BEGV (current_buffer, s); SET_BUF_ZV (current_buffer, e); - - specbind (Qrestrictions_locked, Qt); } else { @@ -2754,6 +2742,26 @@ the current body form. */) return Qnil; } +DEFUN ("narrow-to-region", Fnarrow_to_region, Snarrow_to_region, 2, 2, "r", + doc: /* Restrict editing in this buffer to the current region. +The rest of the text becomes temporarily invisible and untouchable +but is not deleted; if you save the buffer in a file, the invisible +text is included in the file. \\[widen] makes all visible again. +See also `save-restriction'. + +When calling from Lisp, pass two arguments START and END: +positions (integers or markers) bounding the text that should +remain visible. + +Note that, when the current buffer contains one or more lines whose +length is above `long-line-threshold', Emacs may decide to leave, for +performance reasons, the accessible portion of the buffer unchanged +after this function is called. */) + (Lisp_Object start, Lisp_Object end) +{ + return narrow_to_region_internal (start, end, false); +} + Lisp_Object save_restriction_save (void) { diff --git a/src/lisp.h b/src/lisp.h index 807fcb0e5ba..c8ad0bc56f5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4679,6 +4679,7 @@ extern void save_restriction_restore (Lisp_Object); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, bool); +extern Lisp_Object narrow_to_region_internal (Lisp_Object, Lisp_Object, bool); extern void init_editfns (void); extern void syms_of_editfns (void); diff --git a/src/lread.c b/src/lread.c index 0720774db2b..0b46a2e4ee5 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2261,7 +2261,7 @@ readevalloop (Lisp_Object readcharfun, /* Set point and ZV around stuff to be read. */ Fgoto_char (start); if (!NILP (end)) - Fnarrow_to_region (make_fixnum (BEGV), end, Qnil); + Fnarrow_to_region (make_fixnum (BEGV), end); /* Just for cleanliness, convert END to a marker if it is an integer. */ diff --git a/src/process.c b/src/process.c index a15efa39bd1..1ac5a509e56 100644 --- a/src/process.c +++ b/src/process.c @@ -6339,7 +6339,7 @@ Otherwise it discards the output. */) /* If the restriction isn't what it should be, set it. */ if (old_begv != BEGV || old_zv != ZV) - Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv), Qnil); + Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv)); bset_read_only (current_buffer, old_read_only); SET_PT_BOTH (opoint, opoint_byte); diff --git a/src/xdisp.c b/src/xdisp.c index 88a489e290f..65d9221a159 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4406,7 +4406,8 @@ handle_fontified_prop (struct it *it) if (!begv) begv = BEGV; zv = get_narrowed_zv (it->w, charpos); } - Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv), Qt); + narrow_to_region_internal (make_fixnum (begv), make_fixnum (zv), true); + specbind (Qrestrictions_locked, Qt); } /* Don't allow Lisp that runs from 'fontification-functions' -- cgit v1.2.3 From 6fd1fb8a6837acde8e1c9ab26618ec0f36121c72 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 2 Aug 2022 11:56:55 +0200 Subject: Don't disable eldoc when doing edebug * lisp/emacs-lisp/eldoc.el (eldoc-display-message-no-interference-p): Don't disable eldoc when edebugging (bug#56459). There should be no interference in that case, because edebug messaging is done after stepping, and eldoc messaging is done after other movements. --- lisp/emacs-lisp/eldoc.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 8d7f182e0cd..6fd89a690dc 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -381,7 +381,6 @@ Also store it in `eldoc-last-message' and return that value." (defun eldoc-display-message-no-interference-p () "Return nil if displaying a message would cause interference." (not (or executing-kbd-macro - (bound-and-true-p edebug-active) ;; The following configuration shows "Matches..." in the ;; echo area when point is after a closing bracket, which ;; conflicts with eldoc. -- cgit v1.2.3 From 50a192795ad64d2ea49274b402cb42530a5199ca Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Tue, 2 Aug 2022 12:14:09 +0200 Subject: Consider built-in packages to be installed * lisp/emacs-lisp/package.el (package-installed-p): Check for built-in packages before initialization. (bug#56877). --- lisp/emacs-lisp/package.el | 5 ++++- test/lisp/emacs-lisp/package-tests.el | 15 +++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index df70f908daf..482de52f856 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2085,7 +2085,10 @@ If PACKAGE is a `package-desc' object, MIN-VERSION is ignored." package-activated-list) ;; We used the quickstart: make it possible to use package-installed-p ;; even before package is fully initialized. - (memq package package-activated-list)) + (or + (memq package package-activated-list) + ;; Also check built-in packages. + (package-built-in-p package min-version))) (t (or (let ((pkg-descs (cdr (assq package (package--alist))))) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index d7a55998c20..b903cd781ba 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -638,6 +638,21 @@ but with a different end of line convention (bug#48137)." (package-refresh-contents) (should (equal (length package-archive-contents) 2))))) +(ert-deftest package-test-package-installed-p () + "Test package-installed-p before and after package initialization." + (with-package-test () + ;; Verify that `package-installed-p' evaluates true for a built-in + ;; package, in this case `project', before package initialization. + (should (not package--initialized)) + (should (package-installed-p 'project nil)) + (should (not (package-installed-p 'imaginary-package nil))) + + ;; The results don't change after package initialization. + (package-initialize) + (should package--initialized) + (should (package-installed-p 'project nil)) + (should (not (package-installed-p 'imaginary-package nil))))) + (ert-deftest package-test-describe-package () "Test displaying help for a package." -- cgit v1.2.3 From 72c7ee2e525d87b58a28aea8af8cef31f607d7c0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 3 Aug 2022 01:40:32 +0200 Subject: Avoid cl-cXXXr compat aliases * lisp/emacs-lisp/cl-lib.el (cl-third, cl-fourth): * lisp/emacs-lisp/cl-macs.el (cl--do-&aux, cl--do-arglist) (cl--parse-loop-clause, cl--loop-let, cl--loop-build-ands) (cl--do-proclaim, cl-defstruct): Prefer using cXXXr functions directly, instead of cl-cXXXr prefixed compat aliases. --- lisp/emacs-lisp/cl-lib.el | 4 ++-- lisp/emacs-lisp/cl-macs.el | 24 ++++++++++++------------ 2 files changed, 14 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 3f40ab07605..a54fa21fa96 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -372,8 +372,8 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (cl--defalias 'cl-second 'cadr) (cl--defalias 'cl-rest 'cdr) -(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.") -(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.") +(cl--defalias 'cl-third #'caddr "Return the third element of the list X.") +(cl--defalias 'cl-fourth #'cadddr "Return the fourth element of the list X.") (defsubst cl-fifth (x) "Return the fifth element of the list X." diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 727b3098e34..12917c99e10 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -527,7 +527,7 @@ its argument list allows full Common Lisp conventions." (while (and (eq (car args) '&aux) (pop args)) (while (and args (not (memq (car args) cl--lambda-list-keywords))) (if (consp (car args)) - (if (and cl--bind-enquote (cl-cadar args)) + (if (and cl--bind-enquote (cadar args)) (cl--do-arglist (caar args) `',(cadr (pop args))) (cl--do-arglist (caar args) (cadr (pop args)))) @@ -612,7 +612,7 @@ its argument list allows full Common Lisp conventions." (if (eq ?_ (aref name 0)) (setq name (substring name 1))) (intern (format ":%s" name))))) - (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) + (varg (if (consp (car arg)) (cadar arg) (car arg))) (def (if (cdr arg) (cadr arg) ;; The ordering between those two or clauses is ;; irrelevant, since in practice only one of the two @@ -1339,7 +1339,7 @@ For more details, see Info node `(cl)Loop Facility'. (temp-idx (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (eq (cl-caadr cl--loop-args) 'index)) + (eq (caadr cl--loop-args) 'index)) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-idx--")))) @@ -1370,8 +1370,8 @@ For more details, see Info node `(cl)Loop Facility'. (other (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) hash-types) - (not (eq (cl-caadr cl--loop-args) word))) + (memq (caadr cl--loop-args) hash-types) + (not (eq (caadr cl--loop-args) word))) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) @@ -1433,8 +1433,8 @@ For more details, see Info node `(cl)Loop Facility'. (other (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) key-types) - (not (eq (cl-caadr cl--loop-args) word))) + (memq (caadr cl--loop-args) key-types) + (not (eq (caadr cl--loop-args) word))) (cadr (cl--pop2 cl--loop-args)) (error "Bad `using' clause")) (make-symbol "--cl-var--")))) @@ -1656,7 +1656,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." (let ((temps nil) (new nil)) (when par (let ((p specs)) - (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p)))) + (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) (setq p (cdr p))) (when p (setq par nil) @@ -1731,7 +1731,7 @@ such that COMBO is equivalent to (and . CLAUSES)." (setq clauses (cons (nconc (butlast (car clauses)) (if (eq (car-safe (cadr clauses)) 'progn) - (cl-cdadr clauses) + (cdadr clauses) (list (cadr clauses)))) (cddr clauses))) ;; A final (progn ,@A t) is moved outside of the `and'. @@ -2613,7 +2613,7 @@ Example: ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) (while (setq spec (cdr spec)) (if (consp (car spec)) - (if (eq (cl-cadar spec) 0) + (if (eq (cadar spec) 0) (byte-compile-disable-warning (caar spec)) (byte-compile-enable-warning (caar spec))))))) nil) @@ -3093,9 +3093,9 @@ To see the documentation for a defined struct type, use (t `(and (consp cl-x) (memq (nth ,pos cl-x) ,tag-symbol)))))) pred-check (and pred-form (> safety 0) - (if (and (eq (cl-caadr pred-form) 'vectorp) + (if (and (eq (caadr pred-form) 'vectorp) (= safety 1)) - (cons 'and (cl-cdddr pred-form)) + (cons 'and (cdddr pred-form)) `(,predicate cl-x)))) (when pred-form (push `(,defsym ,predicate (cl-x) -- cgit v1.2.3 From 984b8f7ed0687702c524082efb0945f6778fb370 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 3 Aug 2022 11:40:27 +0200 Subject: Remove some spurious references to XEmacs * lisp/desktop.el (desktop--emacs-pid-running-p): * lisp/emacs-lisp/checkdoc.el (checkdoc-ispell-lisp-words): Don't mention XEmacs. --- lisp/desktop.el | 2 +- lisp/emacs-lisp/checkdoc.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/desktop.el b/lisp/desktop.el index a0931e053eb..ef73bc596df 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -701,7 +701,7 @@ DIRNAME omitted or nil means use `desktop-dirname'." -4)))) ;; We should err on the safe side here: if any of the ;; executables is something like "emacs-nox" or "emacs-42.1" - ;; or "gemacs" or "xemacs", let's recognize them as well. + ;; or "gemacs", let's recognize them as well. (and (string-match-p "emacs" proc-cmd) (string-match-p "emacs" my-cmd)))))) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 611f32e23c6..94ade5928f0 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -248,7 +248,7 @@ with these words enabled." ;;;###autoload(put 'checkdoc-spellcheck-documentation-flag 'safe-local-variable #'booleanp) (defvar checkdoc-ispell-lisp-words - '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs") + '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp") "List of words that are correct when spell-checking Lisp documentation.") ;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable #'checkdoc-list-of-strings-p) -- cgit v1.2.3 From 0a6e2b3bfce8b5ae9e713e0668cb3cf5609073e2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 3 Aug 2022 13:13:57 +0200 Subject: Fix quoting of #' in some doc strings * lisp/org/ox.el (org-export-to-file): * lisp/eshell/esh-arg.el (eshell-concat): * lisp/emacs-lisp/edebug.el (edebug-read-special): * lisp/dired-aux.el (dired-split): Fix quoting of #' in doc strings. --- lisp/dired-aux.el | 2 +- lisp/emacs-lisp/edebug.el | 2 +- lisp/eshell/esh-arg.el | 2 +- lisp/org/ox.el | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index b9f33036e31..bb24954386b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -3058,7 +3058,7 @@ Optional third arg LIMIT (>= 1) is a limit to the length of the resulting list. Thus, if SEP is a regexp that only matches itself, - (mapconcat #'identity (dired-split SEP STRING) SEP) + (mapconcat #\\='identity (dired-split SEP STRING) SEP) is always equal to STRING." (declare (obsolete split-string "29.1")) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1a1d58d6e36..dff16df0029 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -864,7 +864,7 @@ marker. The needed data will then come from property (defun edebug-read-special (stream) "Read from STREAM a Lisp object beginning with #. -Turn #'thing into (function thing) and handle the read syntax for +Turn #\\='thing into (function thing) and handle the read syntax for circular objects. Let `read' read everything else." (catch 'return (forward-char 1) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 459487f4358..8e44a88459f 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -186,7 +186,7 @@ If QUOTED is nil, the resulting value(s) may be converted to numbers (see `eshell-concat-1'). If each argument in REST is a non-list value, the result will be -a single value, as if (mapconcat #'eshell-stringify REST) had been +a single value, as if (mapconcat #\\='eshell-stringify REST) had been called, possibly converted to a number. If there is at least one (non-nil) list argument, the result will diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 1bdf4dead89..9a2a69b2c16 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6479,7 +6479,7 @@ to send the output file through additional processing, e.g, (let ((outfile (org-export-output-file-name \".tex\" subtreep))) (org-export-to-file \\='latex outfile async subtreep visible-only body-only ext-plist - #'org-latex-compile))) + #\\='org-latex-compile))) When expressed as an anonymous function, using `lambda', POST-PROCESS needs to be quoted. -- cgit v1.2.3 From 0596c6918667704c486bd7ffba8b13572b8237d9 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 3 Aug 2022 13:14:24 +0200 Subject: Check for mis-quoted #' in doc strings during byte-compile * lisp/emacs-lisp/bytecomp.el (byte-compile-docstring-style-warn): Check for mis-quoted #' in doc strings, too. --- lisp/emacs-lisp/bytecomp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b4954eee9ff..7d2971502da 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1760,7 +1760,7 @@ It is too wide if it has any lines longer than the largest of kind name col)) ;; There's a "naked" ' character before a symbol/list, so it ;; should probably be quoted with \=. - (when (string-match-p "\\( \"\\|[ \t]\\|^\\)'[a-z(]" docs) + (when (string-match-p "\\( [\"#]\\|[ \t]\\|^\\)'[a-z(]" docs) (byte-compile-warn-x name "%s%sdocstring has wrong usage of unescaped single quotes (use \\= or different quoting)" kind name)) -- cgit v1.2.3 From 261d6afd6e6f3ba2bbf4db0d9ac57b0cbacc0137 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 3 Aug 2022 14:22:08 +0200 Subject: Byte-compile the in-tree loaddefs.el files * lisp/Makefile.in (all): Add "autoloads", which now otherwise won't be done. ($(lisp)/loaddefs.el): Remove this target, since it's always done, and would then trigger a re-compilation of loaddefs.elc. * lisp/loadup.el: Load loaddefs.elc (if it exists). * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Don't include no-byte-compile cookies in the Emacs build. * src/Makefile.in ($(pdmp)): Depend on loaddefs.elc to ensure that it's built by this point. ($(etc)/DOC): Don't scan loaddefs.el for doc strings, since they are now picked up from the .elc file (bug#53024). --- lisp/Makefile.in | 17 +++++++---------- lisp/emacs-lisp/loaddefs-gen.el | 3 ++- lisp/loadup.el | 7 ++++--- src/Makefile.in | 6 ++---- 4 files changed, 15 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 9516f2fc364..315b1fcf7ba 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -123,10 +123,10 @@ SUBDIRS_FINDER = $(filter-out ${srcdir}/leim%,${SUBDIRS_ALMOST}) ## All subdirectories in which we might want to create subdirs.el. SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS}) -# cus-load and finder-inf are not explicitly requested by anything, so -# we add them here to make sure they get built. +# cus-load, finder-inf and autoloads are not explicitly requested by +# anything, so we add them here to make sure they get built. all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el generate-ja-dic \ - org-manuals + org-manuals autoloads PHONY_EXTRAS = .PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS) \ @@ -196,13 +196,10 @@ org-manuals: main-first # from ../src rules, but that doesn't seem possible due to the various # non-trivial dependencies. -# We make $(lisp)/loaddefs.el a dependency of .PHONY to cause Make to -# ignore its time stamp. That's because the real dependencies of -# loaddefs.el aren't known to Make, they are implemented in -# loaddefs-generate--emacs-batch. - -autoloads .PHONY: $(lisp)/loaddefs.el -$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) $(lisp)/emacs-lisp/loaddefs-gen.elc +# That's because the real dependencies of loaddefs.el aren't known to +# Make, they are implemented in loaddefs-generate--emacs-batch, so +# autoloads is an "all" dependency. +autoloads: $(AM_V_GEN)$(emacs) \ -l $(lisp)/emacs-lisp/loaddefs-gen.elc \ -f loaddefs-generate--emacs-batch ${SUBDIRS_ALMOST} diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 36b0b1e9cdf..830799ec363 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -588,7 +588,8 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files." (with-temp-buffer (if (and updating (file-exists-p loaddefs-file)) (insert-file-contents loaddefs-file) - (insert (loaddefs-generate--rubric loaddefs-file nil t)) + (insert (loaddefs-generate--rubric + loaddefs-file nil t include-package-version)) (search-backward "\f") (when extra-data (insert extra-data) diff --git a/lisp/loadup.el b/lisp/loadup.el index 21a87dbd77b..a65c1724aee 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -185,9 +185,10 @@ ;; should be updated by overwriting it with an up-to-date copy of ;; loaddefs.el that is not corrupted by local changes. ;; admin/update_autogen can be used to update ldefs-boot.el periodically. -(condition-case nil (load "loaddefs.el") - ;; In case loaddefs hasn't been generated yet. - (file-error (load "ldefs-boot.el"))) +(condition-case nil + (load "loaddefs") + (file-error + (load "ldefs-boot.el"))) (let ((new (make-hash-table :test #'equal))) ;; Now that loaddefs has populated definition-prefixes, purify its contents. diff --git a/src/Makefile.in b/src/Makefile.in index 7d15b7afd51..e81e7a16d94 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -635,7 +635,7 @@ Emacs.pdmp: $(pdmp) endif ifeq ($(DUMPING),pdumper) -$(pdmp): emacs$(EXEEXT) +$(pdmp): emacs$(EXEEXT) $(lispsource)/loaddefs.elc LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \ --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR) cp -f $@ $(bootstrap_pdmp) @@ -652,13 +652,11 @@ endif ## for the first time, this prevents any variation between configurations ## in the contents of the DOC file. ## -$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj) $(lispsource)/loaddefs.el +$(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(doc_obj) $(AM_V_GEN)$(MKDIR_P) $(etc) $(AM_V_at)rm -f $(etc)/DOC $(AM_V_at)$(libsrc)/make-docfile -d $(srcdir) \ $(SOME_MACHINE_OBJECTS) $(doc_obj) > $(etc)/DOC - $(AM_V_at)$(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) \ - loaddefs.el $(libsrc)/make-docfile$(EXEEXT) $(libsrc)/make-fingerprint$(EXEEXT): \ $(lib)/libgnu.a -- cgit v1.2.3 From 4ebdc558f62a4cb5101490e11b7f746d651c513a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 07:44:53 +0200 Subject: Adjust loaddefs-generate--print-form comments * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--print-form): Adjust doc string and comments now that make-docfile doesn't scan this. --- lisp/emacs-lisp/loaddefs-gen.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 830799ec363..00b3bac53cc 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -635,18 +635,19 @@ If GENERATE-FULL, don't update, but regenerate all the loaddefs files." t "GEN"))))))) (defun loaddefs-generate--print-form (def) - "Print DEF in the way make-docfile.c expects it." + "Print DEF in a format that makes sense for version control." (if (or (not (consp def)) (not (symbolp (car def))) (memq (car def) '( make-obsolete define-obsolete-function-alias)) (not (stringp (nth 3 def)))) (prin1 def (current-buffer) t) - ;; The salient point here is that we have to have the doc string - ;; that starts with a backslash and a newline, and there mustn't - ;; be any newlines before that. So -- typically - ;; (defvar foo 'value "\ - ;; Doc string" ...). + ;; We want to print, for instance, `defvar' values while escaping + ;; control characters (so that we don't end up with lines with + ;; trailing tab characters and the like), but we don't want to do + ;; this for doc strings, because then the doc strings would be on + ;; one single line, which would lead to more VC churn. So -- + ;; typically (defvar foo 'value "\ Doc string" ...). (insert "(") (dotimes (_ 3) (prin1 (pop def) (current-buffer) -- cgit v1.2.3 From 4c1bc8315d8e677e4eeb2760d7a5ab7b7553359b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 11:02:49 +0200 Subject: Fix up some prefix registration problems in doc strings * lisp/uniquify.el (uniquify-buffer-name-style): * lisp/org/ob-core.el (org-src-sha): * lisp/emacs-lisp/cl-macs.el (cl--optimize): * lisp/battery.el (battery-update-functions): Avoid triggering the `register-definition-prefixes' in doc strings (bug#56968). --- lisp/battery.el | 16 ++++++++-------- lisp/emacs-lisp/cl-macs.el | 6 +++--- lisp/org/ob-core.el | 12 ++++++------ lisp/uniquify.el | 4 ++-- 4 files changed, 19 insertions(+), 19 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/battery.el b/lisp/battery.el index 3cff3167a6c..93f4070e4bc 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -255,14 +255,14 @@ of the following information may or may not be available: For instance, to play an alarm when the battery power dips below 10%, you could use a function like the following: -(defvar my-prev-battery nil) -(defun my-battery-alarm (data) - (when (and my-prev-battery - (equal (alist-get ?L data) \"off-line\") - (< (string-to-number (alist-get ?p data)) 10) - (>= (string-to-number (alist-get ?p my-prev-battery)) 10)) - (play-sound-file \"~/alarm.wav\" 5)) - (setq my-prev-battery data))" + (defvar my-prev-battery nil) + (defun my-battery-alarm (data) + (when (and my-prev-battery + (equal (alist-get ?L data) \"off-line\") + (< (string-to-number (alist-get ?p data)) 10) + (>= (string-to-number (alist-get ?p my-prev-battery)) 10)) + (play-sound-file \"~/alarm.wav\" 5)) + (setq my-prev-battery data))" :version "29.1" :type '(repeat function)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 12917c99e10..eefaa36b911 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2563,9 +2563,9 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (defun cl--optimize (f _args &rest qualities) "Serve `cl-optimize' in function declarations. Example: -(defun foo (x) - (declare (cl-optimize (speed 3) (safety 0))) - x)" + (defun foo (x) + (declare (cl-optimize (speed 3) (safety 0))) + x)" ;; FIXME this should make use of `cl--declare-stack' but I suspect ;; this mechanism should be reviewed first. (cl-loop for (qly val) in qualities diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 3d159ed38a9..3b114703cdc 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -488,13 +488,13 @@ arguments, imagine you'd like to set the file name output of a latex source block to a sha1 of its contents. We could achieve this with: -(defun org-src-sha () - (let ((elem (org-element-at-point))) - (concat (sha1 (org-element-property :value elem)) \".svg\"))) + (defun org-src-sha () + (let ((elem (org-element-at-point))) + (concat (sha1 (org-element-property :value elem)) \".svg\"))) -(setq org-babel-default-header-args:latex - `((:results . \"file link replace\") - (:file . (lambda () (org-src-sha))))) + (setq org-babel-default-header-args:latex + `((:results . \"file link replace\") + (:file . (lambda () (org-src-sha))))) Because the closure is evaluated with point at the source block, the call to `org-element-at-point' above will always retrieve diff --git a/lisp/uniquify.el b/lisp/uniquify.el index b75b47c03c5..74655e299a8 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -109,8 +109,8 @@ BASE and EXTRA-STRINGS where BASE is a string and EXTRA-STRINGS is a list of strings. For example the current implementation for post-forward-angle-brackets could be: -(defun my-post-forward-angle-brackets (base extra-string) - (concat base \"<\" (mapconcat #\\='identity extra-string \"/\") \">\")) + (defun my-post-forward-angle-brackets (base extra-string) + (concat base \"<\" (mapconcat #\\='identity extra-string \"/\") \">\")) The \"mumble\" part may be stripped as well, depending on the setting of `uniquify-strip-common-suffix'. For more options that -- cgit v1.2.3 From 459b1b8fbc8fda5c136cb52b9a28ca2c3f321691 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 11:27:03 +0200 Subject: Add more autoload-ignored-definitions defs * lisp/emacs-lisp/loaddefs-gen.el (autoload-ignored-definitions): Add more definition forms that shouldn't trigger prefix registration (bug#56970). --- lisp/emacs-lisp/loaddefs-gen.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 00b3bac53cc..8dd67ca993e 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -60,7 +60,10 @@ be included.") "define-widget" "define-erc-module" "define-erc-response-handler" - "defun-rcirc-command") + "defun-rcirc-command" + "define-short-documentation-group" + "def-edebug-elem-spec" + "defvar-mode-local") "List of strings naming definitions to ignore for prefixes. More specifically those definitions will not be considered for the `register-definition-prefixes' call.") -- cgit v1.2.3 From e2eee46247ee9d2332844e5dcf787fb7e5f50067 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 4 Aug 2022 14:36:34 +0200 Subject: Add more autoload-ignored-definitions * lisp/emacs-lisp/loaddefs-gen.el (autoload-ignored-definitions): Add define-ibuffer-column. --- lisp/emacs-lisp/loaddefs-gen.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8dd67ca993e..c11eb3d7ab7 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -63,7 +63,8 @@ be included.") "defun-rcirc-command" "define-short-documentation-group" "def-edebug-elem-spec" - "defvar-mode-local") + "defvar-mode-local" + "define-ibuffer-column") "List of strings naming definitions to ignore for prefixes. More specifically those definitions will not be considered for the `register-definition-prefixes' call.") -- cgit v1.2.3 From 385511f1a2492750106df0991229c90ea701d433 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 4 Aug 2022 14:55:08 +0200 Subject: Add define-key-after to autoload-ignored-definitions * lisp/emacs-lisp/loaddefs-gen.el (autoload-ignored-definitions): Add define-key-after and define-ibuffer-sorter. --- lisp/emacs-lisp/loaddefs-gen.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index c11eb3d7ab7..e3408477b69 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -53,7 +53,8 @@ be included.") (defvar autoload-ignored-definitions '("define-obsolete-function-alias" "define-obsolete-variable-alias" - "define-category" "define-key" + "define-category" + "define-key" "define-key-after" "defgroup" "defface" "defadvice" "def-edebug-spec" ;; Hmm... this is getting ugly: @@ -64,7 +65,8 @@ be included.") "define-short-documentation-group" "def-edebug-elem-spec" "defvar-mode-local" - "define-ibuffer-column") + "define-ibuffer-column" + "define-ibuffer-sorter") "List of strings naming definitions to ignore for prefixes. More specifically those definitions will not be considered for the `register-definition-prefixes' call.") -- cgit v1.2.3 From 91298084965941f7e3d42d638eb52ebd2df5c509 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 15:27:47 +0200 Subject: Add define-keymap to autoload-ignored-definitions * lisp/emacs-lisp/loaddefs-gen.el (autoload-ignored-definitions): Ignore `define-keymap', too (bug#56973). --- lisp/emacs-lisp/loaddefs-gen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index e3408477b69..1bb58c102c2 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -54,7 +54,7 @@ be included.") '("define-obsolete-function-alias" "define-obsolete-variable-alias" "define-category" - "define-key" "define-key-after" + "define-key" "define-key-after" "define-keymap" "defgroup" "defface" "defadvice" "def-edebug-spec" ;; Hmm... this is getting ugly: -- cgit v1.2.3 From d15b67b108a72bbd0216b3eb3bd4e4dd0d1d7968 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 16:29:47 +0200 Subject: Minor checkdoc.el clean up * lisp/emacs-lisp/checkdoc.el (generate-autoload-cookie): This is no longer used, so remove reference. --- lisp/emacs-lisp/checkdoc.el | 2 -- 1 file changed, 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 94ade5928f0..ac589b82f83 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2360,8 +2360,6 @@ News agents may remove it" ;;; Comment checking engine ;; -(defvar generate-autoload-cookie) - (defun checkdoc-file-comments-engine () "Return a message list if this file does not match the Emacs standard. This checks for style only, such as the first line, Commentary:, -- cgit v1.2.3 From f038695085d872124cbb87f2a0382d572014c540 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 16:41:39 +0200 Subject: Minor cleanups in autoload.el/loaddefs-gen.el * lisp/subr.el (package--builtin-versions): Adjust comments. * lisp/emacs-lisp/loaddefs-gen.el (no-update-autoloads): Moved here from autoload.el. * lisp/emacs-lisp/loaddefs-gen.el: Removed now that it's no longer used. * lisp/emacs-lisp/package.el (package-autoload-ensure-default-file): Don't warn about soon-to-be obsolete functon. --- lisp/emacs-lisp/autoload.el | 6 ------ lisp/emacs-lisp/loaddefs-gen.el | 24 +++--------------------- lisp/emacs-lisp/package.el | 4 +++- lisp/subr.el | 2 +- 4 files changed, 7 insertions(+), 29 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index eed88b6faf4..6ad8e81363a 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -267,12 +267,6 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." (hack-local-variables)) (current-buffer))) -(defalias 'autoload-insert-section-header - #'loaddefs-generate--insert-section-header) - -(defvar no-update-autoloads nil - "File local variable to prevent scanning this file for autoload cookies.") - (defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name) (defun generate-file-autoloads (file) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 1bb58c102c2..52ec5ef6809 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -50,6 +50,9 @@ prefix, that will not be registered. But all other prefixes will be included.") (put 'autoload-compute-prefixes 'safe-local-variable #'booleanp) +(defvar no-update-autoloads nil + "File local variable to prevent scanning this file for autoload cookies.") + (defvar autoload-ignored-definitions '("define-obsolete-function-alias" "define-obsolete-variable-alias" @@ -493,27 +496,6 @@ If COMPILE, don't include a \"don't compile\" cookie." :inhibit-provide (not feature)) (buffer-string)))) -(defun loaddefs-generate--insert-section-header (outbuf autoloads - load-name file time) - "Insert into buffer OUTBUF the section-header line for FILE. -The header line lists the file name, its \"load name\", its autoloads, -and the time the FILE was last updated (the time is inserted only -if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." - (insert "\f\n;;;### ") - (prin1 `(autoloads ,autoloads ,load-name ,file ,time) - outbuf) - (terpri outbuf) - ;; Break that line at spaces, to avoid very long lines. - ;; Make each sub-line into a comment. - (with-current-buffer outbuf - (save-excursion - (forward-line -1) - (while (not (eolp)) - (move-to-column 64) - (skip-chars-forward "^ \n") - (or (eolp) - (insert "\n" ";;;;;; ")))))) - ;;;###autoload (defun loaddefs-generate (dir output-file &optional excluded-files extra-data include-package-version diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 482de52f856..d2959f7728c 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1024,7 +1024,9 @@ untar into a directory named DIR; otherwise, signal an error." (unless (file-exists-p file) (require 'autoload) (let ((coding-system-for-write 'utf-8-emacs-unix)) - (write-region (autoload-rubric file "package" nil) nil file nil 'silent))) + (with-suppressed-warnings ((obsolete autoload-rubric)) + (write-region (autoload-rubric file "package" nil) + nil file nil 'silent)))) file) (defvar autoload-timestamps) diff --git a/lisp/subr.el b/lisp/subr.el index 1b59db0604c..2603b5ad251 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6638,7 +6638,7 @@ Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions." (version-list-= (version-to-list v1) (version-to-list v2))) (defvar package--builtin-versions - ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions. + ;; Mostly populated by loaddefs.el. (purecopy `((emacs . ,(version-to-list emacs-version)))) "Alist giving the version of each versioned builtin package. I.e. each element of the list is of the form (NAME . VERSION) where -- cgit v1.2.3 From aa9eaac68e1a80c49932efbd3c62c53a812031ed Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 4 Aug 2022 17:03:59 +0200 Subject: Move autoload.el to lisp/obsolete/ --- lisp/emacs-lisp/autoload.el | 909 -------------------------------------------- lisp/obsolete/autoload.el | 909 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 909 insertions(+), 909 deletions(-) delete mode 100644 lisp/emacs-lisp/autoload.el create mode 100644 lisp/obsolete/autoload.el (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el deleted file mode 100644 index 6ad8e81363a..00000000000 --- a/lisp/emacs-lisp/autoload.el +++ /dev/null @@ -1,909 +0,0 @@ -;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- - -;; Copyright (C) 1991-1997, 2001-2022 Free Software Foundation, Inc. - -;; Author: Roland McGrath -;; Keywords: maint -;; Package: emacs - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to -;; date. It interprets magic cookies of the form ";;;###autoload" in -;; Lisp source files in various useful ways. To learn more, read the -;; source; if you're going to use this, you'd better be able to. - -;; The functions in this file have been largely superseded by -;; loaddefs-gen.el. - -;;; Code: - -(require 'lisp-mode) ;for `doc-string-elt' properties. -(require 'lisp-mnt) -(require 'cl-lib) -(require 'loaddefs-gen) - -;; This feels like it should be a defconst, but MH-E sets it to -;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el. -(defvar generate-autoload-cookie ";;;###autoload" - "Magic comment indicating the following form should be autoloaded. -Used by \\[update-file-autoloads]. This string should be -meaningless to Lisp (e.g., a comment). - -This string is used: - -\;;;###autoload -\(defun function-to-be-autoloaded () ...) - -If this string appears alone on a line, the following form will be -read and an autoload made for it. If there is further text on the line, -that text will be copied verbatim to `generated-autoload-file'.") - -(defvar autoload-excludes nil - "If non-nil, list of absolute file names not to scan for autoloads.") - -(defconst generate-autoload-section-header "\f\n;;;### " - "String that marks the form at the start of a new file's autoload section.") - -(defconst generate-autoload-section-trailer "\n;;;***\n" - "String which indicates the end of the section of autoloads for a file.") - -(defconst generate-autoload-section-continuation ";;;;;; " - "String to add on each continuation of the section header form.") - -;; In some ways it would be nicer to use a value that is recognizably -;; not a time-value, eg t, but that can cause issues if an older Emacs -;; that does not expect non-time-values loads the file. -(defconst autoload--non-timestamp '(0 0 0 0) - "Value to insert when `autoload-timestamps' is nil.") - -(defvar autoload-timestamps nil ; experimental, see bug#22213 - "Non-nil means insert a timestamp for each input file into the output. -We use these in incremental updates of the output file to decide -if we need to rescan an input file. If you set this to nil, -then we use the timestamp of the output file instead. As a result: - - for fixed inputs, the output will be the same every time - - incremental updates of the output file might not be correct if: - i) the timestamp of the output file cannot be trusted (at least - relative to that of the input files) - ii) any of the input files can be modified during the time it takes - to create the output - iii) only a subset of the input files are scanned - These issues are unlikely to happen in practice, and would arguably - represent bugs in the build system. Item iii) will happen if you - use a command like `update-file-autoloads', though, since it only - checks a single input file.") - -(defvar autoload-modified-buffers) ;Dynamically scoped var. - -(defalias 'make-autoload #'loaddefs-generate--make-autoload) - -;; Forms which have doc-strings which should be printed specially. -;; A doc-string-elt property of ELT says that (nth ELT FORM) is -;; the doc-string in FORM. -;; Those properties are now set in lisp-mode.el. - -(defun autoload-find-generated-file (file) - "Visit the autoload file for the current buffer, and return its buffer." - (let ((enable-local-variables :safe) - (enable-local-eval nil) - (find-file-hook nil) - (delay-mode-hooks t)) - ;; We used to use `raw-text' to read this file, but this causes - ;; problems when the file contains non-ASCII characters. - (with-current-buffer (find-file-noselect - (autoload-ensure-file-writeable file)) - (if (zerop (buffer-size)) (insert (autoload-rubric file nil t))) - (current-buffer)))) - -(defun autoload-generated-file (outfile) - "Return OUTFILE as an absolute name. -If `generated-autoload-file' is bound locally in the current -buffer, that is used instead, and it is expanded using the -default directory; otherwise, `source-directory'/lisp is used." - (expand-file-name (if (local-variable-p 'generated-autoload-file) - generated-autoload-file - outfile) - ;; File-local settings of generated-autoload-file should - ;; be interpreted relative to the file's location, - ;; of course. - (if (not (local-variable-p 'generated-autoload-file)) - (expand-file-name "lisp" source-directory)))) - -(defun autoload-read-section-header () - "Read a section header form. -Since continuation lines have been marked as comments, -we must copy the text of the form and remove those comment -markers before we call `read'." - (save-match-data - (let ((beginning (point)) - string) - (forward-line 1) - (while (looking-at generate-autoload-section-continuation) - (forward-line 1)) - (setq string (buffer-substring beginning (point))) - (with-current-buffer (get-buffer-create " *autoload*") - (erase-buffer) - (insert string) - (goto-char (point-min)) - (while (search-forward generate-autoload-section-continuation nil t) - (replace-match " ")) - (goto-char (point-min)) - (read (current-buffer)))))) - -(defvar autoload-print-form-outbuf nil - "Buffer which gets the output of `autoload-print-form'.") - -(defun autoload-print-form (form) - "Print FORM such that `make-docfile' will find the docstrings. -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))) - ;; Symbols at the toplevel are meaningless. - ((symbolp form) nil) - (t - (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt)) - (outbuf autoload-print-form-outbuf)) - (if (and (numberp doc-string-elt) (stringp (nth doc-string-elt form))) - ;; We need to hack the printing because the - ;; doc-string must be printed specially for - ;; make-docfile (sigh). - (let* ((p (nthcdr (1- doc-string-elt) form)) - (elt (cdr p))) - (setcdr p nil) - (princ "\n(" outbuf) - (let ((print-escape-newlines t) - (print-escape-control-characters t) - (print-quoted t) - (print-escape-nonascii t)) - (dolist (elt form) - (prin1 elt outbuf) - (princ " " outbuf))) - (princ "\"\\\n" outbuf) - (let ((begin (with-current-buffer outbuf (point)))) - (princ (substring (prin1-to-string (car elt)) 1) - outbuf) - ;; Insert a backslash before each ( that - ;; appears at the beginning of a line in - ;; the doc string. - (with-current-buffer outbuf - (save-excursion - (while (re-search-backward "\n[[(]" begin t) - (forward-char 1) - (insert "\\")))) - (if (null (cdr elt)) - (princ ")" outbuf) - (princ " " outbuf) - (princ (substring (prin1-to-string (cdr elt)) 1) - outbuf)) - (terpri outbuf))) - (let ((print-escape-newlines t) - (print-escape-control-characters t) - (print-quoted t) - (print-escape-nonascii t)) - (print form outbuf))))))) - -(defalias 'autoload-rubric #'loaddefs-generate--rubric) - -(defvar autoload-ensure-writable nil - "Non-nil means `autoload-find-generated-file' makes existing file writable.") -;; Just in case someone tries to get you to overwrite a file that you -;; don't want to. -;;;###autoload -(put 'autoload-ensure-writable 'risky-local-variable t) - -(defun autoload-ensure-file-writeable (file) - ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, - ;; which was designed to handle CVSREAD=1 and equivalent. - (and autoload-ensure-writable - (let ((modes (file-modes file))) - (if (and modes (zerop (logand modes #o0200))) - ;; Ignore any errors here, and let subsequent attempts - ;; to write the file raise any real error. - (ignore-errors (set-file-modes file (logior modes #o0200)))))) - file) - -(defun autoload-insert-section-header (outbuf autoloads load-name file time) - "Insert into buffer OUTBUF the section-header line for FILE. -The header line lists the file name, its \"load name\", its autoloads, -and the time the FILE was last updated (the time is inserted only -if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." - ;; (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) - (terpri outbuf) - ;; Break that line at spaces, to avoid very long lines. - ;; Make each sub-line into a comment. - (with-current-buffer outbuf - (save-excursion - (forward-line -1) - (while (not (eolp)) - (move-to-column 64) - (skip-chars-forward "^ \n") - (or (eolp) - (insert "\n" generate-autoload-section-continuation)))))) - -(defun autoload-find-file (file) - "Fetch FILE and put it in a temp buffer. Return the buffer." - ;; It is faster to avoid visiting the file. - (setq file (expand-file-name file)) - (with-current-buffer (get-buffer-create " *autoload-file*") - (kill-all-local-variables) - (erase-buffer) - (setq buffer-undo-list t - buffer-read-only nil) - (delay-mode-hooks (emacs-lisp-mode)) - (setq default-directory (file-name-directory file)) - (insert-file-contents file nil) - (let ((enable-local-variables :safe) - (enable-local-eval nil)) - (hack-local-variables)) - (current-buffer))) - -(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name) - -(defun generate-file-autoloads (file) - "Insert at point a loaddefs autoload section for FILE. -Autoloads are generated for defuns and defmacros in FILE -marked by `generate-autoload-cookie' (which see). -If FILE is being visited in a buffer, the contents of the buffer -are used. -Return non-nil in the case where no autoloads were added at point." - (interactive "fGenerate autoloads for file: ") - (let ((autoload-modified-buffers nil)) - (autoload-generate-file-autoloads file (current-buffer) buffer-file-name) - autoload-modified-buffers)) - -(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).") - -(defconst autoload-def-prefixes-max-length 12 - "Target size of definition prefixes. -Don't try to split prefixes that are already longer than that.") - -(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes) - -(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file) - (let ((outbuf - (or (if otherbuf - ;; A file-local setting of - ;; autoload-generated-file says we - ;; should ignore OUTBUF. - nil - outbuf) - (autoload-find-destination absfile load-name output-file) - ;; The file has autoload cookies, but they're - ;; already up-to-date. If OUTFILE is nil, the - ;; entries are in the expected OUTBUF, - ;; otherwise they're elsewhere. - (throw 'done otherbuf)))) - (with-current-buffer outbuf - (point-marker)))) - -(defun autoload--print-cookie-text (output-start load-name file) - (let ((standard-output (marker-buffer output-start))) - (search-forward generate-autoload-cookie) - (skip-chars-forward " \t") - (if (eolp) - (condition-case-unless-debug err - ;; Read the next form and make an autoload. - (let* ((form (prog1 (read (current-buffer)) - (or (bolp) (forward-line 1)))) - (autoload (make-autoload form load-name))) - (if autoload - nil - (setq autoload form)) - (let ((autoload-print-form-outbuf - standard-output)) - (autoload-print-form autoload))) - (error - (message "Autoload cookie error in %s:%s %S" - file (count-lines (point-min) (point)) err))) - - ;; Copy the rest of the line to the output. - (princ (buffer-substring - (progn - ;; Back up over whitespace, to preserve it. - (skip-chars-backward " \f\t") - (if (= (char-after (1+ (point))) ? ) - ;; Eat one space. - (forward-char 1)) - (point)) - (progn (forward-line 1) (point))))))) - -(defvar autoload-builtin-package-versions nil) - -(defun autoload-generate-file-autoloads (file &optional outbuf outfile) - "Insert an autoload section for FILE in the appropriate buffer. -Autoloads are generated for defuns and defmacros in FILE -marked by `generate-autoload-cookie' (which see). - -If FILE is being visited in a buffer, the contents of the buffer are used. -OUTBUF is the buffer in which the autoload statements should be inserted. - -If OUTBUF is nil, the output will go to OUTFILE, unless there's a -buffer-local setting of `generated-autoload-file' in FILE. - -Return non-nil if and only if FILE adds no autoloads to OUTFILE -\(or OUTBUF if OUTFILE is nil). The actual return value is -FILE's modification time." - ;; Include the file name in any error messages - (condition-case err - (let (load-name - (print-length nil) - (print-level nil) - (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 - (catch 'done - (with-current-buffer (or visited - ;; It is faster to avoid visiting the file. - (autoload-find-file file)) - ;; Obey the no-update-autoloads file local variable. - (unless no-update-autoloads - (or noninteractive (message "Generating autoloads for %s..." file)) - (setq load-name - (if (stringp generated-autoload-load-name) - generated-autoload-load-name - (autoload-file-load-name absfile outfile))) - ;; FIXME? Comparing file-names for equality with just equal - ;; is fragile, eg if one has an automounter prefix and one - ;; does not, but both refer to the same physical file. - (when (and outfile - (not outbuf) - (not - (if (memq system-type '(ms-dos windows-nt)) - (equal (downcase outfile) - (downcase (autoload-generated-file - outfile))) - (equal outfile (autoload-generated-file - outfile))))) - (setq otherbuf t)) - (save-excursion - (save-restriction - (widen) - (when autoload-builtin-package-versions - (let ((version (lm-header "version")) - package) - (and version - (setq version (ignore-errors (version-to-list version))) - (setq package (or (lm-header "package") - (file-name-sans-extension - (file-name-nondirectory file)))) - (setq output-start (autoload--setup-output - otherbuf outbuf absfile - load-name outfile)) - (let ((standard-output (marker-buffer output-start)) - (print-quoted t)) - (princ `(push (purecopy - ',(cons (intern package) version)) - package--builtin-versions)) - (princ "\n"))))) - - ;; Do not insert autoload entries for excluded files. - (unless (member absfile autoload-excludes) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n\f") - (cond - ((looking-at (regexp-quote generate-autoload-cookie)) - ;; If not done yet, figure out where to insert this text. - (unless output-start - (setq output-start (autoload--setup-output - otherbuf outbuf absfile - load-name outfile))) - (autoload--print-cookie-text output-start load-name file)) - ((= (following-char) ?\;) - ;; Don't read the comment. - (forward-line 1)) - (t - ;; Avoid (defvar ) 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) - autoload-ignored-definitions))) - (push (match-string-no-properties 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 outfile))) - (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. - (autoload--setup-output nil outbuf absfile load-name - outfile)) - (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 - (if autoload-timestamps - (file-attribute-modification-time - (file-attributes absfile)) - autoload--non-timestamp)) - (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. - (goto-char output-start) - (let ((relfile (file-relative-name absfile))) - (autoload-insert-section-header - (marker-buffer output-start) - () load-name relfile - (if secondary-autoloads-file-buf - ;; MD5 checksums are much better because they do not - ;; change unless the file changes (so they'll be - ;; equal on two different systems and will change - ;; less often than time-stamps, thus leading to fewer - ;; unneeded changes causing spurious conflicts), but - ;; using time-stamps is a very useful optimization, - ;; so we use time-stamps for the main autoloads file - ;; (loaddefs.el) where we have special ways to - ;; circumvent the "random change problem", and MD5 - ;; checksum in secondary autoload files where we do - ;; not need the time-stamp optimization because it is - ;; already provided by the primary autoloads file. - (md5 secondary-autoloads-file-buf - ;; We'd really want to just use - ;; `emacs-internal' instead. - nil nil 'emacs-mule-unix) - (if autoload-timestamps - (file-attribute-modification-time - (file-attributes relfile)) - autoload--non-timestamp))) - (insert ";;; Generated autoloads from " relfile "\n"))) - (insert generate-autoload-section-trailer)))) - (or noninteractive - (message "Generating autoloads for %s...done" file))) - (or visited - ;; We created this buffer, so we should kill it. - (kill-buffer (current-buffer)))) - (or (not output-start) - ;; If the entries were added to some other buffer, then the file - ;; doesn't add entries to OUTFILE. - otherbuf)) - (file-attribute-modification-time (file-attributes absfile)))) - (error - ;; Probably unbalanced parens in forward-sexp. In that case, the - ;; condition is scan-error, and the signal data includes point - ;; where the error was found; we'd like to convert that to - ;; line:col, but line-number-at-pos gets the wrong line in batch - ;; mode for some reason. - ;; - ;; At least this gets the file name in the error message; the - ;; developer can use goto-char to get to the error position. - (error "%s:0:0: error: %s: %s" file (car err) (cdr err))) - )) - -;; For parallel builds, to stop another process reading a half-written file. -(defun autoload--save-buffer () - "Save current buffer to its file, atomically." - ;; Similar to byte-compile-file. - (let* ((version-control 'never) - (tempfile (make-temp-file buffer-file-name)) - (default-modes (default-file-modes)) - (temp-modes (logand default-modes #o600)) - (desired-modes (logand default-modes - (or (file-modes buffer-file-name) #o666))) - (kill-emacs-hook - (cons (lambda () (ignore-errors (delete-file tempfile))) - kill-emacs-hook))) - (unless (= temp-modes desired-modes) - (set-file-modes tempfile desired-modes 'nofollow)) - (write-region (point-min) (point-max) tempfile nil 1) - (backup-buffer) - (rename-file tempfile buffer-file-name t)) - (set-buffer-modified-p nil) - (set-visited-file-modtime) - (or noninteractive (message "Wrote %s" buffer-file-name))) - -(defun autoload-save-buffers () - (while autoload-modified-buffers - (with-current-buffer (pop autoload-modified-buffers) - (autoload--save-buffer)))) - -;; FIXME This command should be deprecated. -;; See https://debbugs.gnu.org/22213#41 -;;;###autoload -(defun update-file-autoloads (file &optional save-after outfile) - "Update the autoloads for FILE. -If prefix arg SAVE-AFTER is non-nil, save the buffer too. - -If FILE binds `generated-autoload-file' as a file-local variable, -autoloads are written into that file. Otherwise, the autoloads -file is determined by OUTFILE. If called interactively, prompt -for OUTFILE; if called from Lisp with OUTFILE nil, use the -existing value of `generated-autoload-file'. - -Return FILE if there was no autoload cookie in it, else nil." - (interactive (list (read-file-name "Update autoloads for file: ") - current-prefix-arg - (read-file-name "Write autoload definitions to file: "))) - (setq outfile (or outfile generated-autoload-file)) - (let* ((autoload-modified-buffers nil) - ;; We need this only if the output file handles more than one input. - ;; See https://debbugs.gnu.org/22213#38 and subsequent. - (autoload-timestamps t) - (no-autoloads (autoload-generate-file-autoloads - file nil - (if (local-variable-p 'generated-autoload-file) - generated-autoload-file - outfile)))) - (if autoload-modified-buffers - (if save-after (autoload-save-buffers)) - (if (called-interactively-p 'interactive) - (message "Autoload section for %s is up to date." file))) - (if no-autoloads file))) - -(defun autoload-find-destination (file load-name output-file) - "Find the destination point of the current buffer's autoloads. -FILE is the file name of the current buffer. -LOAD-NAME is the name as it appears in the output. -Returns a buffer whose point is placed at the requested location. -Returns nil if the file's autoloads are up-to-date, otherwise -removes any prior now out-of-date autoload entries." - (catch 'up-to-date - (let* ((buf (current-buffer)) - (existing-buffer (if buffer-file-name buf)) - (output-file (autoload-generated-file output-file)) - (output-time (if (file-exists-p output-file) - (file-attribute-modification-time - (file-attributes output-file)))) - (found nil)) - (with-current-buffer (autoload-find-generated-file output-file) - ;; This is to make generated-autoload-file have Unix EOLs, so - ;; that it is portable to all platforms. - (or (eq 0 (coding-system-eol-type buffer-file-coding-system)) - (set-buffer-file-coding-system 'unix)) - (or (> (buffer-size) 0) - (error "Autoloads file %s lacks boilerplate" buffer-file-name)) - (or (file-writable-p buffer-file-name) - (error "Autoloads file %s is not writable" buffer-file-name)) - (widen) - (goto-char (point-min)) - ;; Look for the section for LOAD-NAME. - (while (and (not found) - (search-forward generate-autoload-section-header nil t)) - (let ((form (autoload-read-section-header))) - (cond ((string= (nth 2 form) load-name) - ;; We found the section for this file. - ;; Check if it is up to date. - (let ((begin (match-beginning 0)) - (last-time (nth 4 form)) - (file-time (file-attribute-modification-time - (file-attributes file)))) - (if (and (or (null existing-buffer) - (not (buffer-modified-p existing-buffer))) - (cond - ;; FIXME? Arguably we should throw a - ;; user error, or some kind of warning, - ;; if we were called from update-file-autoloads, - ;; which can update only a single input file. - ;; It's not appropriate to use the output - ;; file modtime in such a case, - ;; if there are multiple input files - ;; contributing to the output. - ((and output-time - (member last-time - (list t autoload--non-timestamp))) - (not (time-less-p output-time file-time))) - ;; last-time is the time-stamp (specifying - ;; the last time we looked at the file) and - ;; the file hasn't been changed since. - ((listp last-time) - (not (time-less-p last-time file-time))) - ;; last-time is an MD5 checksum instead. - ((stringp last-time) - (equal last-time - (md5 buf nil nil 'emacs-mule))))) - (throw 'up-to-date nil) - (autoload-remove-section begin) - (setq found t)))) - ((string< load-name (nth 2 form)) - ;; We've come to a section alphabetically later than - ;; LOAD-NAME. We assume the file is in order and so - ;; there must be no section for LOAD-NAME. We will - ;; insert one before the section here. - (goto-char (match-beginning 0)) - (setq found t))))) - (or found - (progn - ;; No later sections in the file. Put before the last page. - (goto-char (point-max)) - (search-backward "\f" nil t))) - (unless (memq (current-buffer) autoload-modified-buffers) - (push (current-buffer) autoload-modified-buffers)) - (current-buffer))))) - -(defun autoload-remove-section (begin) - (goto-char begin) - (search-forward generate-autoload-section-trailer) - (delete-region begin (point))) - -;;;###autoload -(defun update-directory-autoloads (&rest dirs) - "Update autoload definitions for Lisp files in the directories DIRS. -In an interactive call, you must give one argument, the name of a -single directory. In a call from Lisp, you can supply multiple -directories as separate arguments, but this usage is discouraged. - -The function does NOT recursively descend into subdirectories of the -directory or directories specified. - -In an interactive call, prompt for a default output file for the -autoload definitions. When called from Lisp, use the existing -value of `generated-autoload-file'. If any Lisp file binds -`generated-autoload-file' as a file-local variable, write its -autoloads into the specified file instead." - (declare (obsolete make-directory-autoloads "28.1")) - (interactive "DUpdate autoloads from directory: ") - (make-directory-autoloads - dirs - (if (called-interactively-p 'interactive) - (read-file-name "Write autoload definitions to file: ") - generated-autoload-file))) - -;;;###autoload -(defun make-directory-autoloads (dir output-file) - "Update autoload definitions for Lisp files in the directories DIRS. -DIR can be either a single directory or a list of -directories. (The latter usage is discouraged.) - -The autoloads will be written to OUTPUT-FILE. If any Lisp file -binds `generated-autoload-file' as a file-local variable, write -its autoloads into the specified file instead. - -The function does NOT recursively descend into subdirectories of the -directory or directories specified." - (interactive "DUpdate autoloads from directory: \nFWrite to file: ") - (let* ((files-re (let ((tmp nil)) - (dolist (suf (get-load-suffixes)) - ;; We don't use module-file-suffix below because - ;; we don't want to depend on whether Emacs was - ;; built with or without modules support, nor - ;; what is the suffix for the underlying OS. - (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf) - (push suf tmp))) - (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'"))) - (files (apply #'nconc - (mapcar (lambda (d) - (directory-files (expand-file-name d) - t files-re)) - (if (consp dir) dir (list dir))))) - (done ()) ;Files processed; to remove duplicates. - (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. - (no-autoloads nil) - ;; Ensure that we don't do odd things when putting the doc - ;; strings into the autoloads file. - (left-margin 0) - (autoload-modified-buffers nil) - (output-time - (and (file-exists-p output-file) - (file-attribute-modification-time - (file-attributes output-file))))) - - (with-current-buffer (autoload-find-generated-file output-file) - (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))) - - (goto-char (point-min)) - (while (search-forward generate-autoload-section-header nil t) - (let* ((form (autoload-read-section-header)) - (file (nth 3 form))) - (cond ((and (consp file) (stringp (car file))) - ;; This is a list of files that have no autoload cookies. - ;; There shouldn't be more than one such entry. - ;; Remove the obsolete section. - (autoload-remove-section (match-beginning 0)) - (setq last-time (nth 4 form)) - (if (member last-time (list t autoload--non-timestamp)) - (setq last-time output-time)) - (dolist (file file) - (let ((file-time (file-attribute-modification-time - (file-attributes file)))) - (when (and file-time - (not (time-less-p last-time file-time))) - ;; file unchanged - (push file no-autoloads) - (setq files (delete file files)))))) - ((not (stringp file))) - ((or (not (file-exists-p file)) - ;; Remove duplicates as well, just in case. - (member file done)) - ;; 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 - (list - t autoload--non-timestamp)) - output-time - oldtime)) - (file-attribute-modification-time - (file-attributes file)))) - ;; 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. - file (current-buffer) buffer-file-name) - (push file no-autoloads)))) - (push file done) - (setq files (delete file files))))) - ;; Elements remaining in FILES have no existing autoload sections yet. - (let ((no-autoloads-time (or last-time '(0 0 0 0))) - (progress (make-progress-reporter - (byte-compile-info - (concat "Scraping files for " - (file-relative-name output-file))) - 0 (length files) nil 10)) - (file-count 0) - file-time) - (dolist (file files) - (progress-reporter-update progress (setq file-count (1+ file-count))) - (cond - ;; Passing nil as second argument forces - ;; autoload-generate-file-autoloads to look for the right - ;; spot where to insert each autoloads section. - ((setq file-time - (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))) - (t (setq changed t)))) - (progress-reporter-done progress) - - (when no-autoloads - ;; Sort them for better readability. - (setq no-autoloads (sort no-autoloads 'string<)) - ;; Add the `no-autoloads' section. - (goto-char (point-max)) - (search-backward "\f" nil t) - (autoload-insert-section-header - (current-buffer) nil nil - ;; Filter out the other loaddefs files, because it makes - ;; the list unstable (and leads to spurious changes in - ;; ldefs-boot.el) since the loaddef files can be created in - ;; any order. - (seq-filter (lambda (file) - (not (string-match-p "[/-]loaddefs.el" file))) - no-autoloads) - (if autoload-timestamps - no-autoloads-time - autoload--non-timestamp)) - (insert generate-autoload-section-trailer))) - - ;; Don't modify the file if its content has not been changed, so `make' - ;; dependencies don't trigger unnecessarily. - (if (not changed) - (set-buffer-modified-p nil) - (autoload--save-buffer)) - - ;; In case autoload entries were added to other files because of - ;; file-local autoload-generated-file settings. - (autoload-save-buffers)))) - -(defun batch-update-autoloads--summary (strings) - (let ((message "")) - (while strings - (when (> (length (concat message " " (car strings))) 64) - (byte-compile-info (concat message " ...") t "SCRAPE") - (setq message "")) - (setq message (if (zerop (length message)) - (car strings) - (concat message " " (car strings)))) - (setq strings (cdr strings))) - (when (> (length message) 0) - (byte-compile-info message t "SCRAPE")))) - -;;;###autoload -(defun batch-update-autoloads () - "Update loaddefs.el autoloads in batch mode. -Calls `update-directory-autoloads' on the command line arguments. -Definitions are written to `generated-autoload-file' (which -should be non-nil)." - ;; For use during the Emacs build process only. - ;; Exclude those files that are preloaded on ALL platforms. - ;; These are the ones in loadup.el where "(load" is at the start - ;; of the line (crude, but it works). - (unless autoload-excludes - (let ((default-directory (file-name-directory generated-autoload-file)) - file) - (when (file-readable-p "loadup.el") - (with-temp-buffer - (insert-file-contents "loadup.el") - (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t) - (setq file (match-string 1)) - (or (string-match "\\.el\\'" file) - (setq file (format "%s.el" file))) - (or (string-match "\\`site-" file) - (push (expand-file-name file) autoload-excludes))))))) - (let ((args command-line-args-left)) - (batch-update-autoloads--summary args) - (setq command-line-args-left nil) - (make-directory-autoloads args generated-autoload-file))) - -(provide 'autoload) - -;;; autoload.el ends here diff --git a/lisp/obsolete/autoload.el b/lisp/obsolete/autoload.el new file mode 100644 index 00000000000..6ad8e81363a --- /dev/null +++ b/lisp/obsolete/autoload.el @@ -0,0 +1,909 @@ +;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*- + +;; Copyright (C) 1991-1997, 2001-2022 Free Software Foundation, Inc. + +;; Author: Roland McGrath +;; Keywords: maint +;; Package: emacs + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to +;; date. It interprets magic cookies of the form ";;;###autoload" in +;; Lisp source files in various useful ways. To learn more, read the +;; source; if you're going to use this, you'd better be able to. + +;; The functions in this file have been largely superseded by +;; loaddefs-gen.el. + +;;; Code: + +(require 'lisp-mode) ;for `doc-string-elt' properties. +(require 'lisp-mnt) +(require 'cl-lib) +(require 'loaddefs-gen) + +;; This feels like it should be a defconst, but MH-E sets it to +;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el. +(defvar generate-autoload-cookie ";;;###autoload" + "Magic comment indicating the following form should be autoloaded. +Used by \\[update-file-autoloads]. This string should be +meaningless to Lisp (e.g., a comment). + +This string is used: + +\;;;###autoload +\(defun function-to-be-autoloaded () ...) + +If this string appears alone on a line, the following form will be +read and an autoload made for it. If there is further text on the line, +that text will be copied verbatim to `generated-autoload-file'.") + +(defvar autoload-excludes nil + "If non-nil, list of absolute file names not to scan for autoloads.") + +(defconst generate-autoload-section-header "\f\n;;;### " + "String that marks the form at the start of a new file's autoload section.") + +(defconst generate-autoload-section-trailer "\n;;;***\n" + "String which indicates the end of the section of autoloads for a file.") + +(defconst generate-autoload-section-continuation ";;;;;; " + "String to add on each continuation of the section header form.") + +;; In some ways it would be nicer to use a value that is recognizably +;; not a time-value, eg t, but that can cause issues if an older Emacs +;; that does not expect non-time-values loads the file. +(defconst autoload--non-timestamp '(0 0 0 0) + "Value to insert when `autoload-timestamps' is nil.") + +(defvar autoload-timestamps nil ; experimental, see bug#22213 + "Non-nil means insert a timestamp for each input file into the output. +We use these in incremental updates of the output file to decide +if we need to rescan an input file. If you set this to nil, +then we use the timestamp of the output file instead. As a result: + - for fixed inputs, the output will be the same every time + - incremental updates of the output file might not be correct if: + i) the timestamp of the output file cannot be trusted (at least + relative to that of the input files) + ii) any of the input files can be modified during the time it takes + to create the output + iii) only a subset of the input files are scanned + These issues are unlikely to happen in practice, and would arguably + represent bugs in the build system. Item iii) will happen if you + use a command like `update-file-autoloads', though, since it only + checks a single input file.") + +(defvar autoload-modified-buffers) ;Dynamically scoped var. + +(defalias 'make-autoload #'loaddefs-generate--make-autoload) + +;; Forms which have doc-strings which should be printed specially. +;; A doc-string-elt property of ELT says that (nth ELT FORM) is +;; the doc-string in FORM. +;; Those properties are now set in lisp-mode.el. + +(defun autoload-find-generated-file (file) + "Visit the autoload file for the current buffer, and return its buffer." + (let ((enable-local-variables :safe) + (enable-local-eval nil) + (find-file-hook nil) + (delay-mode-hooks t)) + ;; We used to use `raw-text' to read this file, but this causes + ;; problems when the file contains non-ASCII characters. + (with-current-buffer (find-file-noselect + (autoload-ensure-file-writeable file)) + (if (zerop (buffer-size)) (insert (autoload-rubric file nil t))) + (current-buffer)))) + +(defun autoload-generated-file (outfile) + "Return OUTFILE as an absolute name. +If `generated-autoload-file' is bound locally in the current +buffer, that is used instead, and it is expanded using the +default directory; otherwise, `source-directory'/lisp is used." + (expand-file-name (if (local-variable-p 'generated-autoload-file) + generated-autoload-file + outfile) + ;; File-local settings of generated-autoload-file should + ;; be interpreted relative to the file's location, + ;; of course. + (if (not (local-variable-p 'generated-autoload-file)) + (expand-file-name "lisp" source-directory)))) + +(defun autoload-read-section-header () + "Read a section header form. +Since continuation lines have been marked as comments, +we must copy the text of the form and remove those comment +markers before we call `read'." + (save-match-data + (let ((beginning (point)) + string) + (forward-line 1) + (while (looking-at generate-autoload-section-continuation) + (forward-line 1)) + (setq string (buffer-substring beginning (point))) + (with-current-buffer (get-buffer-create " *autoload*") + (erase-buffer) + (insert string) + (goto-char (point-min)) + (while (search-forward generate-autoload-section-continuation nil t) + (replace-match " ")) + (goto-char (point-min)) + (read (current-buffer)))))) + +(defvar autoload-print-form-outbuf nil + "Buffer which gets the output of `autoload-print-form'.") + +(defun autoload-print-form (form) + "Print FORM such that `make-docfile' will find the docstrings. +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))) + ;; Symbols at the toplevel are meaningless. + ((symbolp form) nil) + (t + (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt)) + (outbuf autoload-print-form-outbuf)) + (if (and (numberp doc-string-elt) (stringp (nth doc-string-elt form))) + ;; We need to hack the printing because the + ;; doc-string must be printed specially for + ;; make-docfile (sigh). + (let* ((p (nthcdr (1- doc-string-elt) form)) + (elt (cdr p))) + (setcdr p nil) + (princ "\n(" outbuf) + (let ((print-escape-newlines t) + (print-escape-control-characters t) + (print-quoted t) + (print-escape-nonascii t)) + (dolist (elt form) + (prin1 elt outbuf) + (princ " " outbuf))) + (princ "\"\\\n" outbuf) + (let ((begin (with-current-buffer outbuf (point)))) + (princ (substring (prin1-to-string (car elt)) 1) + outbuf) + ;; Insert a backslash before each ( that + ;; appears at the beginning of a line in + ;; the doc string. + (with-current-buffer outbuf + (save-excursion + (while (re-search-backward "\n[[(]" begin t) + (forward-char 1) + (insert "\\")))) + (if (null (cdr elt)) + (princ ")" outbuf) + (princ " " outbuf) + (princ (substring (prin1-to-string (cdr elt)) 1) + outbuf)) + (terpri outbuf))) + (let ((print-escape-newlines t) + (print-escape-control-characters t) + (print-quoted t) + (print-escape-nonascii t)) + (print form outbuf))))))) + +(defalias 'autoload-rubric #'loaddefs-generate--rubric) + +(defvar autoload-ensure-writable nil + "Non-nil means `autoload-find-generated-file' makes existing file writable.") +;; Just in case someone tries to get you to overwrite a file that you +;; don't want to. +;;;###autoload +(put 'autoload-ensure-writable 'risky-local-variable t) + +(defun autoload-ensure-file-writeable (file) + ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, + ;; which was designed to handle CVSREAD=1 and equivalent. + (and autoload-ensure-writable + (let ((modes (file-modes file))) + (if (and modes (zerop (logand modes #o0200))) + ;; Ignore any errors here, and let subsequent attempts + ;; to write the file raise any real error. + (ignore-errors (set-file-modes file (logior modes #o0200)))))) + file) + +(defun autoload-insert-section-header (outbuf autoloads load-name file time) + "Insert into buffer OUTBUF the section-header line for FILE. +The header line lists the file name, its \"load name\", its autoloads, +and the time the FILE was last updated (the time is inserted only +if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." + ;; (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) + (terpri outbuf) + ;; Break that line at spaces, to avoid very long lines. + ;; Make each sub-line into a comment. + (with-current-buffer outbuf + (save-excursion + (forward-line -1) + (while (not (eolp)) + (move-to-column 64) + (skip-chars-forward "^ \n") + (or (eolp) + (insert "\n" generate-autoload-section-continuation)))))) + +(defun autoload-find-file (file) + "Fetch FILE and put it in a temp buffer. Return the buffer." + ;; It is faster to avoid visiting the file. + (setq file (expand-file-name file)) + (with-current-buffer (get-buffer-create " *autoload-file*") + (kill-all-local-variables) + (erase-buffer) + (setq buffer-undo-list t + buffer-read-only nil) + (delay-mode-hooks (emacs-lisp-mode)) + (setq default-directory (file-name-directory file)) + (insert-file-contents file nil) + (let ((enable-local-variables :safe) + (enable-local-eval nil)) + (hack-local-variables)) + (current-buffer))) + +(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name) + +(defun generate-file-autoloads (file) + "Insert at point a loaddefs autoload section for FILE. +Autoloads are generated for defuns and defmacros in FILE +marked by `generate-autoload-cookie' (which see). +If FILE is being visited in a buffer, the contents of the buffer +are used. +Return non-nil in the case where no autoloads were added at point." + (interactive "fGenerate autoloads for file: ") + (let ((autoload-modified-buffers nil)) + (autoload-generate-file-autoloads file (current-buffer) buffer-file-name) + autoload-modified-buffers)) + +(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).") + +(defconst autoload-def-prefixes-max-length 12 + "Target size of definition prefixes. +Don't try to split prefixes that are already longer than that.") + +(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes) + +(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file) + (let ((outbuf + (or (if otherbuf + ;; A file-local setting of + ;; autoload-generated-file says we + ;; should ignore OUTBUF. + nil + outbuf) + (autoload-find-destination absfile load-name output-file) + ;; The file has autoload cookies, but they're + ;; already up-to-date. If OUTFILE is nil, the + ;; entries are in the expected OUTBUF, + ;; otherwise they're elsewhere. + (throw 'done otherbuf)))) + (with-current-buffer outbuf + (point-marker)))) + +(defun autoload--print-cookie-text (output-start load-name file) + (let ((standard-output (marker-buffer output-start))) + (search-forward generate-autoload-cookie) + (skip-chars-forward " \t") + (if (eolp) + (condition-case-unless-debug err + ;; Read the next form and make an autoload. + (let* ((form (prog1 (read (current-buffer)) + (or (bolp) (forward-line 1)))) + (autoload (make-autoload form load-name))) + (if autoload + nil + (setq autoload form)) + (let ((autoload-print-form-outbuf + standard-output)) + (autoload-print-form autoload))) + (error + (message "Autoload cookie error in %s:%s %S" + file (count-lines (point-min) (point)) err))) + + ;; Copy the rest of the line to the output. + (princ (buffer-substring + (progn + ;; Back up over whitespace, to preserve it. + (skip-chars-backward " \f\t") + (if (= (char-after (1+ (point))) ? ) + ;; Eat one space. + (forward-char 1)) + (point)) + (progn (forward-line 1) (point))))))) + +(defvar autoload-builtin-package-versions nil) + +(defun autoload-generate-file-autoloads (file &optional outbuf outfile) + "Insert an autoload section for FILE in the appropriate buffer. +Autoloads are generated for defuns and defmacros in FILE +marked by `generate-autoload-cookie' (which see). + +If FILE is being visited in a buffer, the contents of the buffer are used. +OUTBUF is the buffer in which the autoload statements should be inserted. + +If OUTBUF is nil, the output will go to OUTFILE, unless there's a +buffer-local setting of `generated-autoload-file' in FILE. + +Return non-nil if and only if FILE adds no autoloads to OUTFILE +\(or OUTBUF if OUTFILE is nil). The actual return value is +FILE's modification time." + ;; Include the file name in any error messages + (condition-case err + (let (load-name + (print-length nil) + (print-level nil) + (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 + (catch 'done + (with-current-buffer (or visited + ;; It is faster to avoid visiting the file. + (autoload-find-file file)) + ;; Obey the no-update-autoloads file local variable. + (unless no-update-autoloads + (or noninteractive (message "Generating autoloads for %s..." file)) + (setq load-name + (if (stringp generated-autoload-load-name) + generated-autoload-load-name + (autoload-file-load-name absfile outfile))) + ;; FIXME? Comparing file-names for equality with just equal + ;; is fragile, eg if one has an automounter prefix and one + ;; does not, but both refer to the same physical file. + (when (and outfile + (not outbuf) + (not + (if (memq system-type '(ms-dos windows-nt)) + (equal (downcase outfile) + (downcase (autoload-generated-file + outfile))) + (equal outfile (autoload-generated-file + outfile))))) + (setq otherbuf t)) + (save-excursion + (save-restriction + (widen) + (when autoload-builtin-package-versions + (let ((version (lm-header "version")) + package) + (and version + (setq version (ignore-errors (version-to-list version))) + (setq package (or (lm-header "package") + (file-name-sans-extension + (file-name-nondirectory file)))) + (setq output-start (autoload--setup-output + otherbuf outbuf absfile + load-name outfile)) + (let ((standard-output (marker-buffer output-start)) + (print-quoted t)) + (princ `(push (purecopy + ',(cons (intern package) version)) + package--builtin-versions)) + (princ "\n"))))) + + ;; Do not insert autoload entries for excluded files. + (unless (member absfile autoload-excludes) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n\f") + (cond + ((looking-at (regexp-quote generate-autoload-cookie)) + ;; If not done yet, figure out where to insert this text. + (unless output-start + (setq output-start (autoload--setup-output + otherbuf outbuf absfile + load-name outfile))) + (autoload--print-cookie-text output-start load-name file)) + ((= (following-char) ?\;) + ;; Don't read the comment. + (forward-line 1)) + (t + ;; Avoid (defvar ) 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) + autoload-ignored-definitions))) + (push (match-string-no-properties 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 outfile))) + (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. + (autoload--setup-output nil outbuf absfile load-name + outfile)) + (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 + (if autoload-timestamps + (file-attribute-modification-time + (file-attributes absfile)) + autoload--non-timestamp)) + (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. + (goto-char output-start) + (let ((relfile (file-relative-name absfile))) + (autoload-insert-section-header + (marker-buffer output-start) + () load-name relfile + (if secondary-autoloads-file-buf + ;; MD5 checksums are much better because they do not + ;; change unless the file changes (so they'll be + ;; equal on two different systems and will change + ;; less often than time-stamps, thus leading to fewer + ;; unneeded changes causing spurious conflicts), but + ;; using time-stamps is a very useful optimization, + ;; so we use time-stamps for the main autoloads file + ;; (loaddefs.el) where we have special ways to + ;; circumvent the "random change problem", and MD5 + ;; checksum in secondary autoload files where we do + ;; not need the time-stamp optimization because it is + ;; already provided by the primary autoloads file. + (md5 secondary-autoloads-file-buf + ;; We'd really want to just use + ;; `emacs-internal' instead. + nil nil 'emacs-mule-unix) + (if autoload-timestamps + (file-attribute-modification-time + (file-attributes relfile)) + autoload--non-timestamp))) + (insert ";;; Generated autoloads from " relfile "\n"))) + (insert generate-autoload-section-trailer)))) + (or noninteractive + (message "Generating autoloads for %s...done" file))) + (or visited + ;; We created this buffer, so we should kill it. + (kill-buffer (current-buffer)))) + (or (not output-start) + ;; If the entries were added to some other buffer, then the file + ;; doesn't add entries to OUTFILE. + otherbuf)) + (file-attribute-modification-time (file-attributes absfile)))) + (error + ;; Probably unbalanced parens in forward-sexp. In that case, the + ;; condition is scan-error, and the signal data includes point + ;; where the error was found; we'd like to convert that to + ;; line:col, but line-number-at-pos gets the wrong line in batch + ;; mode for some reason. + ;; + ;; At least this gets the file name in the error message; the + ;; developer can use goto-char to get to the error position. + (error "%s:0:0: error: %s: %s" file (car err) (cdr err))) + )) + +;; For parallel builds, to stop another process reading a half-written file. +(defun autoload--save-buffer () + "Save current buffer to its file, atomically." + ;; Similar to byte-compile-file. + (let* ((version-control 'never) + (tempfile (make-temp-file buffer-file-name)) + (default-modes (default-file-modes)) + (temp-modes (logand default-modes #o600)) + (desired-modes (logand default-modes + (or (file-modes buffer-file-name) #o666))) + (kill-emacs-hook + (cons (lambda () (ignore-errors (delete-file tempfile))) + kill-emacs-hook))) + (unless (= temp-modes desired-modes) + (set-file-modes tempfile desired-modes 'nofollow)) + (write-region (point-min) (point-max) tempfile nil 1) + (backup-buffer) + (rename-file tempfile buffer-file-name t)) + (set-buffer-modified-p nil) + (set-visited-file-modtime) + (or noninteractive (message "Wrote %s" buffer-file-name))) + +(defun autoload-save-buffers () + (while autoload-modified-buffers + (with-current-buffer (pop autoload-modified-buffers) + (autoload--save-buffer)))) + +;; FIXME This command should be deprecated. +;; See https://debbugs.gnu.org/22213#41 +;;;###autoload +(defun update-file-autoloads (file &optional save-after outfile) + "Update the autoloads for FILE. +If prefix arg SAVE-AFTER is non-nil, save the buffer too. + +If FILE binds `generated-autoload-file' as a file-local variable, +autoloads are written into that file. Otherwise, the autoloads +file is determined by OUTFILE. If called interactively, prompt +for OUTFILE; if called from Lisp with OUTFILE nil, use the +existing value of `generated-autoload-file'. + +Return FILE if there was no autoload cookie in it, else nil." + (interactive (list (read-file-name "Update autoloads for file: ") + current-prefix-arg + (read-file-name "Write autoload definitions to file: "))) + (setq outfile (or outfile generated-autoload-file)) + (let* ((autoload-modified-buffers nil) + ;; We need this only if the output file handles more than one input. + ;; See https://debbugs.gnu.org/22213#38 and subsequent. + (autoload-timestamps t) + (no-autoloads (autoload-generate-file-autoloads + file nil + (if (local-variable-p 'generated-autoload-file) + generated-autoload-file + outfile)))) + (if autoload-modified-buffers + (if save-after (autoload-save-buffers)) + (if (called-interactively-p 'interactive) + (message "Autoload section for %s is up to date." file))) + (if no-autoloads file))) + +(defun autoload-find-destination (file load-name output-file) + "Find the destination point of the current buffer's autoloads. +FILE is the file name of the current buffer. +LOAD-NAME is the name as it appears in the output. +Returns a buffer whose point is placed at the requested location. +Returns nil if the file's autoloads are up-to-date, otherwise +removes any prior now out-of-date autoload entries." + (catch 'up-to-date + (let* ((buf (current-buffer)) + (existing-buffer (if buffer-file-name buf)) + (output-file (autoload-generated-file output-file)) + (output-time (if (file-exists-p output-file) + (file-attribute-modification-time + (file-attributes output-file)))) + (found nil)) + (with-current-buffer (autoload-find-generated-file output-file) + ;; This is to make generated-autoload-file have Unix EOLs, so + ;; that it is portable to all platforms. + (or (eq 0 (coding-system-eol-type buffer-file-coding-system)) + (set-buffer-file-coding-system 'unix)) + (or (> (buffer-size) 0) + (error "Autoloads file %s lacks boilerplate" buffer-file-name)) + (or (file-writable-p buffer-file-name) + (error "Autoloads file %s is not writable" buffer-file-name)) + (widen) + (goto-char (point-min)) + ;; Look for the section for LOAD-NAME. + (while (and (not found) + (search-forward generate-autoload-section-header nil t)) + (let ((form (autoload-read-section-header))) + (cond ((string= (nth 2 form) load-name) + ;; We found the section for this file. + ;; Check if it is up to date. + (let ((begin (match-beginning 0)) + (last-time (nth 4 form)) + (file-time (file-attribute-modification-time + (file-attributes file)))) + (if (and (or (null existing-buffer) + (not (buffer-modified-p existing-buffer))) + (cond + ;; FIXME? Arguably we should throw a + ;; user error, or some kind of warning, + ;; if we were called from update-file-autoloads, + ;; which can update only a single input file. + ;; It's not appropriate to use the output + ;; file modtime in such a case, + ;; if there are multiple input files + ;; contributing to the output. + ((and output-time + (member last-time + (list t autoload--non-timestamp))) + (not (time-less-p output-time file-time))) + ;; last-time is the time-stamp (specifying + ;; the last time we looked at the file) and + ;; the file hasn't been changed since. + ((listp last-time) + (not (time-less-p last-time file-time))) + ;; last-time is an MD5 checksum instead. + ((stringp last-time) + (equal last-time + (md5 buf nil nil 'emacs-mule))))) + (throw 'up-to-date nil) + (autoload-remove-section begin) + (setq found t)))) + ((string< load-name (nth 2 form)) + ;; We've come to a section alphabetically later than + ;; LOAD-NAME. We assume the file is in order and so + ;; there must be no section for LOAD-NAME. We will + ;; insert one before the section here. + (goto-char (match-beginning 0)) + (setq found t))))) + (or found + (progn + ;; No later sections in the file. Put before the last page. + (goto-char (point-max)) + (search-backward "\f" nil t))) + (unless (memq (current-buffer) autoload-modified-buffers) + (push (current-buffer) autoload-modified-buffers)) + (current-buffer))))) + +(defun autoload-remove-section (begin) + (goto-char begin) + (search-forward generate-autoload-section-trailer) + (delete-region begin (point))) + +;;;###autoload +(defun update-directory-autoloads (&rest dirs) + "Update autoload definitions for Lisp files in the directories DIRS. +In an interactive call, you must give one argument, the name of a +single directory. In a call from Lisp, you can supply multiple +directories as separate arguments, but this usage is discouraged. + +The function does NOT recursively descend into subdirectories of the +directory or directories specified. + +In an interactive call, prompt for a default output file for the +autoload definitions. When called from Lisp, use the existing +value of `generated-autoload-file'. If any Lisp file binds +`generated-autoload-file' as a file-local variable, write its +autoloads into the specified file instead." + (declare (obsolete make-directory-autoloads "28.1")) + (interactive "DUpdate autoloads from directory: ") + (make-directory-autoloads + dirs + (if (called-interactively-p 'interactive) + (read-file-name "Write autoload definitions to file: ") + generated-autoload-file))) + +;;;###autoload +(defun make-directory-autoloads (dir output-file) + "Update autoload definitions for Lisp files in the directories DIRS. +DIR can be either a single directory or a list of +directories. (The latter usage is discouraged.) + +The autoloads will be written to OUTPUT-FILE. If any Lisp file +binds `generated-autoload-file' as a file-local variable, write +its autoloads into the specified file instead. + +The function does NOT recursively descend into subdirectories of the +directory or directories specified." + (interactive "DUpdate autoloads from directory: \nFWrite to file: ") + (let* ((files-re (let ((tmp nil)) + (dolist (suf (get-load-suffixes)) + ;; We don't use module-file-suffix below because + ;; we don't want to depend on whether Emacs was + ;; built with or without modules support, nor + ;; what is the suffix for the underlying OS. + (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf) + (push suf tmp))) + (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'"))) + (files (apply #'nconc + (mapcar (lambda (d) + (directory-files (expand-file-name d) + t files-re)) + (if (consp dir) dir (list dir))))) + (done ()) ;Files processed; to remove duplicates. + (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. + (no-autoloads nil) + ;; Ensure that we don't do odd things when putting the doc + ;; strings into the autoloads file. + (left-margin 0) + (autoload-modified-buffers nil) + (output-time + (and (file-exists-p output-file) + (file-attribute-modification-time + (file-attributes output-file))))) + + (with-current-buffer (autoload-find-generated-file output-file) + (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))) + + (goto-char (point-min)) + (while (search-forward generate-autoload-section-header nil t) + (let* ((form (autoload-read-section-header)) + (file (nth 3 form))) + (cond ((and (consp file) (stringp (car file))) + ;; This is a list of files that have no autoload cookies. + ;; There shouldn't be more than one such entry. + ;; Remove the obsolete section. + (autoload-remove-section (match-beginning 0)) + (setq last-time (nth 4 form)) + (if (member last-time (list t autoload--non-timestamp)) + (setq last-time output-time)) + (dolist (file file) + (let ((file-time (file-attribute-modification-time + (file-attributes file)))) + (when (and file-time + (not (time-less-p last-time file-time))) + ;; file unchanged + (push file no-autoloads) + (setq files (delete file files)))))) + ((not (stringp file))) + ((or (not (file-exists-p file)) + ;; Remove duplicates as well, just in case. + (member file done)) + ;; 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 + (list + t autoload--non-timestamp)) + output-time + oldtime)) + (file-attribute-modification-time + (file-attributes file)))) + ;; 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. + file (current-buffer) buffer-file-name) + (push file no-autoloads)))) + (push file done) + (setq files (delete file files))))) + ;; Elements remaining in FILES have no existing autoload sections yet. + (let ((no-autoloads-time (or last-time '(0 0 0 0))) + (progress (make-progress-reporter + (byte-compile-info + (concat "Scraping files for " + (file-relative-name output-file))) + 0 (length files) nil 10)) + (file-count 0) + file-time) + (dolist (file files) + (progress-reporter-update progress (setq file-count (1+ file-count))) + (cond + ;; Passing nil as second argument forces + ;; autoload-generate-file-autoloads to look for the right + ;; spot where to insert each autoloads section. + ((setq file-time + (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))) + (t (setq changed t)))) + (progress-reporter-done progress) + + (when no-autoloads + ;; Sort them for better readability. + (setq no-autoloads (sort no-autoloads 'string<)) + ;; Add the `no-autoloads' section. + (goto-char (point-max)) + (search-backward "\f" nil t) + (autoload-insert-section-header + (current-buffer) nil nil + ;; Filter out the other loaddefs files, because it makes + ;; the list unstable (and leads to spurious changes in + ;; ldefs-boot.el) since the loaddef files can be created in + ;; any order. + (seq-filter (lambda (file) + (not (string-match-p "[/-]loaddefs.el" file))) + no-autoloads) + (if autoload-timestamps + no-autoloads-time + autoload--non-timestamp)) + (insert generate-autoload-section-trailer))) + + ;; Don't modify the file if its content has not been changed, so `make' + ;; dependencies don't trigger unnecessarily. + (if (not changed) + (set-buffer-modified-p nil) + (autoload--save-buffer)) + + ;; In case autoload entries were added to other files because of + ;; file-local autoload-generated-file settings. + (autoload-save-buffers)))) + +(defun batch-update-autoloads--summary (strings) + (let ((message "")) + (while strings + (when (> (length (concat message " " (car strings))) 64) + (byte-compile-info (concat message " ...") t "SCRAPE") + (setq message "")) + (setq message (if (zerop (length message)) + (car strings) + (concat message " " (car strings)))) + (setq strings (cdr strings))) + (when (> (length message) 0) + (byte-compile-info message t "SCRAPE")))) + +;;;###autoload +(defun batch-update-autoloads () + "Update loaddefs.el autoloads in batch mode. +Calls `update-directory-autoloads' on the command line arguments. +Definitions are written to `generated-autoload-file' (which +should be non-nil)." + ;; For use during the Emacs build process only. + ;; Exclude those files that are preloaded on ALL platforms. + ;; These are the ones in loadup.el where "(load" is at the start + ;; of the line (crude, but it works). + (unless autoload-excludes + (let ((default-directory (file-name-directory generated-autoload-file)) + file) + (when (file-readable-p "loadup.el") + (with-temp-buffer + (insert-file-contents "loadup.el") + (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t) + (setq file (match-string 1)) + (or (string-match "\\.el\\'" file) + (setq file (format "%s.el" file))) + (or (string-match "\\`site-" file) + (push (expand-file-name file) autoload-excludes))))))) + (let ((args command-line-args-left)) + (batch-update-autoloads--summary args) + (setq command-line-args-left nil) + (make-directory-autoloads args generated-autoload-file))) + +(provide 'autoload) + +;;; autoload.el ends here -- cgit v1.2.3 From d73a104dd349fdf8de5ababa9ae53ea807b00bfb Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 4 Aug 2022 22:58:59 +0200 Subject: Be more lax when picking up prefixes for loaddefs * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--compute-prefixes): Allow tabs and spaces before symbol name, so that "(defvar\tfoo-bar nil)" is properly picked up. Before this change, such a definition would be wrongly picked up as the symbol "nil". --- lisp/emacs-lisp/loaddefs-gen.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 52ec5ef6809..afba9f8fbc7 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -456,7 +456,7 @@ don't include." (let ((prefs nil)) ;; Avoid (defvar ) by requiring a trailing space. (while (re-search-forward - "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) + "^(\\(def[^ \t]+\\)[ \t]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) (let ((name (match-string-no-properties 2))) (when (save-excursion -- cgit v1.2.3 From 900b09c0235d54d56ef5e88d04cca61bc71cbbb7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 5 Aug 2022 08:18:04 -0400 Subject: bytecomp.el: Further simplifications enabled by commit 59732a83c8875c * lisp/emacs-lisp/bytecomp.el (byte-compile-output-docform): Don't insert a \n before the #@ docstrings since make-docfile doesn't scan .elc files any more. --- lisp/emacs-lisp/bytecomp.el | 3 --- 1 file changed, 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7d2971502da..cc9cbd9da58 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2454,9 +2454,6 @@ list that represents a doc string reference. (and (>= (nth 1 info) 0) dynamic-docstrings (progn - ;; Make the doc string start at beginning of line - ;; for make-docfile's sake. - (insert "\n") (setq position (byte-compile-output-as-comment (nth (nth 1 info) form) nil)) -- cgit v1.2.3 From df263dd7586436b06262e32aa3614e11ed3a6182 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 5 Aug 2022 09:41:03 -0400 Subject: bytecomp.el: Update comments referring to `make-docfile` --- lisp/emacs-lisp/bytecomp.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index cc9cbd9da58..b1f4f01b3ae 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2404,8 +2404,8 @@ Call from the source buffer." (defun byte-compile-output-file-form (form) ;; Write the given form to the output buffer, being careful of docstrings - ;; in defvar, defvaralias, defconst, autoload and - ;; custom-declare-variable because make-docfile is so amazingly stupid. + ;; (for `byte-compile-dynamic-docstrings') in defvar, defvaralias, + ;; defconst, autoload, and custom-declare-variable. ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. @@ -2589,8 +2589,8 @@ list that represents a doc string reference. (t (byte-compile-keep-pending form))))) -;; Functions and variables with doc strings must be output separately, -;; so make-docfile can recognize them. Most other things can be output +;; Functions and variables with doc strings must be output specially, +;; for `byte-compile-dynamic-docstrings'. Most other things can be output ;; as byte-code. (put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload) @@ -4989,7 +4989,7 @@ binding slots have been popped." ;; ;; FIXME: we also use this hunk-handler to implement the function's ;; dynamic docstring feature (via byte-compile-file-form-defmumble). - ;; We should actually implement it (more elegantly) in + ;; We should probably actually implement it (more elegantly) in ;; byte-compile-lambda so it applies to all lambdas. We did it here ;; so the resulting .elc format was recognizable by make-docfile, ;; but since then we stopped using DOC for the docstrings of -- cgit v1.2.3 From eb7fe81e6db8d630521098a728713e10c9d59c74 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 5 Aug 2022 10:38:59 -0400 Subject: timer.el: Avoid repeated timers https://mail.gnu.org/archive/html/emacs-devel/2022-07/msg01127.html points out that end-users can get bitten by this, accidentally calling `timer-activate` on an already activated timer. * lisp/emacs-lisp/timer.el (timer--activate): Signal an error if we try to re-add a timer that's already on the timer-list. --- lisp/emacs-lisp/timer.el | 68 +++++++++++++++++++++++++++--------------------- 1 file changed, 39 insertions(+), 29 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index fd29abf40a3..aafb2e684f4 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -159,32 +159,42 @@ SECS may be a fraction." timer) (defun timer--activate (timer &optional triggered-p reuse-cell idle) - (if (and (timerp timer) - (integerp (timer--high-seconds timer)) - (integerp (timer--low-seconds timer)) - (integerp (timer--usecs timer)) - (integerp (timer--psecs timer)) - (timer--function timer)) - (let ((timers (if idle timer-idle-list timer-list)) - last) - ;; Skip all timers to trigger before the new one. - (while (and timers (timer--time-less-p (car timers) timer)) - (setq last timers - timers (cdr timers))) - (if reuse-cell - (progn - (setcar reuse-cell timer) - (setcdr reuse-cell timers)) - (setq reuse-cell (cons timer timers))) - ;; Insert new timer after last which possibly means in front of queue. - (setf (cond (last (cdr last)) - (idle timer-idle-list) - (t timer-list)) - reuse-cell) - (setf (timer--triggered timer) triggered-p) - (setf (timer--idle-delay timer) idle) - nil) - (error "Invalid or uninitialized timer"))) + (let ((timers (if idle timer-idle-list timer-list)) + last) + (cond + ((not (and (timerp timer) + (integerp (timer--high-seconds timer)) + (integerp (timer--low-seconds timer)) + (integerp (timer--usecs timer)) + (integerp (timer--psecs timer)) + (timer--function timer))) + (error "Invalid or uninitialized timer")) + ;; FIXME: This is not reliable because `idle-delay' is only set late, + ;; by `timer-activate-when-idle' :-( + ;;((not (eq (not idle) + ;; (not (timer--idle-delay timer)))) + ;; (error "idle arg %S out of sync with idle-delay field of timer: %S" + ;; idle timer)) + ((memq timer timers) + (error "Timer already activated")) + (t + ;; Skip all timers to trigger before the new one. + (while (and timers (timer--time-less-p (car timers) timer)) + (setq last timers + timers (cdr timers))) + (if reuse-cell + (progn + (setcar reuse-cell timer) + (setcdr reuse-cell timers)) + (setq reuse-cell (cons timer timers))) + ;; Insert new timer after last which possibly means in front of queue. + (setf (cond (last (cdr last)) + (idle timer-idle-list) + (t timer-list)) + reuse-cell) + (setf (timer--triggered timer) triggered-p) + (setf (timer--idle-delay timer) idle) + nil)))) (defun timer-activate (timer &optional triggered-p reuse-cell) "Insert TIMER into `timer-list'. @@ -216,7 +226,7 @@ the time of the current timer. That's because the activated timer will fire right away." (timer--activate timer (not dont-wait) reuse-cell 'idle)) -(defalias 'disable-timeout 'cancel-timer) +(defalias 'disable-timeout #'cancel-timer) (defun cancel-timer (timer) "Remove TIMER from the list of active timers." @@ -430,7 +440,7 @@ The action is to call FUNCTION with arguments ARGS. This function returns a timer object which you can use in `cancel-timer'." (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ") - (apply 'run-at-time secs repeat function args)) + (apply #'run-at-time secs repeat function args)) (defun add-timeout (secs function object &optional repeat) "Add a timer to run SECS seconds from now, to call FUNCTION on OBJECT. @@ -457,7 +467,7 @@ This function returns a timer object which you can use in `cancel-timer'." (interactive (list (read-from-minibuffer "Run after idle (seconds): " nil nil t) (y-or-n-p "Repeat each time Emacs is idle? ") - (intern (completing-read "Function: " obarray 'fboundp t)))) + (intern (completing-read "Function: " obarray #'fboundp t)))) (let ((timer (timer-create))) (timer-set-function timer function args) (timer-set-idle-time timer secs repeat) -- cgit v1.2.3 From 50730a8b04ede381c958600a1400efe8d04d9dfc Mon Sep 17 00:00:00 2001 From: Filipp Gunbin Date: Fri, 5 Aug 2022 21:01:10 +0300 Subject: Add variable end-of-defun-moves-to-eol * lisp/emacs-lisp/lisp.el (end-of-defun-moves-to-eol): New variable. (end-of-defun): Use it. --- lisp/emacs-lisp/lisp.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 4b85414943a..cc8185e4530 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -507,6 +507,13 @@ It is called with no argument, right after calling `beginning-of-defun-raw'. So the function can assume that point is at the beginning of the defun body. It should move point to the first position after the defun.") +(defvar end-of-defun-moves-to-eol t + "Defines whether `end-of-defun' moves to eol before doing +everything else. + +Set this to nil in major mode if this movement affects mode's +decisions about context in an unwanted way.") + (defun buffer-end (arg) "Return the \"far end\" position of the buffer, in direction ARG. If ARG is positive, that's the end of the buffer. @@ -538,7 +545,9 @@ report errors as appropriate for this kind of usage." (push-mark)) (if (or (null arg) (= arg 0)) (setq arg 1)) (let ((pos (point)) - (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))) + (beg (progn (when end-of-defun-moves-to-eol + (end-of-line 1)) + (beginning-of-defun-raw 1) (point))) (skip (lambda () ;; When comparing point against pos, we want to consider that ;; if point was right after the end of the function, it's -- cgit v1.2.3 From ea6c2e92958a10c7fd6b250f40fec66ac54a59ff Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 5 Aug 2022 20:17:23 +0200 Subject: Allow newline after def*-form for definition-prefix * lisp/emacs-lisp/loaddefs-gen.el (autoload-ignored-definitions): Add another semantic function. (loaddefs-generate--compute-prefixes): Allow newline after the "(def*" form. (Bug#57000) --- lisp/emacs-lisp/loaddefs-gen.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index afba9f8fbc7..8aa17be765e 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -68,6 +68,7 @@ be included.") "define-short-documentation-group" "def-edebug-elem-spec" "defvar-mode-local" + "defcustom-mode-local-semantic-dependency-system-include-path" "define-ibuffer-column" "define-ibuffer-sorter") "List of strings naming definitions to ignore for prefixes. @@ -456,7 +457,7 @@ don't include." (let ((prefs nil)) ;; Avoid (defvar ) by requiring a trailing space. (while (re-search-forward - "^(\\(def[^ \t]+\\)[ \t]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) + "^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t) (unless (member (match-string 1) autoload-ignored-definitions) (let ((name (match-string-no-properties 2))) (when (save-excursion -- cgit v1.2.3 From b70369c557efed3dcd86dc64a2e73e3480dea6af Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 5 Aug 2022 18:46:31 -0400 Subject: time-convert): Deprecate calls without an explicit FORM arg * lisp/subr.el (time-convert): Deprecate calls without an explicit FORM arg. * doc/lispref/os.texi (Time Conversion): Adjust doc accordingly. * lisp/calendar/time-date.el (days-to-time): * lisp/emacs-lisp/timer.el (timer-next-integral-multiple-of-time): * lisp/gnus/nnrss.el (nnrss-normalize-date): * lisp/epa-ks.el (epa-ks--parse-buffer): Silence corresponding warnings. --- doc/lispref/os.texi | 4 ++-- etc/NEWS | 4 ++++ lisp/calendar/time-date.el | 5 ++++- lisp/emacs-lisp/timer.el | 2 +- lisp/epa-ks.el | 6 ++---- lisp/gnus/nnrss.el | 4 ++-- lisp/subr.el | 1 + 7 files changed, 16 insertions(+), 10 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 5fb34fb9b66..d591b219cd0 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1541,7 +1541,7 @@ Year numbers count since the year 1 BCE, and do not skip zero as traditional Gregorian years do; for example, the year number @minus{}37 represents the Gregorian year 38 BCE@. -@defun time-convert time &optional form +@defun time-convert time form This function converts a time value into a Lisp timestamp. The optional @var{form} argument specifies the timestamp form to be @@ -1554,7 +1554,7 @@ representing the timestamp; for example, it is treated as 1000000000 if @var{time} is @code{nil} and the platform timestamp has nanosecond resolution. If @var{form} is @code{list}, this function returns an integer list @code{(@var{high} @var{low} @var{micro} @var{pico})}. -Although an omitted or @code{nil} @var{form} currently acts like +Although a @code{nil} @var{form} currently acts like @code{list}, this is planned to change in a future Emacs version, so callers requiring list timestamps should pass @code{list} explicitly. diff --git a/etc/NEWS b/etc/NEWS index 7145a8861eb..dc8bd6ce24b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2525,6 +2525,10 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el. * Lisp Changes in Emacs 29.1 +** The FORM arg of 'time-convert' is mandatory. +'time-convert' can still be called without it, as before, but the +compiler now emits a warning about this deprecated usage. + +++ ** Emacs now supports user-customizable and themable icons. These can be used for buttons in buffers and the like. See diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 7c99d05dc3f..b80b47a33fa 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -179,7 +179,10 @@ If DATE lacks timezone information, GMT is assumed." ;;;###autoload (defun days-to-time (days) "Convert DAYS into a time value." - (let ((time (time-convert (* 86400 days)))) + ;; FIXME: We should likely just pass `t' to `time-convert'. + ;; All uses I could find in Emacs, GNU ELPA, and NonGNU ELPA can handle + ;; any valid time representation as return value. + (let ((time (time-convert (* 86400 days) 'list))) ;; Traditionally, this returned a two-element list if DAYS was an integer. ;; Keep that tradition if time-convert outputs timestamps in list form. (if (and (integerp days) (consp (cdr time))) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index aafb2e684f4..b25a040a96c 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -122,7 +122,7 @@ of SECS seconds since the epoch. SECS may be a fraction." (setq ticks (ash ticks 1)) (setq hz (ash hz 1))) (let ((more-ticks (+ ticks trunc-s-ticks))) - (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz))))) + (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz) t)))) (defun timer-relative-time (time secs &optional usecs psecs) "Advance TIME by SECS seconds. diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index f41429f7734..7c60b659f0a 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -295,13 +295,11 @@ enough, since keyservers have strict timeout settings." :created (and (match-string 4) (not (string-empty-p (match-string 4))) - (time-convert - (string-to-number (match-string 4)))) + (time-convert (string-to-number (match-string 4)) t)) :expires (and (match-string 5) (not (string-empty-p (match-string 5))) - (time-convert - (string-to-number (match-string 5)))) + (time-convert (string-to-number (match-string 5)) t)) :flags (mapcar (lambda (flag) (cdr (assq flag '((?r revoked) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 5047be1a6a5..8c96d3e0678 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -453,8 +453,8 @@ which RSS 2.0 allows." (let (case-fold-search vector year month day time zone given) (cond ((null date)) ; do nothing for this case ;; if the date is just digits (unix time stamp): - ((string-match "^[0-9]+$" date) - (setq given (time-convert (string-to-number date)))) + ((string-match "\\`[0-9]+\\'" date) + (setq given (time-convert (string-to-number date) t))) ;; RFC 822 ((string-match " [0-9]+ " date) (setq vector (timezone-parse-date date) diff --git a/lisp/subr.el b/lisp/subr.el index 2603b5ad251..4b1fc832da1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1857,6 +1857,7 @@ be a list of the form returned by `event-start' and `event-end'." (set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") (set-advertised-calling-convention 'libxml-parse-xml-region '(start end &optional base-url) "27.1") (set-advertised-calling-convention 'libxml-parse-html-region '(start end &optional base-url) "27.1") +(set-advertised-calling-convention 'time-convert '(time form) "29.1") ;;;; Obsolescence declarations for variables, and aliases. -- cgit v1.2.3 From 564571f712fcf0ffcb93eeca67f7716263c9def5 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 6 Aug 2022 09:40:07 +0300 Subject: ; * lisp/emacs-lisp/lisp.el (end-of-defun-moves-to-eol): Doc fix. --- lisp/emacs-lisp/lisp.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index cc8185e4530..acae1a0b0a9 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -508,11 +508,9 @@ So the function can assume that point is at the beginning of the defun body. It should move point to the first position after the defun.") (defvar end-of-defun-moves-to-eol t - "Defines whether `end-of-defun' moves to eol before doing -everything else. - -Set this to nil in major mode if this movement affects mode's -decisions about context in an unwanted way.") + "Whether `end-of-defun' moves to eol before doing anything else. +Set this to nil if this movement adversely affects the buffer's +major mode's decisions about context.") (defun buffer-end (arg) "Return the \"far end\" position of the buffer, in direction ARG. -- cgit v1.2.3 From 08a74ab05a2dcca261fe6adaa839a936b5c123c0 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Aug 2022 10:52:16 +0200 Subject: Cease emitting negative file offsets for user variables 'User variables' were made obsolete in Emacs 24 along with user-variable-p; the sign of the position in (#$ . POS) hasn't mattered since. * lisp/emacs-lisp/bytecomp.el (byte-compile-output-docform): Don't emit negative position when doc string starts with `*`. * src/lread.c (get_lazy_string): Explain. --- lisp/emacs-lisp/bytecomp.el | 15 +++------------ src/lread.c | 4 +++- 2 files changed, 6 insertions(+), 13 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b1f4f01b3ae..d8a5dd20f6c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2451,18 +2451,9 @@ list that represents a doc string reference. (let (position (print-symbols-bare t)) ; Possibly redundant binding. ;; Insert the doc string, and make it a comment with #@LENGTH. - (and (>= (nth 1 info) 0) - dynamic-docstrings - (progn - (setq position - (byte-compile-output-as-comment - (nth (nth 1 info) form) nil)) - ;; If the doc string starts with * (a user variable), - ;; negate POSITION. - (if (and (stringp (nth (nth 1 info) form)) - (> (length (nth (nth 1 info) form)) 0) - (eq (aref (nth (nth 1 info) form) 0) ?*)) - (setq position (- position))))) + (when (and (>= (nth 1 info) 0) dynamic-docstrings) + (setq position (byte-compile-output-as-comment + (nth (nth 1 info) form) nil))) (let ((print-continuous-numbering t) print-number-table diff --git a/src/lread.c b/src/lread.c index d16df32ca3e..ccccd79cd7c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3486,7 +3486,9 @@ get_lazy_string (Lisp_Object val) unibyte string. If it is actually a doc string, caller must make it multibyte. */ - /* Position is negative for user variables. */ + /* We used to emit negative positions for 'user variables' (whose doc + strings started with an asterisk); take the absolute value for + compatibility. */ EMACS_INT pos = eabs (XFIXNUM (XCDR (val))); struct saved_string *ss = &saved_strings[0]; struct saved_string *ssend = ss + ARRAYELTS (saved_strings); -- cgit v1.2.3 From c3e99a870aa26d6d7d64b7fa9f5a8e990089638e Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 7 Aug 2022 17:18:21 +0200 Subject: ; * lisp/emacs-lisp/bytecomp.el: indentation fix --- lisp/emacs-lisp/bytecomp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d8a5dd20f6c..9d5f6682b5a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2452,8 +2452,8 @@ list that represents a doc string reference. (print-symbols-bare t)) ; Possibly redundant binding. ;; Insert the doc string, and make it a comment with #@LENGTH. (when (and (>= (nth 1 info) 0) dynamic-docstrings) - (setq position (byte-compile-output-as-comment - (nth (nth 1 info) form) nil))) + (setq position (byte-compile-output-as-comment + (nth (nth 1 info) form) nil))) (let ((print-continuous-numbering t) print-number-table -- cgit v1.2.3 From 3d7d8ddc5ac73ebeb4aff9e672e649c8352beeb2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 8 Aug 2022 14:08:47 +0200 Subject: ; Fix typos --- doc/lispref/commands.texi | 2 +- doc/misc/modus-themes.org | 4 ++-- etc/themes/modus-themes.el | 2 +- lisp/ChangeLog.12 | 2 +- lisp/emacs-lisp/warnings.el | 2 +- lisp/help-fns.el | 2 +- lisp/x-dnd.el | 2 +- src/xterm.c | 6 +++--- test/lisp/erc/resources/erc-scenarios-common.el | 4 ++-- test/lisp/net/tramp-tests.el | 2 +- 10 files changed, 14 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index a8ce294ad9a..26739bf5b8d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2704,7 +2704,7 @@ Return the timestamp in @var{position}. This is the time at which the event occurred, in milliseconds. Such a timestamp is reported relative to an arbitrary starting time that varies according to the window system in use. On the X Window System, for example, it is the -number of miliseconds since the X server was started. +number of milliseconds since the X server was started. @end defun These functions compute a position list given particular buffer diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index a80bf6be8a6..ddd9595fc89 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -1253,7 +1253,7 @@ accepts is as follows (order is not significant): The ~popup~ key takes the same values as ~selection~. -Apart from specfying each key separately, a fallback list is accepted. +Apart from specifying each key separately, a fallback list is accepted. This is only useful when the desired aesthetic is the same across all keys that are not explicitly referenced. For example, this: @@ -3639,7 +3639,7 @@ it if you plan to control face attributes. :end: #+cindex: Org custom emphasis faces -Org provides the user option ~org-emphasis-alist~ which assosiates a +Org provides the user option ~org-emphasis-alist~ which associates a character with a face, list of faces, or face attributes. The default specification of that variable looks like this: diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 54e5e465b1f..e64a11b74f5 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -2270,7 +2270,7 @@ follows (order is not significant): The `popup' key takes the same values as `selection'. -Apart from specfying each key separately, a fallback list is +Apart from specifying each key separately, a fallback list is accepted. This is only useful when the desired aesthetic is the same across all keys that are not explicitly referenced. For example, this: diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index c45c8ae7351..a89e5155106 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -14359,7 +14359,7 @@ * ldefs-boot.el: Likewise. * textmodes/bibtex.el (bibtex-validate-globally): Fix typo in a - message text: "Duplicat" => "Duplicate". + message text. 2006-01-06 Sven Joachim (tiny change) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 516fdeb10ea..d60eedbc9cd 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -209,7 +209,7 @@ SUPPRESS-LIST is the list of kinds of warnings to suppress." (text " stop ")) "Suppress warnings." :version "29.1" - :help-echo "Click to supress this warning type") + :help-echo "Click to suppress this warning type") (defun warnings-suppress (type) (pcase (car diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 768023b54c2..59a509b2215 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -799,7 +799,7 @@ the C sources, too." ;; different purposes, such as function name, var name, face name, ;; property name, ...). (concat - ;; The main "canonical" occurence of symbols is within '...'. + ;; The main "canonical" occurrence of symbols is within '...'. "'" quoted "'" ;; Commands can also occur as `M-x blabla'. "\\|M-x[ \t\n]+" quoted "\\_>" diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index bdfe444bc1d..2bda67fe3f3 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -1480,7 +1480,7 @@ instead of returning \"E\".") (error '(STRING . "E"))))))) (defun x-dnd-handle-octet-stream (_selection _type _value) - "Handle a selecton request for `application/octet-stream'. + "Handle a selection request for `application/octet-stream'. Return the contents of the XDS file." (cons 'application/octet-stream (ignore-errors diff --git a/src/xterm.c b/src/xterm.c index 23a35aa1618..36797bc0abb 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6837,7 +6837,7 @@ x_sync_trigger_fence (struct frame *f, XSyncValue value) idx = (n / 4) % 2; #ifdef FRAME_DEBUG - fprintf (stderr, "Triggering synchonization fence: %lu\n", idx); + fprintf (stderr, "Triggering synchronization fence: %lu\n", idx); #endif XSyncTriggerFence (FRAME_X_DISPLAY (f), @@ -18928,7 +18928,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { /* Now clear dpyinfo->last_mouse_motion_frame, or gui_redo_mouse_highlight will end up highlighting the - last known poisition of the mouse if a tooltip frame is + last known position of the mouse if a tooltip frame is later unmapped. */ if (f == dpyinfo->last_mouse_motion_frame) @@ -20397,7 +20397,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { /* Now clear dpyinfo->last_mouse_motion_frame, or gui_redo_mouse_highlight will end up highlighting - the last known poisition of the mouse if a + the last known position of the mouse if a tooltip frame is later unmapped. */ if (f == dpyinfo->last_mouse_motion_frame) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index cbabfcd26be..bc2cb68cd86 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -142,10 +142,10 @@ Dialog resource directories are located by expanding the variable (declare (indent 1)) (let* ((orig-autojoin-mode (make-symbol "orig-autojoin-mode")) - (combind `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode)) + (combined `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode)) ,@(erc-scenarios-common--make-bindings bindings)))) - `(erc-d-t-with-cleanup (,@combind) + `(erc-d-t-with-cleanup (,@combined) (ert-info ("Restore autojoin, etc., kill ERC buffers") (dolist (buf (buffer-list)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e2cafc240b9..a3e80e89562 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2481,7 +2481,7 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) - ;; Write empty string. Used for creation of temprorary files. + ;; Write empty string. Used for creation of temporary files. ;; Since Emacs 27.1. (when (fboundp 'make-empty-file) (with-no-warnings -- cgit v1.2.3 From 55cc8b040b0e3c5f97fd1386d1e9c5a120be6340 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Aug 2022 14:31:54 +0200 Subject: Make which-func-mode output less junk * lisp/emacs-lisp/lisp-mode.el (lisp-current-defun-name): Use edebug specs to find the name (if they exist), and default to returning the top-level symbol if there isn't a define-like form (bug#49592). --- lisp/emacs-lisp/lisp-mode.el | 64 +++++++++++++++++++++++---------- lisp/progmodes/which-func.el | 3 ++ test/lisp/emacs-lisp/lisp-mode-tests.el | 23 ++++++++++++ 3 files changed, 72 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c906ee6e31d..2e7f019aa9e 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -728,30 +728,58 @@ font-lock keywords will not be case sensitive." len)))) (defun lisp-current-defun-name () - "Return the name of the defun at point, or nil." + "Return the name of the defun at point. +If there is no defun at point, return the first symbol from the +top-level form. If there is no top-level form, return nil. + +(\"defun\" here means \"form that defines something\", and is +decided heuristically.)" (save-excursion - (let ((location (point))) + (let ((location (point)) + name) ;; If we are now precisely at the beginning of a defun, make sure ;; beginning-of-defun finds that one rather than the previous one. - (or (eobp) (forward-char 1)) + (unless (eobp) + (forward-char 1)) (beginning-of-defun) ;; Make sure we are really inside the defun found, not after it. - (when (and (looking-at "\\s(") - (progn (end-of-defun) - (< location (point))) - (progn (forward-sexp -1) - (>= location (point)))) - (if (looking-at "\\s(") - (forward-char 1)) - ;; Skip the defining construct name, typically "defun" or + (when (and (looking-at "(") + (progn + (end-of-defun) + (< location (point))) + (progn + (forward-sexp -1) + (>= location (point)))) + (when (looking-at "(") + (forward-char 1)) + ;; Read the defining construct name, typically "defun" or ;; "defvar". - (forward-sexp 1) - ;; The second element is usually a symbol being defined. If it - ;; is not, use the first symbol in it. - (skip-chars-forward " \t\n'(") - (buffer-substring-no-properties (point) - (progn (forward-sexp 1) - (point))))))) + (let ((symbol (ignore-errors (read (current-buffer))))) + (when (and symbol (not (symbolp symbol))) + (setq symbol nil)) + ;; If there's an edebug spec, use that to determine what the + ;; name is. + (when symbol + (let ((spec (get symbol 'edebug-form-spec))) + (save-excursion + (when (and (eq (car spec) '&define) + (memq 'name spec)) + (pop spec) + (while (and spec (not name)) + (let ((candidate (ignore-errors (read (current-buffer))))) + (when (eq (pop spec) 'name) + (setq name candidate + spec nil)))))))) + ;; We didn't have an edebug spec (or couldn't find the + ;; name). If the symbol starts with \"def\", then it's + ;; likely that the next symbol is the name. + (when (and (not name) + (string-match-p "\\`def" (symbol-name symbol))) + (when-let ((candidate (ignore-errors (read (current-buffer))))) + (when (symbolp candidate) + (setq name candidate)))) + (when-let ((result (or name symbol))) + (symbol-name result))))))) (defvar-keymap lisp-mode-shared-map :doc "Keymap for commands shared by all sorts of Lisp modes." diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 2e8e8d23192..4fe4edc1648 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -61,6 +61,9 @@ ;;; Code: +;; So that we can use the edebug spec in `lisp-current-defun-name'. +(require 'edebug) + ;; Variables for customization ;; --------------------------- ;; diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index fd1af75ba3f..d3e78aa1d7e 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -330,5 +330,28 @@ Expected initialization file: `%s'\" (faceup-clean-buffer) (should (faceup-test-font-lock-buffer 'emacs-lisp-mode faceup))))) +(ert-deftest test-lisp-current-defun-name () + (require 'edebug) + (with-temp-buffer + (emacs-lisp-mode) + (insert "(defun foo ()\n'bar)\n") + (goto-char 5) + (should (equal (lisp-current-defun-name) "foo"))) + (with-temp-buffer + (emacs-lisp-mode) + (insert "(define-flabbergast-test zot ()\n'bar)\n") + (goto-char 5) + (should (equal (lisp-current-defun-name) "zot"))) + (with-temp-buffer + (emacs-lisp-mode) + (insert "(progn\n ;; comment\n ;; about that\n (define-key ...)\n )") + (goto-char 5) + (should (equal (lisp-current-defun-name) "progn"))) + (with-temp-buffer + (emacs-lisp-mode) + (insert "(defblarg \"a\" 'b)") + (goto-char 5) + (should (equal (lisp-current-defun-name) "defblarg")))) + (provide 'lisp-mode-tests) ;;; lisp-mode-tests.el ends here -- cgit v1.2.3 From ffc81ebc4b5d6cfc827e6a08679da55134f73fb5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Aug 2022 15:52:19 +0200 Subject: Allow specifying how args are to be stored in `command-history' * doc/lispref/functions.texi (Declare Form): Document `interactive-args' * lisp/replace.el (replace-string): Store the correct interactive arguments (bug#45607). * lisp/emacs-lisp/byte-run.el (byte-run--set-interactive-args): New function. (defun-declarations-alist): Use it. * src/callint.c (fix_command): Remove the old hack (which now longer works since interactive specs are byte-compiled) and instead rely on `interactive-args'. --- doc/lispref/functions.texi | 4 ++ lisp/emacs-lisp/byte-run.el | 17 ++++++- lisp/replace.el | 5 +- src/callint.c | 113 ++++++++++++++------------------------------ test/src/callint-tests.el | 13 +++++ 5 files changed, 73 insertions(+), 79 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 8e8cc5fd9c0..8265e58210e 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2498,6 +2498,10 @@ the current buffer. Specify that this command is meant to be applicable for @var{modes} only. +@item (interactive-args @var{arg} ...) +Specify the arguments that should be stored for @code{repeat-command}. +Each @var{arg} is on the form @code{@var{argument-name} @var{form}}. + @item (pure @var{val}) If @var{val} is non-@code{nil}, this function is @dfn{pure} (@pxref{What Is a Function}). This is the same as the @code{pure} diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 9370bd3a097..4a2860cd43d 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -236,6 +236,20 @@ The return value of this function is not used." (list 'function-put (list 'quote f) ''command-modes (list 'quote val)))) +(defalias 'byte-run--set-interactive-args + #'(lambda (f args &rest val) + (setq args (remove '&optional (remove '&rest args))) + (list 'function-put (list 'quote f) + ''interactive-args + (list + 'quote + (mapcar + (lambda (elem) + (cons + (seq-position args (car elem)) + (cadr elem))) + val))))) + ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist (list @@ -255,7 +269,8 @@ If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'indent #'byte-run--set-indent) (list 'speed #'byte-run--set-speed) (list 'completion #'byte-run--set-completion) - (list 'modes #'byte-run--set-modes)) + (list 'modes #'byte-run--set-modes) + (list 'interactive-args #'byte-run--set-interactive-args)) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration, diff --git a/lisp/replace.el b/lisp/replace.el index ab9ac17ed9c..cac0edf43ac 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -664,7 +664,10 @@ which will run faster and will not set the mark or print anything. \(You may need a more complex loop if FROM-STRING can match the null string and TO-STRING is also null.)" (declare (interactive-only - "use `search-forward' and `replace-match' instead.")) + "use `search-forward' and `replace-match' instead.") + (interactive-args + (start (if (use-region-p) (region-beginning))) + (end (if (use-region-p) (region-end))))) (interactive (let ((common (query-replace-read-args diff --git a/src/callint.c b/src/callint.c index ffa3b231eb5..dfc479284c0 100644 --- a/src/callint.c +++ b/src/callint.c @@ -161,10 +161,8 @@ check_mark (bool for_region) xsignal0 (Qmark_inactive); } -/* If the list of args INPUT was produced with an explicit call to - `list', look for elements that were computed with - (region-beginning) or (region-end), and put those expressions into - VALUES instead of the present values. +/* If FUNCTION has an `interactive-args' spec, replace relevant + elements in VALUES with those forms instead. This function doesn't return a value because it modifies elements of VALUES to do its job. */ @@ -172,62 +170,24 @@ check_mark (bool for_region) static void fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values) { - /* FIXME: Instead of this ugly hack, we should provide a way for an - interactive spec to return an expression/function that will re-build the - args without user intervention. */ - if (CONSP (input)) + /* Quick exit if there's no values to alter. */ + if (!CONSP (values)) + return; + + Lisp_Object reps = Fget (function, Qinteractive_args); + + if (!NILP (reps) && CONSP (reps)) { - Lisp_Object car; + int i = 0; + Lisp_Object vals = values; - car = XCAR (input); - /* Skip through certain special forms. */ - while (EQ (car, Qlet) || EQ (car, Qletx) - || EQ (car, Qsave_excursion) - || EQ (car, Qprogn)) + while (!NILP (vals)) { - while (CONSP (XCDR (input))) - input = XCDR (input); - input = XCAR (input); - if (!CONSP (input)) - break; - car = XCAR (input); - } - if (EQ (car, Qlist)) - { - Lisp_Object intail, valtail; - for (intail = Fcdr (input), valtail = values; - CONSP (valtail); - intail = Fcdr (intail), valtail = XCDR (valtail)) - { - Lisp_Object elt; - elt = Fcar (intail); - if (CONSP (elt)) - { - Lisp_Object presflag, carelt; - carelt = XCAR (elt); - /* If it is (if X Y), look at Y. */ - if (EQ (carelt, Qif) - && NILP (Fnthcdr (make_fixnum (3), elt))) - elt = Fnth (make_fixnum (2), elt); - /* If it is (when ... Y), look at Y. */ - else if (EQ (carelt, Qwhen)) - { - while (CONSP (XCDR (elt))) - elt = XCDR (elt); - elt = Fcar (elt); - } - - /* If the function call we're looking at - is a special preserved one, copy the - whole expression for this argument. */ - if (CONSP (elt)) - { - presflag = Fmemq (Fcar (elt), preserved_fns); - if (!NILP (presflag)) - Fsetcar (valtail, Fcar (intail)); - } - } - } + Lisp_Object rep = Fassq (make_fixnum (i), reps); + if (!NILP (rep)) + Fsetcar (vals, XCDR (rep)); + vals = XCDR (vals); + ++i; } } @@ -235,31 +195,28 @@ fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values) optional, remove them from the list. This makes navigating the history less confusing, since it doesn't contain a lot of parameters that aren't used. */ - if (CONSP (values)) + Lisp_Object arity = Ffunc_arity (function); + /* We don't want to do this simplification if we have an &rest + function, because (cl-defun foo (a &optional (b 'zot)) ..) + etc. */ + if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity))) { - Lisp_Object arity = Ffunc_arity (function); - /* We don't want to do this simplification if we have an &rest - function, because (cl-defun foo (a &optional (b 'zot)) ..) - etc. */ - if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity))) + Lisp_Object final = Qnil; + ptrdiff_t final_i = 0, i = 0; + for (Lisp_Object tail = values; + CONSP (tail); + tail = XCDR (tail), ++i) { - Lisp_Object final = Qnil; - ptrdiff_t final_i = 0, i = 0; - for (Lisp_Object tail = values; - CONSP (tail); - tail = XCDR (tail), ++i) + if (!NILP (XCAR (tail))) { - if (!NILP (XCAR (tail))) - { - final = tail; - final_i = i; - } + final = tail; + final_i = i; } - - /* Chop the trailing optional values. */ - if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1) - XSETCDR (final, Qnil); } + + /* Chop the trailing optional values. */ + if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1) + XSETCDR (final, Qnil); } } @@ -950,4 +907,6 @@ use `event-start', `event-end', and `event-click-count'. */); defsubr (&Scall_interactively); defsubr (&Sfuncall_interactively); defsubr (&Sprefix_numeric_value); + + DEFSYM (Qinteractive_args, "interactive-args"); } diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el index d964fc3c1f3..5a633fdc2bd 100644 --- a/test/src/callint-tests.el +++ b/test/src/callint-tests.el @@ -52,4 +52,17 @@ (call-interactively #'ignore t)) (should (= (length command-history) history-length)))) +(defun callint-test-int-args (foo bar &optional zot) + (declare (interactive-args + (bar 10) + (zot 11))) + (interactive (list 1 1 1)) + (+ foo bar zot)) + +(ert-deftest test-interactive-args () + (let ((history-length 1) + (command-history ())) + (should (= (call-interactively 'callint-test-int-args t) 3)) + (should (equal command-history '((callint-test-int-args 1 10 11)))))) + ;;; callint-tests.el ends here -- cgit v1.2.3 From 909931cb9ad7251393a81076e9020225fe82845e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Aug 2022 15:52:53 +0200 Subject: Further lisp-current-defun-name tweaks * lisp/emacs-lisp/lisp-mode.el (lisp-current-defun-name): Further tweaks to finding the symbol being defined (defalias). --- lisp/emacs-lisp/lisp-mode.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 2e7f019aa9e..82afa31ef12 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -776,8 +776,12 @@ decided heuristically.)" (when (and (not name) (string-match-p "\\`def" (symbol-name symbol))) (when-let ((candidate (ignore-errors (read (current-buffer))))) - (when (symbolp candidate) - (setq name candidate)))) + (cond + ((symbolp candidate) + (setq name candidate)) + ((and (consp candidate) + (symbolp (car (delete 'quote candidate)))) + (setq name (car (delete 'quote candidate))))))) (when-let ((result (or name symbol))) (symbol-name result))))))) -- cgit v1.2.3 From fe4fd160a20e2935b9a6aba4dc5dfbb5e26fdfe1 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Tue, 9 Aug 2022 03:55:14 +0200 Subject: Another lisp-current-defun-name tweak * lisp/emacs-lisp/lisp-mode.el (lisp-current-defun-name): Avoid error when edebug spec is the symbol t. --- lisp/emacs-lisp/lisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 82afa31ef12..1bc2c0ece6d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -762,7 +762,7 @@ decided heuristically.)" (when symbol (let ((spec (get symbol 'edebug-form-spec))) (save-excursion - (when (and (eq (car spec) '&define) + (when (and (eq (car-safe spec) '&define) (memq 'name spec)) (pop spec) (while (and spec (not name)) -- cgit v1.2.3 From ee201bc77b37181bbb4378f360ee8dc94c231676 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Aug 2022 16:36:41 +0200 Subject: Make the loaddefs.el file slightly shorter * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--shorten-autoload): New function. (loaddefs-generate--make-autoload): Use it to drop optional nil values from the `autoloads' forms. This makes the loaddefs.el file about 12K shorter. --- lisp/emacs-lisp/loaddefs-gen.el | 46 +++++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 8aa17be765e..3b329357ad9 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -127,6 +127,15 @@ scanning for autoloads and will be in the `load-path'." (substring name 0 (match-beginning 0)) name))) +(defun loaddefs-generate--shorten-autoload (form) + "Remove optional nil elements from an `autoload' form." + (take (max (- (length form) + (seq-position (reverse form) nil + (lambda (e1 e2) + (not (eq e1 e2))))) + 3) + form)) + (defun loaddefs-generate--make-autoload (form file &optional expansion) "Turn FORM into an autoload or defvar for source file FILE. Returns nil if FORM is not a special autoload form (i.e. a function definition @@ -165,8 +174,8 @@ expression, in which case we want to handle forms differently." ;; Add the usage form at the end where describe-function-1 ;; can recover it. (when (consp args) (setq doc (help-add-fundoc-usage doc args))) - ;; (message "autoload of %S" (nth 1 form)) - `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))) + (loaddefs-generate--shorten-autoload + `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))) ((and expansion (memq car '(progn prog1))) (let ((end (memq :autoload-end form))) @@ -220,22 +229,23 @@ expression, in which case we want to handle forms differently." ;; can recover it. (when (listp args) (setq doc (help-add-fundoc-usage doc args))) ;; `define-generic-mode' quotes the name, so take care of that - `(autoload ,(if (listp name) name (list 'quote name)) - ,file ,doc - ,(or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) - t) - (and (eq (car-safe (car body)) 'interactive) - ;; List of modes or just t. - (or (if (nthcdr 1 (car body)) - (list 'quote (nthcdr 1 (car body))) - t)))) - ,(if macrop ''macro nil)))) + (loaddefs-generate--shorten-autoload + `(autoload ,(if (listp name) name (list 'quote name)) + ,file ,doc + ,(or (and (memq car '(define-skeleton define-derived-mode + define-generic-mode + easy-mmode-define-global-mode + define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode + define-minor-mode)) + t) + (and (eq (car-safe (car body)) 'interactive) + ;; List of modes or just t. + (or (if (nthcdr 1 (car body)) + (list 'quote (nthcdr 1 (car body))) + t)))) + ,(if macrop ''macro nil))))) ;; For defclass forms, use `eieio-defclass-autoload'. ((eq car 'defclass) -- cgit v1.2.3 From 5269842833471c960352ced3c60ce2329660b8cf Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Aug 2022 19:18:55 +0200 Subject: Add a faster seq-uniq for lists * lisp/emacs-lisp/seq.el (seq-uniq): Add a faster method for lists (bug#57079). --- lisp/emacs-lisp/seq.el | 17 +++++++++++++++++ test/lisp/emacs-lisp/seq-tests.el | 13 +++++++++++++ 2 files changed, 30 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 1b8d86563a1..6ddd8de6e8d 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -455,6 +455,23 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (setq result (cons elt result)))) (nreverse result))) +(cl-defmethod seq-uniq ((sequence list) &optional testfn) + (let ((result nil)) + (if (not testfn) + ;; Fast path. + (while sequence + (unless (member (car sequence) result) + (push (car sequence) result)) + (pop sequence)) + ;; Slower path. + (while sequence + (unless (seq-find (lambda (elem) + (funcall testfn elem (car sequence))) + result) + (push (car sequence) result)) + (pop sequence))) + (nreverse result))) + (cl-defgeneric seq-mapcat (function sequence &optional type) "Concatenate the result of applying FUNCTION to each element of SEQUENCE. The result is a sequence of type TYPE, or a list if TYPE is nil." diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 3b22e42df24..a655377e6cc 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -559,5 +559,18 @@ Evaluate BODY for each created sequence. (should (equal (seq-split seq 3) '("012" "345" "678" "9"))))) +(ert-deftest test-seq-uniq-list () + (let ((list '(1 2 3))) + (should (equal (seq-uniq (append list list)) '(1 2 3)))) + (let ((list '(1 2 3 2 1))) + (should (equal (seq-uniq list) '(1 2 3)))) + (let ((list (list (substring "1") + (substring "2") + (substring "3") + (substring "2") + (substring "1")))) + (should (equal (seq-uniq list) '("1" "2" "3"))) + (should (equal (seq-uniq list #'eq) '("1" "2" "3" "2" "1"))))) + (provide 'seq-tests) ;;; seq-tests.el ends here -- cgit v1.2.3 From b2bf91003db3bc2171c566ed710ec34d4a55c064 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Aug 2022 19:19:29 +0200 Subject: Further lisp-current-defun-name tweaks * lisp/emacs-lisp/lisp-mode.el (lisp-current-defun-name): Tweak so that cl-defmethod and friends work again. --- lisp/emacs-lisp/lisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1bc2c0ece6d..c31fbec640c 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -774,7 +774,7 @@ decided heuristically.)" ;; name). If the symbol starts with \"def\", then it's ;; likely that the next symbol is the name. (when (and (not name) - (string-match-p "\\`def" (symbol-name symbol))) + (string-match-p "\\(\\`\\|-\\)def" (symbol-name symbol))) (when-let ((candidate (ignore-errors (read (current-buffer))))) (cond ((symbolp candidate) -- cgit v1.2.3 From 581fa3d958c064e05a8f980472880f153aba30a6 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 9 Aug 2022 19:49:40 +0200 Subject: Autoload string-blank-p * lisp/eshell/em-hist.el (subr-x): * lisp/net/eudc.el (subr-x): Don't require. * lisp/emacs-lisp/subr-x.el (string-blank-p): Autoload. --- lisp/emacs-lisp/subr-x.el | 1 + lisp/eshell/em-hist.el | 1 - lisp/net/eudc.el | 1 - 3 files changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index d5d7bfeb6f5..b7083bfe7cc 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -118,6 +118,7 @@ the resulting string may be longer than the original if LENGTH is (concat "..." (substring string (min (1- strlen) (max 0 (- strlen length)))))))) +;;;###autoload (defsubst string-blank-p (string) "Check whether STRING is either empty or only whitespace. The following characters count as whitespace here: space, tab, newline and diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 1877749c5cf..1db239b9f72 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -55,7 +55,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(eval-when-compile (require 'subr-x)) ; `string-blank-p' (require 'ring) (require 'esh-opt) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 5cfd4e25ec0..eb440ba6144 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -48,7 +48,6 @@ (require 'wid-edit) (require 'cl-lib) (require 'eudc-vars) -(eval-when-compile (require 'subr-x)) ;;{{{ Internal cooking -- cgit v1.2.3 From f002fa8bfc3a217fdce0d54c6b92220d9c8ad6f4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 10 Aug 2022 11:27:14 +0200 Subject: Delete dead code in checkdoc.el * lisp/emacs-lisp/checkdoc.el: Delete code commented out since 1997. --- lisp/emacs-lisp/checkdoc.el | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index ac589b82f83..04ead562f2f 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1,6 +1,6 @@ ;;; checkdoc.el --- check documentation strings for style requirements -*- lexical-binding:t -*- -;; Copyright (C) 1997-1998, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1997-2022 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Old-Version: 0.6.2 @@ -1357,23 +1357,6 @@ checking of documentation strings. checkdoc-common-verbs-wrong-voice "\\|") "\\)\\>")))) -;; Profiler says this is not yet faster than just calling assoc -;;(defun checkdoc-word-in-alist-vector (word vector) -;; "Check to see if WORD is in the car of an element of VECTOR. -;;VECTOR must be sorted. The CDR should be a replacement. Since the -;;word list is getting bigger, it is time for a quick bisecting search." -;; (let ((max (length vector)) (min 0) i -;; (found nil) (fw nil)) -;; (setq i (/ max 2)) -;; (while (and (not found) (/= min max)) -;; (setq fw (car (aref vector i))) -;; (cond ((string= word fw) (setq found (cdr (aref vector i)))) -;; ((string< word fw) (setq max i)) -;; (t (setq min i))) -;; (setq i (/ (+ max min) 2)) -;; ) -;; found)) - ;;; Checking engines ;; (defun checkdoc-this-string-valid (&optional take-notes) @@ -2860,8 +2843,6 @@ function called to create the messages." (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode) -;; Obsolete - (define-obsolete-function-alias 'checkdoc-run-hooks #'run-hook-with-args-until-success "28.1") (defvar checkdoc-version "0.6.2" -- cgit v1.2.3 From 9d35afed49896928433bb28a781b6060bc1601b1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 9 Aug 2022 10:57:46 +0200 Subject: Extend LAP optimisations to more operations Extend the set of eligible opcodes for certain peephole transformations, which then provide further optimisation opportunities. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Optimise empty save-current-buffer in the same way as we already do for save-excursion and save-restriction. This is safe because (save-current-buffer) is a no-op. (byte-compile-side-effect-and-error-free-ops): Add list3, list4 and listN. These were all apparent oversights as list1 and list2 were already included. (byte-after-unbind-ops): Add stack-ref, stack-set, discard, list3, list4 and listN. Stack manipulation is safe because unbind cannot read or modify stack entries. --- lisp/emacs-lisp/byte-opt.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 7a4bbf2e8af..a7edecfac73 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1747,10 +1747,10 @@ See Info node `(elisp) Integer Basics'." byte-goto-if-not-nil-else-pop)) (defconst byte-after-unbind-ops - '(byte-constant byte-dup + '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-not - byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4 + byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN byte-interactive-p) ;; How about other side-effect-free-ops? Is it safe to move an ;; error invocation (such as from nth) out of an unwind-protect? @@ -1762,7 +1762,8 @@ See Info node `(elisp) Integer Basics'." (defconst byte-compile-side-effect-and-error-free-ops '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe - byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max + byte-cdr-safe byte-cons byte-list1 byte-list2 byte-list3 byte-list4 + byte-listN byte-point byte-point-max byte-point-min byte-following-char byte-preceding-char byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp byte-current-buffer byte-stack-ref)) @@ -2113,13 +2114,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setcar (cdr rest) lap0) (setq keep-going t)) ;; - ;; varbind-X unbind-N --> discard unbind-(N-1) - ;; save-excursion unbind-N --> unbind-(N-1) - ;; save-restriction unbind-N --> unbind-(N-1) + ;; varbind-X unbind-N --> discard unbind-(N-1) + ;; save-excursion unbind-N --> unbind-(N-1) + ;; save-restriction unbind-N --> unbind-(N-1) + ;; save-current-buffer unbind-N --> unbind-(N-1) ;; ((and (eq 'byte-unbind (car lap1)) (memq (car lap0) '(byte-varbind byte-save-excursion - byte-save-restriction)) + byte-save-restriction + byte-save-current-buffer)) (< 0 (cdr lap1))) (if (zerop (setcdr lap1 (1- (cdr lap1)))) (delq lap1 rest)) -- cgit v1.2.3 From d8d582dc3c30e184e6f849eb302d0c89be019c83 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Wed, 10 Aug 2022 13:06:12 +0200 Subject: ; * lisp/emacs-lisp/subr-x.el (string-pad): Optimise. --- lisp/emacs-lisp/subr-x.el | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index b7083bfe7cc..1cce97cdb10 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -254,13 +254,9 @@ the string." (unless (natnump length) (signal 'wrong-type-argument (list 'natnump length))) (let ((pad-length (- length (length string)))) - (if (< pad-length 0) - string - (concat (and start - (make-string pad-length (or padding ?\s))) - string - (and (not start) - (make-string pad-length (or padding ?\s))))))) + (cond ((<= pad-length 0) string) + (start (concat (make-string pad-length (or padding ?\s)) string)) + (t (concat string (make-string pad-length (or padding ?\s))))))) (defun string-chop-newline (string) "Remove the final newline (if any) from STRING." -- cgit v1.2.3 From 89f51673792b13ae0d1b93d0bf8e35d452693c9c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Aug 2022 14:32:18 +0200 Subject: Don't show status message in Helper-describe-bindings * lisp/emacs-lisp/helper.el (Helper-describe-bindings): Don't show status message. --- lisp/emacs-lisp/helper.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index 654dbbc5fef..10bb2973253 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -131,7 +131,6 @@ (defun Helper-describe-bindings () "Describe local key bindings of current mode." (interactive) - (message "Making binding list...") (save-window-excursion (describe-bindings)) (Helper-help-scroller)) -- cgit v1.2.3 From 8854b321c2cf6132d7de43682c8ea26dd436c9d4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 11 Aug 2022 17:28:30 +0200 Subject: Make ad-version variable obsolete * lisp/emacs-lisp/advice.el (ad-version): Make obsolete in favor of emacs-version. It has not been bumped since 1994. --- lisp/emacs-lisp/advice.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 2a2bcca7007..391743d7156 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1580,8 +1580,6 @@ :link '(custom-manual "(elisp)Advising Functions") :group 'lisp) -(defconst ad-version "2.14") - ;;;###autoload (defcustom ad-redefinition-action 'warn "Defines what to do with redefinitions during Advice de/activation. @@ -3250,6 +3248,9 @@ Use only in REAL emergencies." (message "Oops! Left over advised function %S" function) (ad-pop-advised-function function))) +(defconst ad-version "2.14") +(make-obsolete-variable 'ad-version 'emacs-version "29.1") + (provide 'advice) ;;; advice.el ends here -- cgit v1.2.3 From a99ea4b7616025cf78c2f6bf69bc8e5cafb730b7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 Aug 2022 09:49:35 +0300 Subject: ; Fix documentation of 'loaddefs-generate' (bug#57144) * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Doc fix. --- lisp/emacs-lisp/loaddefs-gen.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 3b329357ad9..0c9bc4832b4 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -519,15 +519,21 @@ binds `generated-autoload-file' as a file-local variable, write its autoloads into the specified file instead. The function does NOT recursively descend into subdirectories of the -directory or directories specified. +directory or directories specified by DIRS. -If EXTRA-DATA, include this string at the start of the generated -file. This will also force generation of OUTPUT-FILE even if -there are no autoloads to put into the file. +Optional argument EXCLUDED-FILES, if non-nil, should be a list of +files, such as preloaded files, whose autoloads should not be written +to OUTPUT-FILE. -If INCLUDE-PACKAGE-VERSION, include package version data. +If EXTRA-DATA is non-nil, it should be a string; include that string +at the beginning of the generated file. This will also force the +generation of OUTPUT-FILE even if there are no autoloads to put into +that file. -If GENERATE-FULL, don't update, but regenerate all the loaddefs files." +If INCLUDE-PACKAGE-VERSION is non-nil, include package version data. + +If GENERATE-FULL is non-nil, regenerate all the loaddefs files anew, +instead of just updating them with the new/changed autoloads." (let* ((files-re (let ((tmp nil)) (dolist (suf (get-load-suffixes)) ;; We don't use module-file-suffix below because -- cgit v1.2.3 From 8ae68308a1a2988260a521792977e1cb69c47fd2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 12 Aug 2022 14:22:59 +0200 Subject: Use help-key-binding face in package list help * lisp/emacs-lisp/package.el (package--prettify-quick-help-key): Use help-key-binding face. --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d2959f7728c..ed23ee5f221 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3530,7 +3530,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (let ((place (cdr desc)) (out (copy-sequence (car desc)))) (add-text-properties place (1+ place) - '(face (bold font-lock-warning-face)) + '(face help-key-binding) out) out)) (package--prettify-quick-help-key (cons desc 0)))) -- cgit v1.2.3 From c0d761bf7f441f8ab9792351a493dc6bd5525dc1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 12 Aug 2022 15:15:11 +0200 Subject: Further seq-uniq speed-ups for lists * lisp/emacs-lisp/seq.el (seq-uniq): Speed up more for long lists (bug#57079). --- lisp/emacs-lisp/seq.el | 20 +++++++++++++++----- test/lisp/emacs-lisp/seq-tests.el | 7 ++++++- 2 files changed, 21 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 6ddd8de6e8d..b6f0f66e5b1 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -458,11 +458,21 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (cl-defmethod seq-uniq ((sequence list) &optional testfn) (let ((result nil)) (if (not testfn) - ;; Fast path. - (while sequence - (unless (member (car sequence) result) - (push (car sequence) result)) - (pop sequence)) + ;; Fast path. If the list is long, use a hash table to speed + ;; things up even more. + (let ((l (length sequence))) + (if (> l 100) + (let ((hash (make-hash-table :test #'equal :size l))) + (while sequence + (unless (gethash (car sequence) hash) + (setf (gethash (car sequence) hash) t) + (push (car sequence) result)) + (setq sequence (cdr sequence)))) + ;; Short list. + (while sequence + (unless (member (car sequence) result) + (push (car sequence) result)) + (pop sequence)))) ;; Slower path. (while sequence (unless (seq-find (lambda (elem) diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index a655377e6cc..1a27467d292 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -570,7 +570,12 @@ Evaluate BODY for each created sequence. (substring "2") (substring "1")))) (should (equal (seq-uniq list) '("1" "2" "3"))) - (should (equal (seq-uniq list #'eq) '("1" "2" "3" "2" "1"))))) + (should (equal (seq-uniq list #'eq) '("1" "2" "3" "2" "1")))) + ;; Long lists have a different code path. + (let ((list (seq-map-indexed (lambda (_ i) i) + (make-list 10000 nil)))) + (should (= (length list) 10000)) + (should (= (length (seq-uniq (append list list))) 10000)))) (provide 'seq-tests) ;;; seq-tests.el ends here -- cgit v1.2.3