From 8bb5c1bfec0929f2ba419e1c503f5acc01c336c2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 1 Sep 2022 13:39:14 +0200 Subject: Make easy-mmode-defmap obsolete and adjust only caller * lisp/emacs-lisp/easy-mmode.el (easy-mmode-defmap): Make obsolete. * lisp/progmodes/gud.el (gud-menu-map): Use easy-menu-define. --- lisp/emacs-lisp/easy-mmode.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index c3a4e9fc7ab..29ace89c3c7 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -719,9 +719,7 @@ The M, BS, and ARGS arguments are as per that function. DOC is the constant's documentation. This macro is deprecated; use `defvar-keymap' instead." - ;; FIXME: Declare obsolete in favor of `defvar-keymap'. It is still - ;; used for `gud-menu-map' and `gud-minor-mode-map', so fix that first. - (declare (doc-string 3) (indent 1)) + (declare (doc-string 3) (indent 1) (obsolete defvar-keymap "29.1")) `(defconst ,m (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) ,doc)) -- cgit v1.2.3 From 119d59531e19893cdc7eda2abe7174261adcbcaa Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 1 Sep 2022 13:42:19 +0200 Subject: Make easy-mmode-define-keymap obsolete * lisp/emacs-lisp/easy-mmode.el (easy-mmode-define-keymap): Make obsolete. (define-minor-mode): Add comment. --- lisp/emacs-lisp/easy-mmode.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 29ace89c3c7..a1398bd12e7 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -417,6 +417,8 @@ No problems result if this variable is not bound. `(defvar ,keymap-sym (let ((m ,keymap)) (cond ((keymapp m) m) + ;; FIXME: `easy-mmode-define-keymap' is obsolete, + ;; so this form should also be obsolete somehow. ((listp m) (easy-mmode-define-keymap m)) (t (error "Invalid keymap %S" m)))) ,(format "Keymap for `%s'." mode-name))) @@ -679,6 +681,7 @@ Valid keywords and arguments are: :group Ignored. :suppress Non-nil to call `suppress-keymap' on keymap, `nodigits' to suppress digits as prefix arguments." + (declare (obsolete define-keymap "29.1")) (let (inherit dense suppress) (while args (let ((key (pop args)) -- cgit v1.2.3 From 965ebf3484bf8ec39d0ee34f4040071fe3e5e04a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 2 Sep 2022 14:58:30 +0200 Subject: Fix define-minor-mode :keymap obsoletion warning * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Fix some warning. --- lisp/emacs-lisp/easy-mmode.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index a1398bd12e7..7d54a84687b 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -419,7 +419,10 @@ No problems result if this variable is not bound. (cond ((keymapp m) m) ;; FIXME: `easy-mmode-define-keymap' is obsolete, ;; so this form should also be obsolete somehow. - ((listp m) (easy-mmode-define-keymap m)) + ((listp m) + (with-suppressed-warnings ((obsolete + easy-mmode-define-keymap)) + (easy-mmode-define-keymap m))) (t (error "Invalid keymap %S" m)))) ,(format "Keymap for `%s'." mode-name))) -- cgit v1.2.3 From dcfe3314cd78e95d992fe00f757ce906d49586cd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Sep 2022 13:45:53 +0300 Subject: Teach 'max-char' about the Unicode code range * src/character.c (Fmax_char): Accept an optional argument UNICODE, and, if non-nil, return the maximum codepoint defined by Unicode. * lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Update the signature of 'max-char'. * etc/NEWS: * doc/lispref/nonascii.texi (Character Codes): Update the documentation of 'max-char'. --- doc/lispref/nonascii.texi | 7 +++++-- etc/NEWS | 6 ++++++ lisp/emacs-lisp/comp.el | 2 +- src/character.c | 10 ++++++---- 4 files changed, 18 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 6dc23637a79..71fee45c4a5 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -404,9 +404,12 @@ This returns @code{t} if @var{charcode} is a valid character, and @cindex maximum value of character codepoint @cindex codepoint, largest value -@defun max-char +@defun max-char &optional unicode This function returns the largest value that a valid character -codepoint can have. +codepoint can have in Emacs. If the optional argument @var{unicode} +is non-@code{nil}, it returns the largest character codepoint defined +by the Unicode Standard (which is smaller than the maximum codepoint +supported by Emacs). @example @group diff --git a/etc/NEWS b/etc/NEWS index 8269d3e7bf3..cc4714e71ce 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2789,6 +2789,12 @@ request the name of the ".eln" file which defined a given symbol. +++ ** New macro 'with-memoization' provides a very primitive form of memoization. ++++ +** 'max-char' can now report the maximum codepoint according to Unicode. +When called with a new optional argument UNICODE non-nil, 'max-char' +will now report the maximum valid codepoint defined by the Unicode +Standard. + ** Themes --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e10443588e4..306ec918b1a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -462,7 +462,7 @@ Useful to hook into pass checkers.") (marker-buffer (function (marker) (or buffer null))) (markerp (function (t) boolean)) (max (function ((or number marker) &rest (or number marker)) number)) - (max-char (function () fixnum)) + (max-char (function (&optional t) fixnum)) (member (function (t list) list)) (memory-limit (function () integer)) (memq (function (t list) list)) diff --git a/src/character.c b/src/character.c index 968daccafa7..dc21649b226 100644 --- a/src/character.c +++ b/src/character.c @@ -178,12 +178,14 @@ usage: (characterp OBJECT) */ return (CHARACTERP (object) ? Qt : Qnil); } -DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0, - doc: /* Return the character of the maximum code. */ +DEFUN ("max-char", Fmax_char, Smax_char, 0, 1, 0, + doc: /* Return the maximum character code. +If UNICODE is non-nil, return the maximum character code defined +by the Unicode Standard. */ attributes: const) - (void) + (Lisp_Object unicode) { - return make_fixnum (MAX_CHAR); + return unicode ? make_fixnum (MAX_UNICODE_CHAR) : make_fixnum (MAX_CHAR); } DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, -- cgit v1.2.3 From 6c11214dc1124bcb459088e89334e16e46127e16 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 3 Sep 2022 14:23:26 +0200 Subject: Inhibit nativecomp of loaddefs files * lisp/emacs-lisp/generate-lisp-file.el (generate-lisp-file-trailer): Allow inhibiting nativecomp. * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--rubric): Inhibit native-comp, because it's not very useful for loaddefs files. --- lisp/emacs-lisp/generate-lisp-file.el | 14 ++++++++++---- lisp/emacs-lisp/loaddefs-gen.el | 1 + 2 files changed, 11 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/generate-lisp-file.el b/lisp/emacs-lisp/generate-lisp-file.el index 8896a3f7019..7b087a4ecbd 100644 --- a/lisp/emacs-lisp/generate-lisp-file.el +++ b/lisp/emacs-lisp/generate-lisp-file.el @@ -63,12 +63,12 @@ inserted." (cl-defun generate-lisp-file-trailer (file &key version inhibit-provide (coding 'utf-8-emacs-unix) autoloads - compile provide) + compile provide inhibit-native-compile) "Insert a standard trailer for FILE. By default, this trailer inhibits version control, byte compilation, updating autoloads, and uses a `utf-8-emacs-unix' coding system. These can be inhibited by providing non-nil -values to the VERSION, NO-PROVIDE, AUTOLOADS and COMPILE +values to the VERSION, AUTOLOADS, COMPILE and NATIVE-COMPILE keyword arguments. CODING defaults to `utf-8-emacs-unix'. Use a nil value to @@ -79,7 +79,11 @@ If PROVIDE is non-nil, use that in the `provide' statement instead of using FILE as the basis. If `standard-output' is bound to a buffer, insert in that buffer. -If no, insert at point in the current buffer." +If no, insert at point in the current buffer. + +If INHITBIT-NATIVE-COMPILE is non-nil, add a cookie to inhibit +native compilation. (By default, a file will be native-compiled +if it's also byte-compiled)." (with-current-buffer (if (bufferp standard-output) standard-output (current-buffer)) @@ -96,9 +100,11 @@ If no, insert at point in the current buffer." (unless version (insert ";; version-control: never\n")) (unless compile - (insert ";; no-byte-" "compile: t\n")) ;; #$ is byte-compiled into nil. + (insert ";; no-byte-" "compile: t\n")) (unless autoloads (insert ";; no-update-autoloads: t\n")) + (when inhibit-native-compile + (insert ";; no-native-" "compile: t\n")) (when coding (insert (format ";; coding: %s\n" (if (eq coding t) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index e13b92bab8c..005a46c2d75 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -504,6 +504,7 @@ If COMPILE, don't include a \"don't compile\" cookie." (generate-lisp-file-trailer file :provide (and (stringp feature) feature) :compile compile + :inhibit-native-compile t :inhibit-provide (not feature)) (buffer-string)))) -- cgit v1.2.3 From d60e930d34fe0f4a88a790f98dcd43999327240c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Sep 2022 10:46:46 -0400 Subject: * lisp/emacs-lisp/cl-macs.el: Use `define-symbol-prop` (bug#50869) (cl-define-compiler-macro, cl-defstruct, cl-deftype): Prefer `define-symbol-prop` over `put` so `unload-feature` can undo those definitions. --- lisp/emacs-lisp/cl-macs.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 80ca43c902a..edd633675dc 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3105,7 +3105,7 @@ To see the documentation for a defined struct type, use `(and ,pred-form t))) forms) (push `(eval-and-compile - (put ',name 'cl-deftype-satisfies ',predicate)) + (define-symbol-prop ',name 'cl-deftype-satisfies ',predicate)) forms)) (let ((pos 0) (descp descs)) (while descp @@ -3570,7 +3570,7 @@ and then returning foo." (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args) (cons '_cl-whole-arg args)) ,@body) - (put ',func 'compiler-macro #',fname)))) + (define-symbol-prop ',func 'compiler-macro #',fname)))) ;;;###autoload (defun cl-compiler-macroexpand (form) @@ -3679,8 +3679,8 @@ macro that returns its `&whole' argument." The type name can then be used in `cl-typecase', `cl-check-type', etc." (declare (debug cl-defmacro) (doc-string 3) (indent 2)) `(cl-eval-when (compile load eval) - (put ',name 'cl-deftype-handler - (cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body))))) + (define-symbol-prop ',name 'cl-deftype-handler + (cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body))))) (cl-deftype extended-char () '(and character (not base-char))) ;; Define fixnum so `cl-typep' recognize it and the type check emitted -- cgit v1.2.3 From b01d529e8de00b38a2a9e401254a34f018ee4004 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Sep 2022 10:52:57 -0400 Subject: * lisp/emacs-lisp/macroexp.el (macroexp--compiler-macro): Soften message Clarify that the error is "harmless". --- lisp/emacs-lisp/macroexp.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index c3ba1b36d44..f4df40249de 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -110,7 +110,8 @@ each clause." (let ((symbols-with-pos-enabled t)) (apply handler form (cdr form))) (error - (message "Compiler-macro error for %S: Handler: %S\n%S" (car form) handler err) + (message "Warning: Optimization failure for %S: Handler: %S\n%S" + (car form) handler err) form))) (defun macroexp--funcall-if-compiled (_form) -- cgit v1.2.3 From 99a5a72537be811ae4220d9b58329991d6aa3d4d Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 3 Sep 2022 16:35:16 +0200 Subject: lisp/emacs-lisp/seq.el: remove unnecessary compatibility code * lisp/emacs-lisp/seq.el (seq-take, seq--activate-font-lock-keywords): Simplify unnecessarily guarded code, as this file will only ever be used with the same version of Emacs. --- lisp/emacs-lisp/seq.el | 18 +----------------- 1 file changed, 1 insertion(+), 17 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index b6f0f66e5b1..1b4a49e4e32 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -618,13 +618,7 @@ Signal an error if SEQUENCE is empty." (cl-defmethod seq-take ((list list) n) "Optimized implementation of `seq-take' for lists." - (if (eval-when-compile (fboundp 'take)) - (take n list) - (let ((result '())) - (while (and list (> n 0)) - (setq n (1- n)) - (push (pop list) result)) - (nreverse result)))) + (take n list)) (cl-defmethod seq-drop-while (pred (list list)) "Optimized implementation of `seq-drop-while' for lists." @@ -655,16 +649,6 @@ Signal an error if SEQUENCE is empty." sequence (concat sequence))) -(defun seq--activate-font-lock-keywords () - "Activate font-lock keywords for some symbols defined in seq." - (font-lock-add-keywords 'emacs-lisp-mode - '("\\" "\\"))) - -(unless (fboundp 'elisp--font-lock-flush-elisp-buffers) - ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others) - ;; we automatically highlight macros. - (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords)) - (defun seq-split (sequence length) "Split SEQUENCE into a list of sub-sequences of at most LENGTH. All the sub-sequences will be of LENGTH, except the last one, -- cgit v1.2.3 From aad38d6010d9eef07685fa52ce93bcf70512f88b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Sep 2022 11:03:01 -0400 Subject: * lisp/emacs-lisp/comp.el (comp-run-async-workers): Fail more gracefully Otherwise Emacs may fail to start if it can't find a writable `~/.emacs.d/eln-cache` directory. Fixes bug#57562. See also Debian's bug #1017739. --- lisp/emacs-lisp/comp.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 374b39e9990..a5ab12ae388 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3927,8 +3927,11 @@ display a message." when (or native-comp-always-compile load ; Always compile when the compilation is ; commanded for late load. - (file-newer-than-file-p - source-file (comp-el-to-eln-filename source-file))) + ;; Skip compilation if `comp-el-to-eln-filename' fails + ;; to find a writable directory. + (with-demoted-errors "Async compilation :%S" + (file-newer-than-file-p + source-file (comp-el-to-eln-filename source-file)))) do (let* ((expr `((require 'comp) ,(when (boundp 'backtrace-line-length) `(setf backtrace-line-length ,backtrace-line-length)) -- cgit v1.2.3 From 2dd1c2ab19f7fb99ecee60e27e63b2fb045f6970 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 3 Sep 2022 22:38:28 -0400 Subject: gv.el and cl-macs.el: Fix bug#57397 * lisp/emacs-lisp/gv.el (gv-get): Obey symbol macros. * lisp/emacs-lisp/cl-macs.el (cl--letf): Remove workaround placed to try and handle symbol macros. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-test--symbol-macrolet): Add new testcase. --- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/gv.el | 6 +++++- test/lisp/emacs-lisp/cl-macs-tests.el | 15 ++++++++++++++- 3 files changed, 20 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index edd633675dc..9755c2636de 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2762,7 +2762,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (funcall setter vold))) binds)))) (let* ((binding (car bindings)) - (place (macroexpand (car binding) macroexpand-all-environment))) + (place (car binding))) (gv-letplace (getter setter) place (macroexp-let2 nil vnew (cadr binding) (if (symbolp place) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index eaab6439adb..1db9d96d999 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -87,7 +87,11 @@ with a (not necessarily copyable) Elisp expression that returns the value to set it to. DO must return an Elisp expression." (cond - ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v)))) + ((symbolp place) + (let ((me (macroexpand-1 place macroexpand-all-environment))) + (if (eq me place) + (funcall do place (lambda (v) `(setq ,place ,v))) + (gv-get me do)))) ((not (consp place)) (signal 'gv-invalid-place (list place))) (t (let* ((head (car place)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 19ede627a13..2a647e08305 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -539,7 +539,20 @@ collection clause." ((p (gv-synthetic-place cl (lambda (v) `(setcar l ,v))))) (cl-incf p))) l) - '(1)))) + '(1))) + ;; Make sure `gv-synthetic-place' isn't macro-expanded before + ;; `cl-letf' gets to see its `gv-expander'. + (should (equal + (condition-case err + (let ((x 1)) + (list x + (cl-letf (((gv-synthetic-place (+ 1 2) + (lambda (v) `(setq x ,v))) + 7)) + x) + x)) + (error err)) + '(1 7 3)))) (ert-deftest cl-macs-loop-conditional-step-clauses () "These tests failed under the initial fixes in #bug#29799." -- cgit v1.2.3 From 77b761dafaf65d57dd05ecd586884340fa4e63e2 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Sun, 4 Sep 2022 13:00:22 +0200 Subject: Improve documentation of several functions in seq.el * doc/lispref/sequences.texi (Sequence Functions): * lisp/emacs-lisp/seq.el (seq-contains): (seq-contains-p): (seq-set-equal-p): (seq-position): (seq-union): (seq-intersection): (seq-difference): Use more standard wording in the docstrings (bug#57561). --- doc/lispref/sequences.texi | 2 +- lisp/emacs-lisp/seq.el | 16 ++++++++-------- 2 files changed, 9 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 1f6f80521c0..cc956952d6f 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -863,7 +863,7 @@ arguments to use instead of the default @code{equal}. @end defun @defun seq-position sequence elt &optional function - This function returns the index of the first element in + This function returns the (zero-based) index of the first element in @var{sequence} that is equal to @var{elt}. If the optional argument @var{function} is non-@code{nil}, it is a function of two arguments to use instead of the default @code{equal}. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 1b4a49e4e32..b5f762ef3ac 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -409,7 +409,7 @@ found or not." (cl-defgeneric seq-contains (sequence elt &optional testfn) "Return the first element in SEQUENCE that is equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (declare (obsolete seq-contains-p "27.1")) (seq-some (lambda (e) (when (funcall (or testfn #'equal) elt e) @@ -418,7 +418,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (cl-defgeneric seq-contains-p (sequence elt &optional testfn) "Return non-nil if SEQUENCE contains an element equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (catch 'seq--break (seq-doseq (e sequence) (let ((r (funcall (or testfn #'equal) e elt))) @@ -429,14 +429,14 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements. This does not depend on the order of the elements. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1) (seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2))) ;;;###autoload (cl-defgeneric seq-position (sequence elt &optional testfn) - "Return the index of the first element in SEQUENCE that is equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." + "Return the (zero-based) index of the first element in SEQUENCE equal to ELT. +Equality is defined by the function TESTFN, which defaults to `equal'." (let ((index 0)) (catch 'seq--break (seq-doseq (e sequence) @@ -502,7 +502,7 @@ negative integer or 0, nil is returned." ;;;###autoload (cl-defgeneric seq-union (sequence1 sequence2 &optional testfn) "Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (let* ((accum (lambda (acc elt) (if (seq-contains-p acc elt testfn) acc @@ -514,7 +514,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." ;;;###autoload (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn) "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) (cons elt acc) @@ -524,7 +524,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn) "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) acc -- cgit v1.2.3 From 2db8b0e12f913ecd720aa81a70580e58fd032397 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Sat, 3 Sep 2022 18:47:04 +0200 Subject: Add new function `seq-remove-at-position' * doc/lispref/sequences.texi (Sequence Functions): Document it. * lisp/emacs-lisp/seq.el (seq-remove-at-position): New function. * lisp/emacs-lisp/shortdoc.el (sequence): Mention it. * test/lisp/emacs-lisp/seq-tests.el (test-seq-remove-at-position): Test it. --- doc/lispref/sequences.texi | 18 ++++++++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/seq.el | 14 ++++++++++++++ lisp/emacs-lisp/shortdoc.el | 3 +++ test/lisp/emacs-lisp/seq-tests.el | 8 ++++++++ 5 files changed, 48 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index cc956952d6f..2ee19efb1a9 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -680,6 +680,24 @@ for which @var{predicate} returns @code{nil}. @end example @end defun +@defun seq-remove-at-position sequence n +@cindex removing from sequences + This function returns a copy of @var{sequence} where the element at + (zero-based) index @var{n} got removed. The result is a sequence of + the same type as @var{sequence}. + +@example +@group +(seq-remove-at-position [1 -1 3 -3 5] 0) +@result{} [-1 3 -3 5] +@end group +@group +(seq-remove-at-position [1 -1 3 -3 5] 3) +@result{} [1 -1 3 5] +@end group +@end example +@end defun + @defun seq-reduce function sequence initial-value @cindex reducing sequences This function returns the result of calling @var{function} with diff --git a/etc/NEWS b/etc/NEWS index edd4b01eab5..e9c322d74ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2743,6 +2743,11 @@ The default timeout value can be defined by the new variable ** New function 'seq-split'. This returns a list of sub-sequences of the specified sequence. ++++ +** New function 'seq-remove-at-position'. +This function returns a copy of the specified sequence where the +element at a given (zero-based) index got removed. + +++ ** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'. These function now take an optional comparison predicate argument. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index b5f762ef3ac..64197b55e5f 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -346,6 +346,20 @@ list." (seq-filter (lambda (elt) (not (funcall pred elt))) sequence)) +;;;###autoload +(cl-defgeneric seq-remove-at-position (sequence n) + "Return a copy of SEQUENCE where the element at N got removed. + +N is the (zero-based) index of the element that should not be in +the result. + +The result is a sequence of the same type as SEQUENCE." + (seq-concatenate + (let ((type (type-of sequence))) + (if (eq type 'cons) 'list type)) + (seq-subseq sequence 0 n) + (seq-subseq sequence (1+ n)))) + ;;;###autoload (cl-defgeneric seq-reduce (function sequence initial-value) "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 990dabe351a..6a366ec0fc0 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -888,6 +888,9 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (seq-filter #'numberp '(a b 3 4 f 6))) (seq-remove :eval (seq-remove #'numberp '(1 2 c d 5))) + (seq-remove-at-position + :eval (seq-remove-at-position '(a b c d e) 3) + :eval (seq-remove-at-position [a b c d e] 0)) (seq-group-by :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6))) (seq-union diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 1a27467d292..6249e486173 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -137,6 +137,14 @@ Evaluate BODY for each created sequence. (with-test-sequences (seq '()) (should (equal (seq-remove #'test-sequences-evenp seq) '())))) +(ert-deftest test-seq-remove-at-position () + (with-test-sequences (seq '(1 2 3 4)) + (should (same-contents-p (seq-remove-at-position seq 2) '(1 2 4))) + (should (same-contents-p (seq-remove-at-position seq 0) '(2 3 4))) + (should (same-contents-p (seq-remove-at-position seq 3) '(1 2 3))) + (should (eq (type-of (seq-remove-at-position seq 2)) + (type-of seq))))) + (ert-deftest test-seq-count () (with-test-sequences (seq '(6 7 8 9 10)) (should (equal (seq-count #'test-sequences-evenp seq) 3)) -- cgit v1.2.3 From 4751b51d5e1182975aa002af08a625e4859ec276 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Sun, 4 Sep 2022 13:21:59 +0200 Subject: Add new function `seq-positions' * doc/lispref/sequences.texi (Sequence Functions): Document it. * lisp/emacs-lisp/seq.el (seq-positions): New function. * lisp/emacs-lisp/shortdoc.el (sequence): Mention it. * test/lisp/emacs-lisp/seq-tests.el (test-seq-positions): Test it (bug#57548). --- doc/lispref/sequences.texi | 21 +++++++++++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/seq.el | 17 +++++++++++++++++ lisp/emacs-lisp/shortdoc.el | 4 ++++ test/lisp/emacs-lisp/seq-tests.el | 7 +++++++ 5 files changed, 54 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 2ee19efb1a9..214b1e76e15 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -898,6 +898,27 @@ use instead of the default @code{equal}. @end example @end defun +@defun seq-positions sequence elt &optional testfn + This function returns a list of the (zero-based) indices of the +elements in @var{sequence} for which @var{testfn} returns +non-@code{nil} when passed the element and @var{elt} as +arguments. @var{testfn} defaults to @code{equal}. + +@example +@group +(seq-positions '(a b c a d) 'a) +@result{} (0 3) +@end group +@group +(seq-positions '(a b c a d) 'z) +@result{} nil +@end group +@group +(seq-positions '(11 5 7 12 9 15) 10 #'>=) +@result{} (0 3 5) +@end group +@end example +@end defun @defun seq-uniq sequence &optional function This function returns a list of the elements of @var{sequence} with diff --git a/etc/NEWS b/etc/NEWS index ee450317a0c..6c0cf19fe6b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2742,6 +2742,11 @@ compiler now emits a warning about this deprecated usage. These can be used for buttons in buffers and the like. See the "(elisp) Icons" and "(emacs) Icons" nodes in the manuals for details. ++++ +** New function 'seq-positions'. +This returns a list of the (zero-based) indices of elements matching a +given predicate in the specified sequence. + +++ ** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. MESSAGE specifies a message to display after activating the transient diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 64197b55e5f..31dcfa98b40 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -459,6 +459,23 @@ Equality is defined by the function TESTFN, which defaults to `equal'." (setq index (1+ index))) nil))) +;;;###autoload +(cl-defgeneric seq-positions (sequence elt &optional testfn) + "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil. + +TESTFN is a two-argument function which is passed each element of +SEQUENCE as first argument and ELT as second. TESTFN defaults to +`equal'. + +The result is a list of (zero-based) indices." + (let ((result '())) + (seq-do-indexed + (lambda (e index) + (when (funcall (or testfn #'equal) e elt) + (push index result))) + sequence) + (nreverse result))) + ;;;###autoload (cl-defgeneric seq-uniq (sequence &optional testfn) "Return a list of the elements of SEQUENCE with duplicates removed. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 6a366ec0fc0..2472479bad6 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -846,6 +846,10 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (seq-find #'numberp '(a b 3 4 f 6))) (seq-position :eval (seq-position '(a b c) 'c)) + (seq-positions + :eval (seq-positions '(a b c a d) 'a) + :eval (seq-positions '(a b c a d) 'z) + :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) (seq-length :eval (seq-length "abcde")) (seq-max diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 6249e486173..d95b35c45eb 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -490,6 +490,13 @@ Evaluate BODY for each created sequence. (should (= (seq-position seq 'a #'eq) 0)) (should (null (seq-position seq (make-symbol "a") #'eq))))) +(ert-deftest test-seq-positions () + (with-test-sequences (seq '(1 2 3 1 4)) + (should (equal '(0 3) (seq-positions seq 1))) + (should (seq-empty-p (seq-positions seq 9)))) + (with-test-sequences (seq '(11 5 7 12 9 15)) + (should (equal '(0 3 5) (seq-positions seq 10 #'>=))))) + (ert-deftest test-seq-sort-by () (let ((seq ["x" "xx" "xxx"])) (should (equal (seq-sort-by #'seq-length #'> seq) -- cgit v1.2.3 From 1763cd4727a4ff38a9ea89e1d532017adff05c1e Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 5 Sep 2022 20:58:27 +0200 Subject: Fit the re-builder window to the buffer * lisp/emacs-lisp/re-builder.el (re-builder): Fit the height to the buffer (bug#56772). --- lisp/emacs-lisp/re-builder.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index e6e8bb202da..897c35b5b19 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -369,7 +369,8 @@ provided in the Commentary section of this library." (get-buffer-create reb-buffer) `((display-buffer-in-direction) (direction . ,dir) - (dedicated . t)))))) + (dedicated . t) + (window-height . fit-window-to-buffer)))))) (font-lock-mode 1) (reb-initialize-buffer))) -- cgit v1.2.3 From 2a78f06ef4d303b383749be3dabd0f9a68547e5e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Sep 2022 00:08:35 -0400 Subject: cl-symbol-macrolet: Fix recent regression The recent fix for bug#57397 introduced a regression, breaking the `cl-lib-symbol-macrolet-hide` test. It turned out that the origin of the problem was that `gv.el` uses `macroexpand-1` which does not (can't) use `macroexpand` but `cl-symbol-macrolet` failed to advise `macroexpand-1` the way it advised `macroexpand`. To fix this, we change `cl-symbol-macrolet` so it advises both, and we do that with a new `macroexpand` advice which delegates the bulk of the work to `macroexpand-1`. Along the way, I bumped into another bug in the interaction between `cl-letf` and `cl-symbol-macrolet`, which I tried to fix in `cl-letf`. I hear the war on `cl-symbol-macrolet` was a failure. Maybe ... just say no? * lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand-1): New function, extracted from `cl--sm-macroexpand`. (cl--sm-macroexpand): Rewrite completely. (cl-symbol-macrolet): Advise both `macroexpand` and `macroexpand-1`. (cl--letf): Don't use the "simple variable" code for symbol macros. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-symbol-macrolet-hide): Revert last change because the test was right. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs-test--symbol-macrolet): Add a test case. --- lisp/emacs-lisp/cl-macs.el | 266 +++++++++++++++++----------------- test/lisp/emacs-lisp/cl-lib-tests.el | 3 - test/lisp/emacs-lisp/cl-macs-tests.el | 9 +- 3 files changed, 141 insertions(+), 137 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9755c2636de..f8fdc50251f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2261,139 +2261,131 @@ This is like `cl-flet', but for macros instead of functions. (eval `(function (lambda ,@res)) t)) macroexpand-all-environment)))))) -(defun cl--sm-macroexpand (orig-fun exp &optional env) +(defun cl--sm-macroexpand (exp &optional env) + "Special macro expander used inside `cl-symbol-macrolet'." + ;; FIXME: Arguably, this should be the official definition of `macroexpand'. + (while (not (eq exp (setq exp (macroexpand-1 exp env))))) + exp) + +(defun cl--sm-macroexpand-1 (orig-fun exp &optional env) "Special macro expander advice used inside `cl-symbol-macrolet'. -This function extends `macroexpand' during macro expansion +This function extends `macroexpand-1' during macro expansion of `cl-symbol-macrolet' to additionally expand symbol macros." - (let ((macroexpand-all-environment env) + (let ((exp (funcall orig-fun exp env)) (venv (alist-get :cl-symbol-macros env))) - (while - (progn - (setq exp (funcall orig-fun exp env)) - (pcase exp - ((pred symbolp) - ;; Perform symbol-macro expansion. - (let ((symval (assq exp venv))) - (when symval - (setq exp (cadr symval))))) - (`(setq . ,args) - ;; Convert setq to setf if required by symbol-macro expansion. - (let ((convert nil) - (rargs nil)) - (while args - (let ((place (pop args))) - ;; Here, we know `place' should be a symbol. - (while - (let ((symval (assq place venv))) - (when symval - (setq place (cadr symval)) - (if (symbolp place) - t ;Repeat. - (setq convert t) - nil)))) - (push place rargs) - (push (pop args) rargs))) - (setq exp (cons (if convert 'setf 'setq) - (nreverse rargs))) - convert)) - ;; CL's symbol-macrolet used to treat re-bindings as candidates for - ;; expansion (turning the let into a letf if needed), contrary to - ;; Common-Lisp where such re-bindings hide the symbol-macro. - ;; Not sure if there actually is code out there which depends - ;; on this behavior (haven't found any yet). - ;; Such code should explicitly use `cl-letf' instead, I think. - ;; - ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare)) - ;; (let ((letf nil) (found nil) (nbs ())) - ;; (dolist (binding bindings) - ;; (let* ((var (if (symbolp binding) binding (car binding))) - ;; (sm (assq var venv))) - ;; (push (if (not (cdr sm)) - ;; binding - ;; (let ((nexp (cadr sm))) - ;; (setq found t) - ;; (unless (symbolp nexp) (setq letf t)) - ;; (cons nexp (cdr-safe binding)))) - ;; nbs))) - ;; (when found - ;; (setq exp `(,(if letf - ;; (if (eq (car exp) 'let) 'cl-letf 'cl-letf*) - ;; (car exp)) - ;; ,(nreverse nbs) - ;; ,@body))))) - ;; - ;; We implement the Common-Lisp behavior, instead (see bug#26073): - ;; The behavior of CL made sense in a dynamically scoped - ;; language, but nowadays, lexical scoping semantics is more often - ;; expected. - (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare)) - (let ((nbs ()) (found nil)) - (dolist (binding bindings) - (let* ((var (if (symbolp binding) binding (car binding))) - (val (and found (consp binding) (eq 'let* (car exp)) - (list (macroexpand-all (cadr binding) - env))))) - (push (if (assq var venv) - ;; This binding should hide "its" surrounding - ;; symbol-macro, but given the way macroexpand-all - ;; works (i.e. the `env' we receive as input will - ;; be (re)applied to the code we return), we can't - ;; prevent application of `env' to the - ;; sub-expressions, so we need to α-rename this - ;; variable instead. - (let ((nvar (make-symbol (symbol-name var)))) - (setq found t) - (push (list var nvar) venv) - (push (cons :cl-symbol-macros venv) env) - (cons nvar (or val (cdr-safe binding)))) - (if val (cons var val) binding)) - nbs))) - (when found - (setq exp `(,(car exp) - ,(nreverse nbs) - ,@(macroexp-unprogn - (macroexpand-all (macroexp-progn body) - env))))) - nil)) - ;; Do the same as for `let' but for variables introduced - ;; via other means, such as `lambda' and `condition-case'. - (`(function (lambda ,args . ,body)) - (let ((nargs ()) (found nil)) - (dolist (var args) - (push (cond - ((memq var '(&optional &rest)) var) - ((assq var venv) - (let ((nvar (make-symbol (symbol-name var)))) - (setq found t) - (push (list var nvar) venv) - (push (cons :cl-symbol-macros venv) env) - nvar)) - (t var)) - nargs)) - (when found - (setq exp `(function - (lambda ,(nreverse nargs) - . ,(mapcar (lambda (exp) - (macroexpand-all exp env)) - body))))) - nil)) - ((and `(condition-case ,var ,exp . ,clauses) - (guard (assq var venv))) - (let ((nvar (make-symbol (symbol-name var)))) - (push (list var nvar) venv) - (push (cons :cl-symbol-macros venv) env) - (setq exp - `(condition-case ,nvar ,(macroexpand-all exp env) - . ,(mapcar - (lambda (clause) - `(,(car clause) - . ,(mapcar (lambda (exp) - (macroexpand-all exp env)) - (cdr clause)))) - clauses))) - nil)) - ))) - exp)) + (pcase exp + ((pred symbolp) + ;; Try symbol-macro expansion. + (let ((symval (assq exp venv))) + (if symval (cadr symval) exp))) + (`(setq . ,args) + ;; Convert setq to setf if required by symbol-macro expansion. + (let ((convert nil)) + (while args + (let* ((place (pop args)) + ;; Here, we know `place' should be a symbol. + (symval (assq place venv))) + (pop args) + (when symval + (setq convert t)))) + (if convert + (cons 'setf (cdr exp)) + exp))) + ;; CL's symbol-macrolet used to treat re-bindings as candidates for + ;; expansion (turning the let into a letf if needed), contrary to + ;; Common-Lisp where such re-bindings hide the symbol-macro. + ;; Not sure if there actually is code out there which depends + ;; on this behavior (haven't found any yet). + ;; Such code should explicitly use `cl-letf' instead, I think. + ;; + ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare)) + ;; (let ((letf nil) (found nil) (nbs ())) + ;; (dolist (binding bindings) + ;; (let* ((var (if (symbolp binding) binding (car binding))) + ;; (sm (assq var venv))) + ;; (push (if (not (cdr sm)) + ;; binding + ;; (let ((nexp (cadr sm))) + ;; (setq found t) + ;; (unless (symbolp nexp) (setq letf t)) + ;; (cons nexp (cdr-safe binding)))) + ;; nbs))) + ;; (when found + ;; (setq exp `(,(if letf + ;; (if (eq (car exp) 'let) 'cl-letf 'cl-letf*) + ;; (car exp)) + ;; ,(nreverse nbs) + ;; ,@body))))) + ;; + ;; We implement the Common-Lisp behavior, instead (see bug#26073): + ;; The behavior of CL made sense in a dynamically scoped + ;; language, but nowadays, lexical scoping semantics is more often + ;; expected. + (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare)) + (let ((nbs ()) (found nil)) + (dolist (binding bindings) + (let* ((var (if (symbolp binding) binding (car binding))) + (val (and found (consp binding) (eq 'let* (car exp)) + (list (macroexpand-all (cadr binding) + env))))) + (push (if (assq var venv) + ;; This binding should hide "its" surrounding + ;; symbol-macro, but given the way macroexpand-all + ;; works (i.e. the `env' we receive as input will + ;; be (re)applied to the code we return), we can't + ;; prevent application of `env' to the + ;; sub-expressions, so we need to α-rename this + ;; variable instead. + (let ((nvar (make-symbol (symbol-name var)))) + (setq found t) + (push (list var nvar) venv) + (push (cons :cl-symbol-macros venv) env) + (cons nvar (or val (cdr-safe binding)))) + (if val (cons var val) binding)) + nbs))) + (if found + `(,(car exp) + ,(nreverse nbs) + ,@(macroexp-unprogn + (macroexpand-all (macroexp-progn body) + env))) + exp))) + ;; Do the same as for `let' but for variables introduced + ;; via other means, such as `lambda' and `condition-case'. + (`(function (lambda ,args . ,body)) + (let ((nargs ()) (found nil)) + (dolist (var args) + (push (cond + ((memq var '(&optional &rest)) var) + ((assq var venv) + (let ((nvar (make-symbol (symbol-name var)))) + (setq found t) + (push (list var nvar) venv) + (push (cons :cl-symbol-macros venv) env) + nvar)) + (t var)) + nargs)) + (if found + `(function + (lambda ,(nreverse nargs) + . ,(mapcar (lambda (exp) + (macroexpand-all exp env)) + body))) + exp))) + ((and `(condition-case ,var ,exp . ,clauses) + (guard (assq var venv))) + (let ((nvar (make-symbol (symbol-name var)))) + (push (list var nvar) venv) + (push (cons :cl-symbol-macros venv) env) + `(condition-case ,nvar ,(macroexpand-all exp env) + . ,(mapcar + (lambda (clause) + `(,(car clause) + . ,(mapcar (lambda (exp) + (macroexpand-all exp env)) + (cdr clause)))) + clauses)))) + (_ exp)))) ;;;###autoload (defmacro cl-symbol-macrolet (bindings &rest body) @@ -2412,7 +2404,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (unwind-protect (progn (unless advised - (advice-add 'macroexpand :around #'cl--sm-macroexpand)) + (advice-add 'macroexpand :override #'cl--sm-macroexpand) + (advice-add 'macroexpand-1 :around #'cl--sm-macroexpand-1)) (let* ((venv (cdr (assq :cl-symbol-macros macroexpand-all-environment))) (expansion @@ -2428,7 +2421,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). expansion nil nil rev-malformed-bindings)) expansion))) (unless advised - (advice-remove 'macroexpand #'cl--sm-macroexpand))))) + (advice-remove 'macroexpand #'cl--sm-macroexpand) + (advice-remove 'macroexpand-1 #'cl--sm-macroexpand-1))))) ;;;###autoload (defmacro cl-with-gensyms (names &rest body) @@ -2765,8 +2759,14 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'. (place (car binding))) (gv-letplace (getter setter) place (macroexp-let2 nil vnew (cadr binding) - (if (symbolp place) + (if (and (symbolp place) + ;; `place' could be some symbol-macro. + (eq place getter)) ;; Special-case for simple variables. + ;; FIXME: We currently only use this special case when `place' + ;; is a simple var. Should we also use it when the + ;; macroexpansion of `place' is a simple var (i.e. when + ;; getter+setter is the same as that of a simple var)? (cl--letf (cdr bindings) (cons `(,getter ,(if (cdr binding) vnew getter)) simplebinds) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 8d2b187e33a..b19494af746 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -511,9 +511,6 @@ (ert-deftest cl-lib-symbol-macrolet-hide () - :expected-result :failed - ;; FIXME -- it's unclear what the semantics here should be, but - ;; 2dd1c2ab19f7fb99ecee flipped them. ;; bug#26325, bug#26073 (should (equal (let ((y 5)) (cl-symbol-macrolet ((x y)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 2a647e08305..68898720d9c 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -552,7 +552,14 @@ collection clause." x) x)) (error err)) - '(1 7 3)))) + '(1 7 3))) + (should (equal + (let ((x (list 42))) + (cl-symbol-macrolet ((m (car x))) + (list m + (cl-letf ((m 5)) m) + m))) + '(42 5 42)))) (ert-deftest cl-macs-loop-conditional-step-clauses () "These tests failed under the initial fixes in #bug#29799." -- cgit v1.2.3 From 1f29ee2d21b57e81a28550a1b31bc8a39406d17b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 10 Jul 2022 13:27:36 +0200 Subject: Delete many items obsolete since 24.3 * lisp/allout.el (allout-exposure-change-hook) (allout-structure-added-hook, allout-structure-deleted-hook) (allout-structure-shifted-hook): * lisp/arc-mode.el (archive-extract-hooks): * lisp/buff-menu.el (Buffer-menu-buffer+size-width): * lisp/calendar/timeclock.el (timeclock-modeline-display) (timeclock-modeline-display, timeclock-update-modeline): * lisp/cedet/semantic/db-el.el (semanticdb-elisp-sym-function-arglist): * lisp/cedet/semantic/db-file.el (semanticdb-save-database-hooks): * lisp/cedet/semantic/edit.el (semantic-change-hooks) (semantic-edits-new-change-hooks) (semantic-edits-delete-change-hooks) (semantic-edits-reparse-change-hooks): * lisp/cedet/semantic/lex.el (semantic-lex-reset-hooks): * lisp/comint.el (comint--unquote&expand-filename) (comint-unquote-filename): * lisp/custom.el (user-variable-p): * lisp/dired.el (dired-shrink-to-fit, dired-pop-to-buffer) (dired-sort-set-modeline): * lisp/ebuff-menu.el (Electric-buffer-menu-mode): * lisp/emacs-lisp/byte-run.el (macro-declaration-function): * lisp/emacs-lisp/checkdoc.el (custom-print-functions) (checkdoc-comment-style-hooks): * lisp/emacs-lisp/cl-lib.el (custom-print-functions): * lisp/emacs-lisp/edebug.el (gud-inhibit-global-bindings): * lisp/erc/erc-dcc.el (erc-dcc-chat-filter-hook): * lisp/eshell/esh-mode.el (eshell-status-in-modeline): * lisp/eshell/eshell.el (eshell-add-to-window-buffer-names) (eshell-remove-from-window-buffer-names): * lisp/faces.el (set-face-underline-p, font-list-limit): * lisp/files.el (automount-dir-prefix, toggle-read-only): * lisp/filesets.el (filesets-cache-fill-content-hooks): * lisp/frame.el (automatic-hscrolling): * lisp/generic-x.el (javascript-generic-mode) (javascript-generic-mode-hook): * lisp/gnus/gnus-start.el (gnus-subscribe-newsgroup-hooks): * lisp/gnus/nndiary.el (nndiary-request-create-group-hooks) (nndiary-request-update-info-hooks) (nndiary-request-accept-article-hooks): * lisp/htmlfontify.el (hfy-post-html-hooks): * lisp/international/mule-cmds.el (inactivate-current-input-method-function) (inactivate-input-method, input-method-inactivate-hook) (ucs-insert): * lisp/international/quail.el (quail-inactivate) (quail-inactivate-hook): * lisp/international/robin.el (robin-inactivate) (robin-inactivate-hook): * lisp/leim/quail/hangul.el (hangul-input-method-inactivate): * lisp/leim/quail/uni-input.el (ucs-input-inactivate): * lisp/mail/emacsbug.el (report-emacs-bug-info): * lisp/mh-e/mh-e.el (mh-kill-folder-suppress-prompt-hooks): * lisp/mpc.el (mpc-string-prefix-p): * lisp/net/rcirc.el (rcirc-print-hooks, rcirc-sentinel-hooks) (rcirc-receive-message-hooks, rcirc-activity-hooks): * lisp/obsolete/crisp.el (crisp-mode-modeline-string): * lisp/pcomplete.el (pcomplete-arg-quote-list) (pcomplete-quote-argument): * lisp/progmodes/cc-mode.el (c-prepare-bug-report-hooks): * lisp/progmodes/python.el (python-info-ppss-context) (python-info-ppss-context-type) (python-info-ppss-comment-or-string-p, python-indent) (python-guess-indent, python-buffer, python-preoutput-result) (python-proc, python-send-receive, python-send-string) (python-use-skeletons): * lisp/progmodes/sh-script.el (sh-maybe-here-document): * lisp/replace.el (query-replace-interactive): * lisp/strokes.el (strokes-modeline-string): * lisp/subr.el (redraw-modeline): * lisp/term.el (term-default-fg-color, term-default-bg-color): * lisp/textmodes/tex-mode.el (latex-string-prefix-p) (tex-string-prefix-p): * lisp/url/url-parse.el (url-recreate-url-attributes): * lisp/vc/add-log.el (change-log-acknowledgement): * lisp/vc/ediff-wind.el (ediff-choose-window-setup-function-automatically): * lisp/vc/pcvs-util.el (cvs-string-prefix-p): * lisp/vc/vc.el (vc-string-prefix-p): * lisp/window.el (display-buffer-function): * lisp/winner.el (winner-mode-leave-hook): Remove many functions and variables obsolete since 24.3. * lisp/buff-menu.el (list-buffers--refresh): * lisp/dired.el (dired-mode-map): * lisp/files.el (abbreviate-file-name): * lisp/generic-x.el (generic-default-modes): * lisp/mh-e/mh-funcs.el (mh-kill-folder): * lisp/progmodes/hideif.el (hide-ifdef-mode-submap): * lisp/replace.el (query-replace-read-from): * lisp/term.el (term): * lisp/window.el (display-buffer): Don't use above deleted functions and variables. * src/marker.c (Fbuffer_has_markers_at): Delete DEFUN obsolete since 24.3. (syms_of_marker) : Delete defsubr. * lisp/subr.el (buffer-has-markers-at): Remove obsoletion of above deleted DEFUN. * etc/TODO: Doc fix; don't mention above deleted function. * admin/cus-test.el (cus-test-get-options): * lisp/pcomplete.el: Doc fixes; don't mention removed items. ; * etc/NEWS: List removed items. --- admin/cus-test.el | 2 +- etc/NEWS | 107 ++++++++++++++++------- etc/TODO | 4 +- lisp/allout.el | 8 -- lisp/arc-mode.el | 2 - lisp/buff-menu.el | 18 ---- lisp/calendar/timeclock.el | 9 -- lisp/cedet/semantic/db-el.el | 3 - lisp/cedet/semantic/db-file.el | 2 - lisp/cedet/semantic/edit.el | 8 -- lisp/cedet/semantic/lex.el | 2 - lisp/comint.el | 10 --- lisp/custom.el | 2 - lisp/dired.el | 36 -------- lisp/ebuff-menu.el | 3 - lisp/emacs-lisp/byte-run.el | 43 ---------- lisp/emacs-lisp/checkdoc.el | 4 - lisp/emacs-lisp/cl-lib.el | 6 -- lisp/emacs-lisp/edebug.el | 3 - lisp/erc/erc-dcc.el | 3 - lisp/eshell/esh-mode.el | 3 - lisp/eshell/eshell.el | 11 --- lisp/faces.el | 9 -- lisp/files.el | 22 +---- lisp/filesets.el | 2 - lisp/frame.el | 4 - lisp/generic-x.el | 7 -- lisp/gnus/gnus-start.el | 2 - lisp/gnus/nndiary.el | 6 -- lisp/htmlfontify.el | 1 - lisp/international/mule-cmds.el | 12 --- lisp/international/quail.el | 6 -- lisp/international/robin.el | 6 -- lisp/leim/quail/hangul.el | 4 - lisp/leim/quail/uni-input.el | 4 - lisp/mail/emacsbug.el | 2 - lisp/mh-e/mh-e.el | 2 - lisp/mh-e/mh-funcs.el | 2 +- lisp/mpc.el | 2 - lisp/net/rcirc.el | 8 -- lisp/obsolete/crisp.el | 3 - lisp/pcomplete.el | 15 +--- lisp/proced.el | 3 + lisp/progmodes/cc-mode.el | 2 - lisp/progmodes/hideif.el | 4 +- lisp/progmodes/python.el | 34 -------- lisp/progmodes/sh-script.el | 8 -- lisp/replace.el | 186 +++++++++++++++++++--------------------- lisp/strokes.el | 3 - lisp/subr.el | 6 -- lisp/term.el | 19 +--- lisp/textmodes/tex-mode.el | 6 -- lisp/url/url-parse.el | 11 --- lisp/vc/add-log.el | 2 - lisp/vc/ediff-wind.el | 8 -- lisp/vc/pcvs-util.el | 2 - lisp/vc/vc.el | 2 - lisp/window.el | 78 ++++++----------- lisp/winner.el | 3 - src/marker.c | 18 ---- 60 files changed, 207 insertions(+), 596 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/admin/cus-test.el b/admin/cus-test.el index 5894abed3df..22d5a3a1516 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -272,7 +272,7 @@ currently defined groups." (if group (memq symbol groups) (or - ;; (user-variable-p symbol) + ;; (custom-variable-p symbol) (get symbol 'standard-value) ;; (get symbol 'saved-value) (get symbol 'custom-type))) diff --git a/etc/NEWS b/etc/NEWS index bf24665ee4f..7005e290b33 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2621,55 +2621,102 @@ but switching to `ash` is generally much preferable. --- ** Some functions and variables obsolete since Emacs 24 have been removed: +'Buffer-menu-buffer+size-width', 'Electric-buffer-menu-mode', 'Info-edit-map', 'allout-abbreviate-flattened-numbering', -'allout-mode-deactivate-hook', 'ansi-color-unfontify-region', -'auth-source-forget-user-or-password', 'auth-source-hide-passwords', -'auth-source-user-or-password', 'bibtex-complete', -'bibtex-entry-field-alist', 'buffer-substring-filters', -'byte-compile-disable-print-circle', 'cfengine-mode-abbrevs', -'chart-map', 'comint-dynamic-complete', -'comint-dynamic-complete-as-filename', -'comint-dynamic-simple-complete', 'command-history-map', -'compilation-parse-errors-function', 'completion-annotate-function', -'condition-case-no-debug', 'count-lines-region', 'data-debug-map', -'deferred-action-list', 'deferred-action-function', -'dired-x-submit-report', 'eieio-defgeneric', 'eieio-defmethod', -'emacs-lock-from-exiting', 'erc-complete-word', -'eshell-cmpl-suffix-list', 'eshell-for', 'font-lock-maximum-size', +'allout-exposure-change-hook', 'allout-mode-deactivate-hook', +'allout-structure-added-hook', 'allout-structure-deleted-hook', +'allout-structure-shifted-hook', 'ansi-color-unfontify-region', +'archive-extract-hooks', 'auth-source-forget-user-or-password', +'auth-source-hide-passwords', 'auth-source-user-or-password', +'automatic-hscrolling', 'automount-dir-prefix', 'bibtex-complete', +'bibtex-entry-field-alist', 'buffer-has-markers-at', +'buffer-substring-filters', 'byte-compile-disable-print-circle', +'c-prepare-bug-report-hooks', 'cfengine-mode-abbrevs', +'change-log-acknowledgement', 'chart-map', +'checkdoc-comment-style-hooks', 'comint--unquote&expand-filename', +'comint-dynamic-complete', 'comint-dynamic-complete-as-filename', +'comint-dynamic-simple-complete', 'comint-unquote-filename', +'command-history-map', 'compilation-parse-errors-function', +'completion-annotate-function', 'condition-case-no-debug', +'count-lines-region', 'crisp-mode-modeline-string', +'custom-print-functions', 'custom-print-functions', +'cvs-string-prefix-p', 'data-debug-map', 'deferred-action-function', +'deferred-action-list', 'dired-pop-to-buffer', 'dired-shrink-to-fit', +'dired-sort-set-modeline', 'dired-x-submit-report', +'display-buffer-function', +'ediff-choose-window-setup-function-automatically', +'eieio-defgeneric', 'eieio-defmethod', 'emacs-lock-from-exiting', +'erc-complete-word', 'erc-dcc-chat-filter-hook', +'eshell-add-to-window-buffer-names', 'eshell-cmpl-suffix-list', +'eshell-for', 'eshell-remove-from-window-buffer-names', +'eshell-status-in-modeline', 'filesets-cache-fill-content-hooks', +'font-list-limit', 'font-lock-maximum-size', 'font-lock-reference-face', 'gnus-carpal', 'gnus-debug-exclude-variables', 'gnus-debug-files', 'gnus-local-domain', 'gnus-outgoing-message-group', -'gnus-secondary-servers', 'gnus-registry-user-format-function-M', +'gnus-registry-user-format-function-M', 'gnus-secondary-servers', +'gnus-subscribe-newsgroup-hooks', 'gud-inhibit-global-bindings', +'hangul-input-method-inactivate', 'hfy-post-html-hooks', 'image-extension-data', 'image-library-alist', +'inactivate-current-input-method-function', 'inactivate-input-method', 'inhibit-first-line-modes-regexps', -'inhibit-first-line-modes-suffixes', 'intdos', -'mail-complete-function', 'mail-completion-at-point-function', +'inhibit-first-line-modes-suffixes', 'input-method-inactivate-hook', +'intdos', 'javascript-generic-mode', 'javascript-generic-mode-hook', +'latex-string-prefix-p', 'macro-declaration-function' (function), +'macro-declaration-function' (variable), 'mail-complete-function', +'mail-completion-at-point-function', 'mail-mailer-swallows-blank-line', 'mail-sent-via', 'make-register', 'makefile-complete', 'menu-bar-kill-ring-save', 'meta-complete-symbol', 'meta-mode-map', +'mh-kill-folder-suppress-prompt-hooks', 'minibuffer-completing-symbol', 'minibuffer-local-filename-must-match-map', 'mode25', 'mode4350', -'msb-after-load-hooks', 'nnimap-split-rule', 'nntp-authinfo-file', -'ns-alternatives-map', 'ns-store-cut-buffer-internal', -'package-menu-view-commentary', 'pascal-last-completions', -'pascal-show-completions', 'pascal-toggle-completions', -'prolog-char-quote-workaround', 'read-filename-at-point', +'mpc-string-prefix-p', 'msb-after-load-hooks', +'nndiary-request-accept-article-hooks', +'nndiary-request-create-group-hooks', +'nndiary-request-update-info-hooks', 'nnimap-split-rule', +'nntp-authinfo-file', 'ns-alternatives-map', +'ns-store-cut-buffer-internal', 'package-menu-view-commentary', +'pascal-last-completions', 'pascal-show-completions', +'pascal-toggle-completions', 'pcomplete-arg-quote-list', +'pcomplete-quote-argument', 'prolog-char-quote-workaround', +'python-buffer, 'python-guess-indent', 'python-indent', +'python-info-ppss-comment-or-string-p', 'python-info-ppss-context', +'python-info-ppss-context-type', 'python-preoutput-result', +'python-proc', 'python-send-receive', 'python-send-string', +'python-use-skeletons', 'quail-inactivate', 'quail-inactivate-hook', +'query-replace-interactive', 'rcirc-activity-hooks', +'rcirc-print-hooks', 'rcirc-receive-message-hooks', +'rcirc-sentinel-hooks', 'read-filename-at-point', 'redraw-modeline', 'reftex-index-map', 'reftex-index-phrases-map', 'reftex-select-bib-map', 'reftex-select-label-map', 'reftex-toc-map', -'register-name-alist', 'register-value', +'register-name-alist', 'register-value', 'report-emacs-bug-info', 'report-emacs-bug-pretest-address', 'rmail-default-dont-reply-to-names', 'rmail-dont-reply-to', -'rmail-dont-reply-to-names', 'rst-block-face', 'rst-comment-face', +'rmail-dont-reply-to-names', 'robin-inactivate', +'robin-inactivate-hook', 'rst-block-face', 'rst-comment-face', 'rst-definition-face', 'rst-directive-face', 'rst-emphasis1-face', 'rst-emphasis2-face', 'rst-external-face', 'rst-literal-face', -'rst-reference-face', 'semantic-grammar-map', -'semantic-grammar-syntax-table', 'set-register-value', -'speedbar-key-map', 'speedbar-syntax-table', -'starttls-any-program-available', 'strokes-report-bug', +'rst-reference-face', 'semantic-change-hooks', +'semantic-edits-delete-change-hooks', +'semantic-edits-new-change-hooks', +'semantic-edits-reparse-change-hooks', 'semantic-grammar-map', +'semantic-grammar-syntax-table', 'semantic-lex-reset-hooks', +'semanticdb-elisp-sym-function-arglist', +'semanticdb-save-database-hooks', 'set-face-underline-p', +'set-register-value', 'sh-maybe-here-document', 'speedbar-key-map', +'speedbar-syntax-table', 'starttls-any-program-available', +'strokes-modeline-string', 'strokes-report-bug', +'term-default-bg-color', 'term-default-fg-color', +'tex-string-prefix-p', 'timeclock-modeline-display', +'timeclock-modeline-display', 'timeclock-update-modeline', 'toggle-emacs-lock', 'tooltip-use-echo-area', 'turn-on-cwarn-mode', -'turn-on-iimage-mode', 'vc-toggle-read-only', 'view-return-to-alist', +'turn-on-iimage-mode', 'ucs-input-inactivate', 'ucs-insert', +'url-recreate-url-attributes', 'user-variable-p', +'vc-string-prefix-p', 'vc-toggle-read-only', 'view-return-to-alist', 'view-return-to-alist-update', 'w32-default-color-map' (function), -'which-func-mode' (function), 'x-cut-buffer-or-selection-value'. +'which-func-mode' (function), 'winner-mode-leave-hook', +'x-cut-buffer-or-selection-value'. --- ** Some functions and variables obsolete since Emacs 23 have been removed: diff --git a/etc/TODO b/etc/TODO index a086470ef5c..5a89c47a9c1 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1481,8 +1481,8 @@ Markers are implemented as a non-sorted singly linked list of markers. This makes them scale badly when thousands of markers are created in a buffer for some purpose, because some low-level primitives in Emacs traverse the markers' list (e.g., when converting between character -and byte positions), and also because searching for a marker (e.g., -with 'buffer-has-markers-at') becomes very slow. +and byte positions), and also because searching for a marker becomes +very slow. **** Explore whether overlay-recenter can cure overlays performance problems diff --git a/lisp/allout.el b/lisp/allout.el index fb922608b0d..5f7087829e2 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1352,8 +1352,6 @@ their settings before `allout-mode' was started." "Symbol for use as allout invisible-text overlay category.") ;;;_ = allout-exposure-change-functions -(define-obsolete-variable-alias 'allout-exposure-change-hook - 'allout-exposure-change-functions "24.3") (defcustom allout-exposure-change-functions nil "Abnormal hook run after allout outline subtree exposure changes. It is run at the conclusion of `allout-flag-region'. @@ -1370,8 +1368,6 @@ This hook might be invoked multiple times by a single command." :version "24.3") ;;;_ = allout-structure-added-functions -(define-obsolete-variable-alias 'allout-structure-added-hook - 'allout-structure-added-functions "24.3") (defcustom allout-structure-added-functions nil "Abnormal hook run after adding items to an Allout outline. Functions on the hook should take two arguments: @@ -1385,8 +1381,6 @@ This hook might be invoked multiple times by a single command." :version "24.3") ;;;_ = allout-structure-deleted-functions -(define-obsolete-variable-alias 'allout-structure-deleted-hook - 'allout-structure-deleted-functions "24.3") (defcustom allout-structure-deleted-functions nil "Abnormal hook run after deleting subtrees from an Allout outline. Functions on the hook must take two arguments: @@ -1403,8 +1397,6 @@ This hook might be invoked multiple times by a single command." :version "24.3") ;;;_ = allout-structure-shifted-functions -(define-obsolete-variable-alias 'allout-structure-shifted-hook - 'allout-structure-shifted-functions "24.3") (defcustom allout-structure-shifted-functions nil "Abnormal hook run after shifting items in an Allout outline. Functions on the hook should take two arguments: diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 632ae578523..b6f7794e337 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -125,8 +125,6 @@ A non-local file is one whose file name is not proper outside Emacs. A local copy of the archive will be used when updating." :type 'regexp) -(define-obsolete-variable-alias 'archive-extract-hooks - 'archive-extract-hook "24.3") (defcustom archive-extract-hook nil "Hook run when an archive member has been extracted." :type 'hook) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 539ef673f0b..abf152f058c 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -54,21 +54,6 @@ :group 'Buffer-menu) (put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer) -(defcustom Buffer-menu-buffer+size-width nil - "Combined width of buffer name and size columns in Buffer Menu. -If nil, use `Buffer-menu-name-width' and `Buffer-menu-size-width'. - -If non-nil, the value of `Buffer-menu-name-width' is overridden; -the name column is assigned width `Buffer-menu-buffer+size-width' -minus `Buffer-menu-size-width'. This use is deprecated." - :type '(choice (const nil) number) - :group 'Buffer-menu - :version "24.3") - -(make-obsolete-variable 'Buffer-menu-buffer+size-width - "use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead." - "24.3") - (defun Buffer-menu--dynamic-name-width (buffers) "Return a name column width based on the current window width. The width will never exceed the actual width of the buffer names, @@ -679,9 +664,6 @@ means list those buffers and no others." (setq name-width (if (functionp Buffer-menu-name-width) (funcall Buffer-menu-name-width (mapcar #'car entries)) Buffer-menu-name-width)) - ;; Handle obsolete variable: - (if Buffer-menu-buffer+size-width - (setq name-width (- Buffer-menu-buffer+size-width size-width))) (setq tabulated-list-format (vector '("C" 1 t :pad-right 0) '("R" 1 t :pad-right 0) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 6b6cc517a20..e36119984be 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -137,9 +137,6 @@ This variable only has effect if set with \\[customize]." (defvar timeclock-update-timer nil "The timer used to update `timeclock-mode-string'.") -(define-obsolete-variable-alias 'timeclock-modeline-display - 'timeclock-mode-line-display "24.3") - ;; For byte-compiler. (defvar display-time-hook) (defvar timeclock-mode-line-display) @@ -259,9 +256,6 @@ The time is bracketed by <> if you are clocked in, otherwise by [].") ;;; User Functions: -(define-obsolete-function-alias 'timeclock-modeline-display - 'timeclock-mode-line-display "24.3") - ;;;###autoload (define-minor-mode timeclock-mode-line-display "Toggle display of the amount of time left today in the mode line. @@ -612,9 +606,6 @@ arguments of `completing-read'." "Ask the user for the reason they are clocking out." (completing-read "Reason for clocking out: " timeclock-reason-list)) -(define-obsolete-function-alias 'timeclock-update-modeline - 'timeclock-update-mode-line "24.3") - (defun timeclock-update-mode-line () "Update the `timeclock-mode-string' displayed in the mode line. The value of `timeclock-relative' affects the display as described in diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 02ebde40785..f72e2069089 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -342,9 +342,6 @@ Return a list of tags." ) taglst)))) -(define-obsolete-function-alias 'semanticdb-elisp-sym-function-arglist - #'help-function-arglist "24.3") - (provide 'semantic/db-el) ;;; semantic/db-el.el ends here diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index e2c9d618ba2..0fc6806e403 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -70,8 +70,6 @@ passes a list of predicates in `semanticdb-project-predicate-functions'." :type '(repeat (choice (string :tag "Directory") (const never) (const always) (const project)))) -(define-obsolete-variable-alias 'semanticdb-save-database-hooks - 'semanticdb-save-database-functions "24.3") (defcustom semanticdb-save-database-functions nil "Abnormal hook run after a database is saved. Each function is called with one argument, the object representing diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index 4679500ed99..7cb6768f7e1 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -72,8 +72,6 @@ updated in the current buffer. For language specific hooks, make sure you define this as a local hook.") -(define-obsolete-variable-alias 'semantic-change-hooks - 'semantic-change-functions "24.3") (defvar semantic-change-functions '(semantic-edits-change-function-handle-changes) "Abnormal hook run when semantic detects a change in a buffer. @@ -91,14 +89,10 @@ If the hook returns non-nil, then declare that a reparse is needed. For language specific hooks, make sure you define this as a local hook. Not used yet; part of the next generation reparse mechanism.") -(define-obsolete-variable-alias 'semantic-edits-new-change-hooks - 'semantic-edits-new-change-functions "24.3") (defvar semantic-edits-new-change-functions nil "Abnormal hook run when a new change is found. Functions must take one argument representing an overlay on that change.") -(define-obsolete-variable-alias 'semantic-edits-delete-change-hooks - 'semantic-edits-delete-change-functions "24.3") (defvar semantic-edits-delete-change-functions nil "Abnormal hook run before a change overlay is deleted. Deleted changes occur when multiple changes are merged. @@ -110,8 +104,6 @@ Changes move when a new change overlaps an old change. The old change will be moved. Functions must take one argument representing an overlay being moved.") -(define-obsolete-variable-alias 'semantic-edits-reparse-change-hooks - 'semantic-edits-reparse-change-functions "24.3") (defvar semantic-edits-reparse-change-functions nil "Abnormal hook run after a change results in a reparse. Functions are called before the overlay is deleted, and after the diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 75c4ee328d6..b3c9e96538c 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -718,8 +718,6 @@ This is an alist of (ANCHOR . STREAM) elements where ANCHOR is the start position of the block, and STREAM is the list of tokens in that block.") -(define-obsolete-variable-alias 'semantic-lex-reset-hooks - 'semantic-lex-reset-functions "24.3") (defvar semantic-lex-reset-functions nil "Abnormal hook used by major-modes to reset lexical analyzers. Hook functions are called with START and END values for the diff --git a/lisp/comint.el b/lisp/comint.el index 3ed04f098c7..8786c6db4b3 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3268,8 +3268,6 @@ See `comint-word'." (defun comint--unquote-argument (str) (car (comint--unquote&requote-argument str))) -(define-obsolete-function-alias 'comint--unquote&expand-filename - #'comint--unquote-argument "24.3") (defun comint-match-partial-filename () "Return the unquoted&expanded filename at point, or nil if none is found. @@ -3290,14 +3288,6 @@ Magic characters are those in `comint-file-name-quote-list'." (setq i (1+ (match-end 0))))) filename)))) -(defun comint-unquote-filename (filename) - "Return FILENAME with quoted characters unquoted." - (declare (obsolete nil "24.3")) - (if (null comint-file-name-quote-list) - filename - (save-match-data - (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t)))) - (defun comint--requote-argument (upos qstr) ;; See `completion-table-with-quoting'. (let ((res (comint--unquote&requote-argument qstr upos))) diff --git a/lisp/custom.el b/lisp/custom.el index 96dfb37d862..352b5b0e160 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -674,8 +674,6 @@ property, or (ii) an alias for another customizable variable." "Return the standard value of VARIABLE." (eval (car (get variable 'standard-value)) t)) -(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3") - (defun custom-note-var-changed (variable) "Inform Custom that VARIABLE has been set (changed). VARIABLE is a symbol that names a user option. diff --git a/lisp/dired.el b/lisp/dired.el index facfb35ab45..b9e89292e25 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -508,15 +508,6 @@ This is what the do-commands look for, and what the mark-commands store.") (defvar dired-del-marker ?D "Character used to flag files for deletion.") -(defvar dired-shrink-to-fit t - ;; I see no reason ever to make this nil -- rms. - ;; (> baud-rate search-slow-speed) - "Non-nil means Dired shrinks the display buffer to fit the marked files.") -(make-obsolete-variable 'dired-shrink-to-fit - "use the Customization interface to add a new rule -to `display-buffer-alist' where condition regexp is \"^ \\*Marked Files\\*$\", -action argument symbol is `window-height' and its value is nil." "24.3") - (defvar dired-file-version-alist) ;;;###autoload @@ -2259,8 +2250,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." "M-s f C-M-s" #'dired-isearch-filenames-regexp ;; misc " " #'dired-toggle-read-only - ;; `toggle-read-only' is an obsolete alias for `read-only-mode' - " " #'dired-toggle-read-only "?" #'dired-summary "DEL" #'dired-unmark-backward " " #'dired-undo @@ -3879,28 +3868,6 @@ or \"* [3 files]\"." (format "[next %d files]" arg) (format "%c [%d files]" dired-marker-char count))))) -(defun dired-pop-to-buffer (buf) - "Pop up buffer BUF in a way suitable for Dired." - (declare (obsolete pop-to-buffer "24.3")) - (let ((split-window-preferred-function - (lambda (window) - (or (and (let ((split-height-threshold 0)) - (window-splittable-p (selected-window))) - ;; Try to split the selected window vertically if - ;; that's possible. (Bug#1806) - (split-window-below)) - ;; Otherwise, try to split WINDOW sensibly. - (split-window-sensibly window)))) - pop-up-frames) - (pop-to-buffer (get-buffer-create buf))) - ;; See Bug#12281. - (set-window-start nil (point-min)) - ;; If dired-shrink-to-fit is t, make its window fit its contents. - (when dired-shrink-to-fit - ;; Try to not delete window when we want to display less than - ;; `window-min-height' lines. - (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t))) - (defcustom dired-no-confirm nil "A list of symbols for commands Dired should not confirm, or t. Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress', @@ -4590,9 +4557,6 @@ Possible values: (t (concat "Dired " dired-actual-switches)))))) (force-mode-line-update))) -(define-obsolete-function-alias 'dired-sort-set-modeline - #'dired-sort-set-mode-line "24.3") - (defun dired-sort-toggle-or-edit (&optional arg) "Toggle sorting by date, and refresh the Dired buffer. With a prefix argument, edit the current listing switches instead." diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 2b1fc916d9f..809a31d4573 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -203,9 +203,6 @@ See the documentation of `electric-buffer-list' for details." (setq mode-line-buffer-identification "Electric Buffer List") (setq-local Helper-return-blurb "return to buffer editing")) -(define-obsolete-function-alias 'Electric-buffer-menu-mode - #'electric-buffer-menu-mode "24.3") - ;; generally the same as Buffer-menu-mode-map ;; (except we don't indirect to global-map) (put 'Electric-buffer-menu-undefined 'suppress-keymap t) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 9a56ba0f7ad..9db84c31b88 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -112,44 +112,6 @@ So far, FUNCTION can only be a symbol, not a lambda expression." (function-put 'defmacro 'doc-string-elt 3) (function-put 'defmacro 'lisp-indent-function 2) -;; `macro-declaration-function' are both obsolete (as marked at the end of this -;; file) but used in many .elc files. - -;; We don't use #' here, because it's an obsolete function, and we -;; can't use `with-suppressed-warnings' here due to how this file is -;; used in the bootstrapping process. -(defvar macro-declaration-function 'macro-declaration-function - "Function to process declarations in a macro definition. -The function will be called with two args MACRO and DECL. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The value the function returns is not used.") - -(defalias 'macro-declaration-function - #'(lambda (macro decl) - "Process a declaration found in a macro definition. -This is set as the value of the variable `macro-declaration-function'. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The return value of this function is not used." - ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. - (let (d) - ;; Ignore the first element of `decl' (it's always `declare'). - (while (setq decl (cdr decl)) - (setq d (car decl)) - (if (and (consp d) - (listp (cdr d)) - (null (cdr (cdr d)))) - (cond ((eq (car d) 'indent) - (put macro 'lisp-indent-function (car (cdr d)))) - ((eq (car d) 'debug) - (put macro 'edebug-form-spec (car (cdr d)))) - ((eq (car d) 'doc-string) - (put macro 'doc-string-elt (car (cdr d)))) - (t - (message "Unknown declaration %s" d))) - (message "Invalid declaration %s" d)))))) - ;; We define macro-declaration-alist here because it is needed to ;; handle declarations in macro definitions and this is the first file ;; loaded by loadup.el that uses declarations in macros. We specify @@ -771,9 +733,4 @@ type is. This defaults to \"INFO\"." ;; (file-format emacs19))" ;; nil) -(make-obsolete-variable 'macro-declaration-function - 'macro-declarations-alist "24.3") -(make-obsolete 'macro-declaration-function - 'macro-declarations-alist "24.3") - ;;; byte-run.el ends here diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index a5ab3a50ff2..20d64b59158 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -281,8 +281,6 @@ Currently, all recognized keywords must be on `finder-known-keywords'." :version "25.1" :type 'boolean) -(define-obsolete-variable-alias 'checkdoc-style-hooks - 'checkdoc-style-functions "24.3") (defvar checkdoc-style-functions nil "Hook run after the standard style check is completed. All functions must return nil or a string representing the error found. @@ -292,8 +290,6 @@ Each hook is called with two parameters, (DEFUNINFO ENDPOINT). DEFUNINFO is the return value of `checkdoc-defun-info'. ENDPOINT is the location of end of the documentation string.") -(define-obsolete-variable-alias 'checkdoc-comment-style-hooks - 'checkdoc-comment-style-functions "24.3") (defvar checkdoc-comment-style-functions nil "Hook run after the standard comment style check is completed. Must return nil if no errors are found, or a string describing the diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index a54fa21fa96..b83b44974d3 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -89,12 +89,6 @@ (defvar cl--optimize-speed 1) (defvar cl--optimize-safety 1) -;;;###autoload -(define-obsolete-variable-alias - ;; This alias is needed for compatibility with .elc files that use defstruct - ;; and were compiled with Emacs<24.3. - 'custom-print-functions 'cl-custom-print-functions "24.3") - ;;;###autoload (defvar cl-custom-print-functions nil "This is a list of functions that format user objects for printing. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9de8999fdfd..763848c0c9b 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3791,9 +3791,6 @@ limited by `edebug-print-length' or `edebug-print-level'." ;;; Edebug Minor Mode -(define-obsolete-variable-alias 'gud-inhibit-global-bindings - 'edebug-inhibit-emacs-lisp-mode-bindings "24.3") - (defvar edebug-inhibit-emacs-lisp-mode-bindings nil "If non-nil, inhibit Edebug bindings on the C-x C-a key. By default, loading the `edebug' library causes these bindings to diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index dd70bfb7b70..90a10766c4c 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1108,9 +1108,6 @@ Possible values are: ask, auto, ignore." (pcomplete-here '("auto" "ask" "ignore"))) (defalias 'pcomplete/erc-mode/SREQ #'pcomplete/erc-mode/CREQ) -(define-obsolete-variable-alias 'erc-dcc-chat-filter-hook - 'erc-dcc-chat-filter-functions "24.3") - (defvar erc-dcc-chat-filter-functions '(erc-dcc-chat-parse-output) "Abnormal hook run after parsing (and maybe inserting) a DCC message. Each function is called with two arguments: the ERC process and diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ecbcf88b973..69069183a3f 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -175,9 +175,6 @@ This is used by `eshell-watch-for-password-prompt'." "A function called from beginning of line to skip the prompt." :type '(choice (const nil) function)) -(define-obsolete-variable-alias 'eshell-status-in-modeline - 'eshell-status-in-mode-line "24.3") - (defcustom eshell-status-in-mode-line t "If non-nil, let the user know a command is running in the mode line." :type 'boolean) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 2c472a2afad..e0c927cad41 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -194,17 +194,6 @@ shells such as bash, zsh, rc, 4dos." ;; The following user options modify the behavior of Eshell overall. (defvar eshell-buffer-name) -(defun eshell-add-to-window-buffer-names () - "Add `eshell-buffer-name' to `same-window-buffer-names'." - (declare (obsolete nil "24.3")) - (add-to-list 'same-window-buffer-names eshell-buffer-name)) - -(defun eshell-remove-from-window-buffer-names () - "Remove `eshell-buffer-name' from `same-window-buffer-names'." - (declare (obsolete nil "24.3")) - (setq same-window-buffer-names - (delete eshell-buffer-name same-window-buffer-names))) - (defcustom eshell-load-hook nil "A hook run once Eshell has been loaded." :type 'hook diff --git a/lisp/faces.el b/lisp/faces.el index f1d8f82fec5..e171b32e317 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1001,9 +1001,6 @@ Use `set-face-attribute' to \"unspecify\" underlining." (interactive (read-face-and-attribute :underline)) (set-face-attribute face frame :underline underline)) -(define-obsolete-function-alias 'set-face-underline-p - 'set-face-underline "24.3") - (defun set-face-inverse-video (face inverse-video-p &optional frame) "Specify whether face FACE is in inverse video. @@ -3174,12 +3171,6 @@ also the same size as FACE on FRAME, or fail." (car fonts)) (frame-parameter nil 'font))) -(defcustom font-list-limit 100 - "This variable is obsolete and has no effect." - :type 'integer - :group 'display) -(make-obsolete-variable 'font-list-limit nil "24.3") - (define-obsolete-function-alias 'face-background-pixmap #'face-stipple "29.1") (define-obsolete-function-alias 'set-face-background-pixmap #'set-face-stipple "29.1") diff --git a/lisp/files.el b/lisp/files.el index b084dca8b7d..540bc2a6a85 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2079,12 +2079,6 @@ this function prepends a \"|\" to the final result if necessary." (uniquify--create-file-buffer-advice buf filename) buf)) -(defcustom automount-dir-prefix (purecopy "^/tmp_mnt/") - "Regexp to match the automounter prefix in a directory name." - :group 'files - :type 'regexp) -(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3") - (defvar abbreviated-home-dir nil "Regexp matching the user's homedir at the beginning of file name. The value includes abbreviation according to `directory-abbrev-alist'.") @@ -2092,8 +2086,7 @@ The value includes abbreviation according to `directory-abbrev-alist'.") (defun abbreviate-file-name (filename) "Return a version of FILENAME shortened using `directory-abbrev-alist'. This also substitutes \"~\" for the user's home directory (unless the -home directory is a root directory) and removes automounter prefixes -\(see the variable `automount-dir-prefix'). +home directory is a root directory). When this function is first called, it caches the user's home directory as a regexp in `abbreviated-home-dir', and reuses it @@ -2104,11 +2097,6 @@ started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)." (save-match-data ;FIXME: Why? (if-let ((handler (find-file-name-handler filename 'abbreviate-file-name))) (funcall handler 'abbreviate-file-name filename) - (if (and automount-dir-prefix - (string-match automount-dir-prefix filename) - (file-exists-p (file-name-directory - (substring filename (1- (match-end 0)))))) - (setq filename (substring filename (1- (match-end 0))))) ;; Avoid treating /home/foo as /home/Foo during `~' substitution. (let ((case-fold-search (file-name-case-insensitive-p filename))) ;; If any elt of directory-abbrev-alist matches this name, @@ -6100,14 +6088,6 @@ prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." "Modification-flag cleared")) (set-buffer-modified-p arg)) -(defun toggle-read-only (&optional arg interactive) - "Change whether this buffer is read-only." - (declare (obsolete read-only-mode "24.3")) - (interactive (list current-prefix-arg t)) - (if interactive - (call-interactively 'read-only-mode) - (read-only-mode (or arg 'toggle)))) - (defun insert-file (filename) "Insert contents of file FILENAME into buffer after point. Set mark after the inserted text. diff --git a/lisp/filesets.el b/lisp/filesets.el index 4831bf167dd..aeebd907c35 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -358,8 +358,6 @@ Don't forget to check out `filesets-menu-ensure-use-cached'." :value filesets-be-docile-flag) (sexp :tag "Other" :value nil)))) -(define-obsolete-variable-alias 'filesets-cache-fill-content-hooks - 'filesets-cache-fill-content-hook "24.3") (defcustom filesets-cache-fill-content-hook nil "Hook run when writing the contents of filesets' cache file. diff --git a/lisp/frame.el b/lisp/frame.el index 9476cb0ec46..9361683c28a 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -3048,10 +3048,6 @@ See also `toggle-frame-maximized'." ;; Misc. -;; Only marked as obsolete in 24.3. -(define-obsolete-variable-alias 'automatic-hscrolling - 'auto-hscroll-mode "22.1") - (make-variable-buffer-local 'show-trailing-whitespace) ;; Defined in dispnew.c. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 2c9d1b316e1..bbc90493afe 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -193,7 +193,6 @@ This hook will be installed if the variable hosts-generic-mode java-manifest-generic-mode java-properties-generic-mode - javascript-generic-mode show-tabs-generic-mode vrml-generic-mode) "List of generic modes that are defined by default.") @@ -489,12 +488,6 @@ like an INI file. You can add this hook to `find-file-hook'." nil "Generic mode for Sys V pkginfo files.")) -;; Javascript mode -;; Obsolete; defer to js-mode from js.el. -(when (memq 'javascript-generic-mode generic-extras-enable-list) - (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") - (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) - ;; VRML files (when (memq 'vrml-generic-mode generic-extras-enable-list) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 7700e6bd430..8d9e50059fd 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -294,8 +294,6 @@ claim them." function (repeat function))) -(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks - 'gnus-subscribe-newsgroup-functions "24.3") (defcustom gnus-subscribe-newsgroup-functions nil "Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 27204b3618a..ab9c6dd74f9 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -165,22 +165,16 @@ In order to make this clear, here are some examples: :type 'boolean) -(define-obsolete-variable-alias 'nndiary-request-create-group-hooks - 'nndiary-request-create-group-functions "24.3") (defcustom nndiary-request-create-group-functions nil "Hook run after `nndiary-request-create-group' is executed. The hook functions will be called with the full group name as argument." :type 'hook) -(define-obsolete-variable-alias 'nndiary-request-update-info-hooks - 'nndiary-request-update-info-functions "24.3") (defcustom nndiary-request-update-info-functions nil "Hook run after `nndiary-request-update-info' is executed. The hook functions will be called with the full group name as argument." :type 'hook) -(define-obsolete-variable-alias 'nndiary-request-accept-article-hooks - 'nndiary-request-accept-article-functions "24.3") (defcustom nndiary-request-accept-article-functions nil "Hook run before accepting an article. Executed near the beginning of `nndiary-request-accept-article'. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index bf7446f151a..b1fdbd2c4a3 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -226,7 +226,6 @@ to make them safe." :tag "html-quote-regex" :type '(regexp)) -(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook "24.3") (defcustom hfy-post-html-hook nil "List of functions to call after creating and filling the HTML buffer. These functions will be called with the HTML buffer as the current buffer." diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 41376425289..e1d0df6e3ed 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1389,9 +1389,6 @@ Maximum length of the history list is determined by the value of `history-length', which see.") (put 'input-method-history 'permanent-local t) -(define-obsolete-variable-alias - 'inactivate-current-input-method-function - 'deactivate-current-input-method-function "24.3") (defvar-local deactivate-current-input-method-function nil "Function to call for deactivating the current input method. Every input method should set this to an appropriate value when activated. @@ -1524,10 +1521,6 @@ If INPUT-METHOD is nil, deactivate any current input method." (setq current-input-method nil) (force-mode-line-update))))) -(define-obsolete-function-alias - 'inactivate-input-method - 'deactivate-input-method "24.3") - (defun set-input-method (input-method &optional interactive) "Select and activate input method INPUT-METHOD for the current buffer. This also sets the default input method to the one you specify. @@ -1741,10 +1734,6 @@ just activated." :type 'hook :group 'mule) -(define-obsolete-variable-alias - 'input-method-inactivate-hook - 'input-method-deactivate-hook "24.3") - (defcustom input-method-deactivate-hook nil "Normal hook run just after an input method is deactivated. @@ -3254,7 +3243,6 @@ single characters to be treated as standing for themselves." (error "Invalid character")) char)) -(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) (define-key ctl-x-map "8e" (define-keymap diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 4bb6dbcc8e4..e2ba485bbea 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -540,8 +540,6 @@ This function runs the normal hook `quail-deactivate-hook'." (interactive) (quail-activate -1)) -(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3") - (defun quail-activate (&optional arg) "Activate Quail input method. With ARG, activate Quail input method if and only if arg is positive. @@ -583,10 +581,6 @@ While this input method is active, the variable (run-hooks 'quail-activate-hook) (setq-local input-method-function #'quail-input-method))) -(define-obsolete-variable-alias - 'quail-inactivate-hook - 'quail-deactivate-hook "24.3") - (defun quail-exit-from-minibuffer () (deactivate-input-method) (if (<= (minibuffer-depth) 1) diff --git a/lisp/international/robin.el b/lisp/international/robin.el index 4c498d7f923..9f0ff80e62e 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -393,8 +393,6 @@ A nil value means no package is selected.") (interactive) (robin-activate -1)) -(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3") - (defun robin-activate (&optional arg) "Activate robin input method. @@ -423,10 +421,6 @@ While this input method is active, the variable 'robin-activate-hook) (setq-local input-method-function 'robin-input-method))) -(define-obsolete-variable-alias - 'robin-inactivate-hook - 'robin-deactivate-hook "24.3") - (defun robin-exit-from-minibuffer () (deactivate-input-method) (if (<= (minibuffer-depth) 1) diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index 83fee1e04c3..89b9abe137e 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -537,10 +537,6 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'." (setq describe-current-input-method-function nil)) (kill-local-variable 'input-method-function))) -(define-obsolete-function-alias - 'hangul-input-method-inactivate - #'hangul-input-method-deactivate "24.3") - (defun hangul-input-method-help () "Describe the current Hangul input method." (interactive) diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el index 36d8e6a8404..3f10b873a34 100644 --- a/lisp/leim/quail/uni-input.el +++ b/lisp/leim/quail/uni-input.el @@ -113,10 +113,6 @@ While this input method is active, the variable (interactive) (ucs-input-activate -1)) -(define-obsolete-function-alias - 'ucs-input-inactivate - #'ucs-input-deactivate "24.3") - (defun ucs-input-help () (interactive) (with-output-to-temp-buffer "*Help*" diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index d72809b186d..a85ceaf1a5a 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -414,8 +414,6 @@ copy text to your preferred mail program.\n" system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point)))) -(define-obsolete-function-alias 'report-emacs-bug-info #'info-emacs-bug "24.3") - (defun report-emacs-bug-hook () "Do some checking before sending a bug report." (goto-char (point-max)) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index f6031df9c24..0ad934107d3 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -3183,8 +3183,6 @@ function used to insert the signature with :group 'mh-letter :package-version '(MH-E . "8.0")) -(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks - 'mh-kill-folder-suppress-prompt-functions "24.3") (defcustom mh-kill-folder-suppress-prompt-functions '(mh-search-p) "Abnormal hook run at the beginning of \\\\[mh-kill-folder]. diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index ab89ef2a3d1..4956d9b59fd 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -101,7 +101,7 @@ a non-nil value to suppress the normal prompt when you remove a folder. This is useful for folders that are easily regenerated." (interactive) (if (or (run-hook-with-args-until-success - 'mh-kill-folder-suppress-prompt-hooks) + 'mh-kill-folder-suppress-prompt-functions) (yes-or-no-p (format "Remove folder %s (and all included messages)? " mh-current-folder))) (let ((folder mh-current-folder) diff --git a/lisp/mpc.el b/lisp/mpc.el index ba95308bf67..1775e7d5e72 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -182,8 +182,6 @@ numerically rather than lexicographically." (abs res)) res)))))))) -(define-obsolete-function-alias 'mpc-string-prefix-p #'string-prefix-p "24.3") - ;; This can speed up mpc--song-search significantly. The table may grow ;; very large, tho. It's only bounded by the fact that it gets flushed ;; whenever the connection is established; which seems to work OK thanks diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index fcef3f10104..abb67da95f0 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -350,8 +350,6 @@ See `rcirc-bright-nick' face." See `rcirc-dim-nick' face." :type '(repeat string)) -(define-obsolete-variable-alias 'rcirc-print-hooks - 'rcirc-print-functions "24.3") (defcustom rcirc-print-functions nil "Hook run after text is printed. Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." @@ -832,8 +830,6 @@ is moved to after the text inserted. Otherwise the point is not moved." text)) (goto-char old))))) -(define-obsolete-variable-alias 'rcirc-sentinel-hooks - 'rcirc-sentinel-functions "24.3") (defvar rcirc-sentinel-functions nil "Hook functions called when the process sentinel is called. Functions are called with PROCESS and SENTINEL arguments.") @@ -974,8 +970,6 @@ If BUFFER is nil, default to the current buffer." (process-list)) ps)) -(define-obsolete-variable-alias 'rcirc-receive-message-hooks - 'rcirc-receive-message-functions "24.3") (defvar rcirc-receive-message-functions nil "Hook functions run when a message is received from server. Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") @@ -2375,8 +2369,6 @@ With prefix ARG, go to the next low priority buffer with activity." "")))) (rcirc-update-activity-string)) -(define-obsolete-variable-alias 'rcirc-activity-hooks - 'rcirc-activity-functions "24.3") (defvar rcirc-activity-functions nil "Hook to be run when there is channel activity. diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index 8424c42b69c..5e1a278a2c2 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -174,9 +174,6 @@ All the bindings are done here instead of globally to try and be nice to the world.") -(define-obsolete-variable-alias 'crisp-mode-modeline-string - 'crisp-mode-mode-line-string "24.3") - (defcustom crisp-mode-mode-line-string " *CRiSP*" "String to display in the mode line when CRiSP emulation mode is enabled." :type 'string) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 15b9880df85..0e3d1df7814 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -155,9 +155,6 @@ This mirrors the optional behavior of tcsh. A non-nil value is useful if `pcomplete-autolist' is non-nil too." :type 'boolean) -(define-obsolete-variable-alias - 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") - (defcustom pcomplete-man-function #'man "A function to that will be called to display a manual page. It will be passed the name of the command to document." @@ -364,11 +361,10 @@ modified to be an empty string, or the desired separation string." ;;; Alternative front-end using the standard completion facilities. -;; The way pcomplete-parse-arguments, pcomplete-stub, and -;; pcomplete-quote-argument work only works because of some deep -;; hypothesis about the way the completion work. Basically, it makes -;; it pretty much impossible to have completion other than -;; prefix-completion. +;; The way pcomplete-parse-arguments and pcomplete-stub work only +;; works because of some deep hypothesis about the way the completion +;; work. Basically, it makes it pretty much impossible to have +;; completion other than prefix-completion. ;; ;; pcomplete--common-suffix and completion-table-subvert try to work around ;; this difficulty with heuristics, but it's really a hack. @@ -841,9 +837,6 @@ this is `comint-dynamic-complete-functions'." (throw 'pcompleted t) pcomplete-args)))))) -(define-obsolete-function-alias - 'pcomplete-quote-argument #'comint-quote-filename "24.3") - ;; file-system completion lists (defsubst pcomplete-dirs-or-entries (&optional regexp predicate) diff --git a/lisp/proced.el b/lisp/proced.el index 52389beff79..c278cce9dc7 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1766,6 +1766,9 @@ The value returned is the value of the last form in BODY." (save-window-excursion ;; Analogous to `dired-pop-to-buffer' ;; Don't split window horizontally. (Bug#1806) + ;; FIXME: `dired-pop-to-buffer' was removed and replaced with + ;; `dired-mark-pop-up'. Should we just use + ;; `pop-to-buffer' here also? (display-buffer (current-buffer) '(display-buffer-in-direction (direction . bottom) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 9327dbf7758..9309a546dbd 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -3148,8 +3148,6 @@ Key bindings: (message "Using CC Mode version %s" c-version) (c-keep-region-active)) -(define-obsolete-variable-alias 'c-prepare-bug-report-hooks - 'c-prepare-bug-report-hook "24.3") (defvar c-prepare-bug-report-hook nil) ;; Dynamic variables used by reporter. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index d09e1f4cdfe..53788949ea4 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -196,9 +196,7 @@ Effective only if `hide-ifdef-expand-reinclusion-guard' is t." "C" #'hif-clear-all-ifdef-defined "C-q" #'hide-ifdef-toggle-read-only "C-w" #'hide-ifdef-toggle-shadowing - " " #'hide-ifdef-toggle-outside-read-only - ;; `toggle-read-only' is obsoleted by `read-only-mode'. - " " #'hide-ifdef-toggle-outside-read-only) + " " #'hide-ifdef-toggle-outside-read-only) (defcustom hide-ifdef-mode-prefix-key "\C-c@" "Prefix key for all Hide-Ifdef mode commands." diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3247d7ad507..9f9439aac69 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -528,16 +528,6 @@ The type returned can be `comment', `string' or `paren'." (eql (syntax-class (syntax-after (point))) (syntax-class (string-to-syntax ")")))) -(define-obsolete-function-alias - 'python-info-ppss-context #'python-syntax-context "24.3") - -(define-obsolete-function-alias - 'python-info-ppss-context-type #'python-syntax-context-type "24.3") - -(define-obsolete-function-alias - 'python-info-ppss-comment-or-string-p - #'python-syntax-comment-or-string-p "24.3") - (defun python-font-lock-syntactic-face-function (state) "Return syntactic face given STATE." (if (nth 3 state) @@ -953,17 +943,11 @@ It makes underscores and dots word constituent chars.") ;;; Indentation -(define-obsolete-variable-alias - 'python-indent 'python-indent-offset "24.3") - (defcustom python-indent-offset 4 "Default indentation offset for Python." :type 'integer :safe 'integerp) -(define-obsolete-variable-alias - 'python-guess-indent 'python-indent-guess-indent-offset "24.3") - (defcustom python-indent-guess-indent-offset t "Non-nil tells Python mode to guess `python-indent-offset' value." :type 'boolean @@ -3307,17 +3291,11 @@ be asked for their values." "Instead call `python-shell-get-process' and create one if returns nil." "25.1") -(define-obsolete-variable-alias - 'python-buffer 'python-shell-internal-buffer "24.3") - (defvar python-shell-internal-buffer nil "Current internal shell buffer for the current buffer. This is really not necessary at all for the code to work but it's there for compatibility with CEDET.") -(define-obsolete-variable-alias - 'python-preoutput-result 'python-shell-internal-last-output "24.3") - (defvar python-shell-internal-last-output nil "Last output captured by the internal shell. This is really not necessary at all for the code to work but it's @@ -3330,9 +3308,6 @@ there for compatibility with CEDET.") (get-process proc-name) (run-python-internal)))) -(define-obsolete-function-alias - 'python-proc #'python-shell-internal-get-or-create-process "24.3") - (defun python-shell--save-temp-file (string) (let* ((temporary-file-directory (if (file-remote-p default-directory) @@ -3449,12 +3424,6 @@ Returns the output. See `python-shell-send-string-no-output'." (replace-regexp-in-string "_emacs_out +" "" string) (python-shell-internal-get-or-create-process)))) -(define-obsolete-function-alias - 'python-send-receive #'python-shell-internal-send-string "24.3") - -(define-obsolete-function-alias - 'python-send-string #'python-shell-internal-send-string "24.3") - (defun python-shell-buffer-substring (start end &optional nomain no-cookie) "Send buffer substring from START to END formatted for shell. This is a wrapper over `buffer-substring' that takes care of @@ -4620,9 +4589,6 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ;;; Skeletons -(define-obsolete-variable-alias - 'python-use-skeletons 'python-skeleton-autoinsert "24.3") - (defcustom python-skeleton-autoinsert nil "Non-nil means template skeletons will be automagically inserted. This happens when pressing \"if\", for example, to prompt for diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index be9f325d93d..517fbbd8e7b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2982,14 +2982,6 @@ option followed by a colon `:' if the option accepts an argument." (match-string 1)))))) -(defun sh-maybe-here-document (arg) - "Insert self. Without prefix, following unquoted `<' inserts here document. -The document is bounded by `sh-here-document-word'." - (declare (obsolete sh-electric-here-document-mode "24.3")) - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (or arg (sh--maybe-here-document))) - (defun sh--maybe-here-document () (when (and (looking-back "[^<]<<[ E-]" (line-beginning-position)) (save-excursion diff --git a/lisp/replace.el b/lisp/replace.el index 06cde771b9e..6393c092886 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -73,14 +73,6 @@ See `query-replace-from-history-variable' and This is a list of cons cells (FROM-STRING . TO-STRING), or nil if there are no default values.") -(defvar query-replace-interactive nil - "Non-nil means `query-replace' uses the last search string. -That becomes the \"string to replace\".") -(make-obsolete-variable 'query-replace-interactive - "use `M-n' to pull the last incremental search string -to the minibuffer that reads the string to replace, or invoke replacements -from Isearch by using a key sequence like `C-s C-s M-%'." "24.3") - (defcustom query-replace-from-to-separator " → " "String that separates FROM and TO in the history of replacement pairs. When nil, the pair will not be added to the history (same behavior @@ -213,96 +205,94 @@ by this function to the end of values available via Prompt with PROMPT. REGEXP-FLAG non-nil means the response should be a regexp. The return value can also be a pair (FROM . TO) indicating that the user wants to replace FROM with TO." - (if query-replace-interactive - (car (if regexp-flag regexp-search-ring search-ring)) - (let* ((history-add-new-input nil) - (separator-string - (when query-replace-from-to-separator - ;; Check if the first non-whitespace char is displayable - (if (char-displayable-p - (string-to-char (string-replace - " " "" query-replace-from-to-separator))) - query-replace-from-to-separator - " -> "))) - (separator - (when separator-string - (propertize separator-string - 'display separator-string - 'face 'minibuffer-prompt - 'separator t))) - (minibuffer-history - (append - (when separator - (mapcar (lambda (from-to) - (concat (query-replace-descr (car from-to)) - separator - (query-replace-descr (cdr from-to)))) - query-replace-defaults)) - (symbol-value query-replace-from-history-variable))) - (minibuffer-allow-text-properties t) ; separator uses text-properties - (default (when (and query-replace-read-from-default (not regexp-flag)) - (funcall query-replace-read-from-default))) - (prompt - (cond ((and query-replace-read-from-regexp-default regexp-flag) prompt) - (default (format-prompt prompt default)) - ((and query-replace-defaults separator) - (format-prompt prompt (car minibuffer-history))) - (query-replace-defaults - (format-prompt - prompt (format "%s -> %s" - (query-replace-descr - (caar query-replace-defaults)) - (query-replace-descr - (cdar query-replace-defaults))))) - (t (format-prompt prompt nil)))) - (from - ;; The save-excursion here is in case the user marks and copies - ;; a region in order to specify the minibuffer input. - ;; That should not clobber the region for the query-replace itself. - (save-excursion - (minibuffer-with-setup-hook - (lambda () - (setq-local text-property-default-nonsticky - (append '((separator . t) (face . t)) - text-property-default-nonsticky))) - (if regexp-flag - (read-regexp - (if query-replace-read-from-regexp-default - (string-remove-suffix ": " prompt) - prompt) - query-replace-read-from-regexp-default - 'minibuffer-history) - (read-from-minibuffer - prompt nil nil nil nil - (if default - (delete-dups - (cons default (query-replace-read-from-suggestions))) - (query-replace-read-from-suggestions)) - t))))) - (to)) - (if (and (zerop (length from)) query-replace-defaults (not default)) - (cons (caar query-replace-defaults) - (query-replace-compile-replacement - (cdar query-replace-defaults) regexp-flag)) - (setq from (or (and (zerop (length from)) default) - (query-replace--split-string from))) - (when (consp from) (setq to (cdr from) from (car from))) - (add-to-history query-replace-from-history-variable from nil t) - ;; Warn if user types \n or \t, but don't reject the input. - (and regexp-flag - (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) - (let ((match (match-string 3 from))) - (cond - ((string= match "\\n") - (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) - ((string= match "\\t") - (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) - (sit-for 2))) - (if (not to) - from - (add-to-history query-replace-to-history-variable to nil t) - (add-to-history 'query-replace-defaults (cons from to) nil t) - (cons from (query-replace-compile-replacement to regexp-flag))))))) + (let* ((history-add-new-input nil) + (separator-string + (when query-replace-from-to-separator + ;; Check if the first non-whitespace char is displayable + (if (char-displayable-p + (string-to-char (string-replace + " " "" query-replace-from-to-separator))) + query-replace-from-to-separator + " -> "))) + (separator + (when separator-string + (propertize separator-string + 'display separator-string + 'face 'minibuffer-prompt + 'separator t))) + (minibuffer-history + (append + (when separator + (mapcar (lambda (from-to) + (concat (query-replace-descr (car from-to)) + separator + (query-replace-descr (cdr from-to)))) + query-replace-defaults)) + (symbol-value query-replace-from-history-variable))) + (minibuffer-allow-text-properties t) ; separator uses text-properties + (default (when (and query-replace-read-from-default (not regexp-flag)) + (funcall query-replace-read-from-default))) + (prompt + (cond ((and query-replace-read-from-regexp-default regexp-flag) prompt) + (default (format-prompt prompt default)) + ((and query-replace-defaults separator) + (format-prompt prompt (car minibuffer-history))) + (query-replace-defaults + (format-prompt + prompt (format "%s -> %s" + (query-replace-descr + (caar query-replace-defaults)) + (query-replace-descr + (cdar query-replace-defaults))))) + (t (format-prompt prompt nil)))) + (from + ;; The save-excursion here is in case the user marks and copies + ;; a region in order to specify the minibuffer input. + ;; That should not clobber the region for the query-replace itself. + (save-excursion + (minibuffer-with-setup-hook + (lambda () + (setq-local text-property-default-nonsticky + (append '((separator . t) (face . t)) + text-property-default-nonsticky))) + (if regexp-flag + (read-regexp + (if query-replace-read-from-regexp-default + (string-remove-suffix ": " prompt) + prompt) + query-replace-read-from-regexp-default + 'minibuffer-history) + (read-from-minibuffer + prompt nil nil nil nil + (if default + (delete-dups + (cons default (query-replace-read-from-suggestions))) + (query-replace-read-from-suggestions)) + t))))) + (to)) + (if (and (zerop (length from)) query-replace-defaults (not default)) + (cons (caar query-replace-defaults) + (query-replace-compile-replacement + (cdar query-replace-defaults) regexp-flag)) + (setq from (or (and (zerop (length from)) default) + (query-replace--split-string from))) + (when (consp from) (setq to (cdr from) from (car from))) + (add-to-history query-replace-from-history-variable from nil t) + ;; Warn if user types \n or \t, but don't reject the input. + (and regexp-flag + (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) + (let ((match (match-string 3 from))) + (cond + ((string= match "\\n") + (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) + ((string= match "\\t") + (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) + (sit-for 2))) + (if (not to) + from + (add-to-history query-replace-to-history-variable to nil t) + (add-to-history 'query-replace-defaults (cons from to) nil t) + (cons from (query-replace-compile-replacement to regexp-flag)))))) (defun query-replace-compile-replacement (to regexp-flag) "Maybe convert a regexp replacement TO to Lisp. diff --git a/lisp/strokes.el b/lisp/strokes.el index d7a95393166..0edb20c2ebb 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -210,9 +210,6 @@ static char * stroke_xpm[] = { :link '(emacs-commentary-link "strokes") :group 'mouse) -(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter - "24.3") - (defcustom strokes-lighter " Strokes" "Mode line identifier for Strokes mode." :type 'string) diff --git a/lisp/subr.el b/lisp/subr.el index c7b86c83e8c..f4b457556d6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1794,8 +1794,6 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescent names for functions. -(make-obsolete 'buffer-has-markers-at nil "24.3") - (make-obsolete 'invocation-directory "use the variable of the same name." "27.1") (make-obsolete 'invocation-name "use the variable of the same name." "27.1") @@ -3758,10 +3756,6 @@ This finishes the change group by reverting all of its changes." ;;;; Display-related functions. -;; For compatibility. -(define-obsolete-function-alias 'redraw-modeline - #'force-mode-line-update "24.3") - (defun momentary-string-display (string pos &optional exit-char message) "Momentarily display STRING in the buffer at POS. Display remains until next event is input. diff --git a/lisp/term.el b/lisp/term.el index 797fb18074f..755c2202703 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -755,25 +755,8 @@ Buffer local variable.") term-color-bright-cyan term-color-bright-white]) -(defcustom term-default-fg-color nil - "If non-nil, default color for foreground in Term mode." - :group 'term - :type '(choice (const nil) (string :tag "color"))) -(make-obsolete-variable 'term-default-fg-color "use the face `term' instead." - "24.3") - -(defcustom term-default-bg-color nil - "If non-nil, default color for foreground in Term mode." - :group 'term - :type '(choice (const nil) (string :tag "color"))) -(make-obsolete-variable 'term-default-bg-color "use the face `term' instead." - "24.3") - (defface term - `((t - :foreground ,term-default-fg-color - :background ,term-default-bg-color - :inherit default)) + `((t :inherit default)) "Default face to use in Term mode." :group 'term) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index e6c0f8c28c0..f624b604aac 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1596,10 +1596,6 @@ Puts point on a blank line between them." ;;;; LaTeX completion. (defvar latex-complete-bibtex-cache nil) - -(define-obsolete-function-alias 'latex-string-prefix-p - #'string-prefix-p "24.3") - (defvar bibtex-reference-key) (declare-function reftex-get-bibfile-list "reftex-cite.el" ()) @@ -2174,8 +2170,6 @@ IN can be either a string (with the same % escapes in it) indicating OUT describes the output file and is either a %-escaped string or nil to indicate that there is no output file.") -(define-obsolete-function-alias 'tex-string-prefix-p #'string-prefix-p "24.3") - (defun tex-guess-main-file (&optional all) "Find a likely `tex-main-file'. Looks for hints in other buffers in the same directory or in diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 24b064773b8..91f47d0325d 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -96,17 +96,6 @@ If the specified port number is the default, return nil." (or file "/") (if frag (concat "#" frag))))) -(defun url-recreate-url-attributes (urlobj) - "Recreate the attributes of an URL string from the parsed URLOBJ." - (declare (obsolete nil "24.3")) - (when (url-attributes urlobj) - (concat ";" - (mapconcat (lambda (x) - (if (cdr x) - (concat (car x) "=" (cdr x)) - (car x))) - (url-attributes urlobj) ";")))) - ;;;###autoload (defun url-generic-parse-url (url) "Return an URL-struct of the parts of URL. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index d710578ffff..d617d5aebb2 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -208,8 +208,6 @@ a case simply use the directory containing the changed file." '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." :version "21.1") -(define-obsolete-face-alias 'change-log-acknowledgement - 'change-log-acknowledgment "24.3") (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index d45e13ea725..bd2e9f19773 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -36,14 +36,6 @@ :group 'ediff :group 'frames) - -;; Determine which window setup function to use based on current window system. -(defun ediff-choose-window-setup-function-automatically () - (declare (obsolete ediff-setup-windows-default "24.3")) - (if (display-graphic-p) - #'ediff-setup-windows-multiframe - #'ediff-setup-windows-plain)) - (defcustom ediff-window-setup-function #'ediff-setup-windows-default "Function called to set up windows. Ediff provides a choice of three functions: diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 89f8d26880b..ddc3ea6e810 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -164,8 +164,6 @@ arguments. If ARGS is not a list, no argument will be passed." (if oneline (line-end-position) (point-max)))) (file-error nil))) -(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3") - ;;;; ;;;; file names ;;;; diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index d93be951a3c..6df5f3cf7d7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3273,8 +3273,6 @@ to provide the `find-revision' operation instead." ;; These things should probably be generally available -(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3") - (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each VC-managed file f underneath it." diff --git a/lisp/window.el b/lisp/window.el index 9ff55dc9807..67a4a4bbf2f 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6622,24 +6622,6 @@ fourth element is BUFFER." window 'quit-restore (list 'tab 'tab (selected-window) buffer))))) -(defcustom display-buffer-function nil - "If non-nil, function to call to handle `display-buffer'. -It will receive two args, the buffer and a flag which if non-nil -means that the currently selected window is not acceptable. It -should choose or create a window, display the specified buffer in -it, and return the window. - -The specified function should call `display-buffer-record-window' -with corresponding arguments to set up the quit-restore parameter -of the window used." - :type '(choice - (const nil) - (function :tag "function")) - :group 'windows) - -(make-obsolete-variable 'display-buffer-function - 'display-buffer-alist "24.3") - (defcustom pop-up-frame-alist nil "Alist of parameters for automatically generated new frames. If non-nil, the value you specify here is used by the default @@ -7745,38 +7727,34 @@ specified by the ACTION argument." ;; Handle the old form of the first argument. (inhibit-same-window (and action (not (listp action))))) (unless (listp action) (setq action nil)) - (if display-buffer-function - ;; If `display-buffer-function' is defined, let it do the job. - (funcall display-buffer-function buffer inhibit-same-window) - ;; Otherwise, use the defined actions. - (let* ((user-action - (display-buffer-assq-regexp - buffer display-buffer-alist action)) - (special-action (display-buffer--special-action buffer)) - ;; Extra actions from the arguments to this function: - (extra-action - (cons nil (append (if inhibit-same-window - '((inhibit-same-window . t))) - (if frame - `((reusable-frames . ,frame)))))) - ;; Construct action function list and action alist. - (actions (list display-buffer-overriding-action - user-action special-action action extra-action - display-buffer-base-action - display-buffer-fallback-action)) - (functions (apply 'append - (mapcar (lambda (x) - (setq x (car x)) - (if (functionp x) (list x) x)) - actions))) - (alist (apply 'append (mapcar 'cdr actions))) - window) - (unless (buffer-live-p buffer) - (error "Invalid buffer")) - (while (and functions (not window)) - (setq window (funcall (car functions) buffer alist) - functions (cdr functions))) - (and (windowp window) window))))) + (let* ((user-action + (display-buffer-assq-regexp + buffer display-buffer-alist action)) + (special-action (display-buffer--special-action buffer)) + ;; Extra actions from the arguments to this function: + (extra-action + (cons nil (append (if inhibit-same-window + '((inhibit-same-window . t))) + (if frame + `((reusable-frames . ,frame)))))) + ;; Construct action function list and action alist. + (actions (list display-buffer-overriding-action + user-action special-action action extra-action + display-buffer-base-action + display-buffer-fallback-action)) + (functions (apply 'append + (mapcar (lambda (x) + (setq x (car x)) + (if (functionp x) (list x) x)) + actions))) + (alist (apply 'append (mapcar 'cdr actions))) + window) + (unless (buffer-live-p buffer) + (error "Invalid buffer")) + (while (and functions (not window)) + (setq window (funcall (car functions) buffer alist) + functions (cdr functions))) + (and (windowp window) window)))) (defun display-buffer-other-frame (buffer) "Display buffer BUFFER preferably in another frame. diff --git a/lisp/winner.el b/lisp/winner.el index 89f337170cc..4290f1fd239 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -318,9 +318,6 @@ You may want to include buffer names such as *Help*, *Apropos*, "Functions to run whenever Winner mode is turned on or off." :type 'hook) -(define-obsolete-variable-alias 'winner-mode-leave-hook - 'winner-mode-off-hook "24.3") - (defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." :type 'hook) diff --git a/src/marker.c b/src/marker.c index 9727586f424..0ed1e55ddc9 100644 --- a/src/marker.c +++ b/src/marker.c @@ -759,23 +759,6 @@ If TYPE is nil, it means the marker stays behind when you insert text at it. */ return type; } -DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at, - 1, 1, 0, - doc: /* Return t if there are markers pointing at POSITION in the current buffer. */) - (Lisp_Object position) -{ - register struct Lisp_Marker *tail; - register ptrdiff_t charpos; - - charpos = clip_to_bounds (BEG, XFIXNUM (position), Z); - - for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) - if (tail->charpos == charpos) - return Qt; - - return Qnil; -} - #ifdef MARKER_DEBUG /* For debugging -- count the markers in buffer BUF. */ @@ -821,5 +804,4 @@ syms_of_marker (void) defsubr (&Scopy_marker); defsubr (&Smarker_insertion_type); defsubr (&Sset_marker_insertion_type); - defsubr (&Sbuffer_has_markers_at); } -- cgit v1.2.3 From 79ae7b3c874ae9ca77213bfdea13d186ba902961 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 9 Sep 2022 19:16:01 +0200 Subject: Fix typo in byte-compile-lambda warning * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Fix typo in message (bug#57690). --- 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 a16486dc31c..48929e62bdf 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3104,8 +3104,8 @@ lambda-expression." ;; Check that the bit after the `interactive' spec is ;; just a list of symbols (i.e., modes). (unless (seq-every-p #'symbolp (cdr (cdr int))) - (byte-compile-warn-x int "malformed interactive specc: %s" - int)) + (byte-compile-warn-x + int "malformed `interactive' specification: %s" int)) (setq command-modes (cdr (cdr int))) ;; If the interactive spec is a call to `list', don't ;; compile it, because `call-interactively' looks at the -- cgit v1.2.3 From 04a6fd378f0996c14c3cf9e4905f56df231aa500 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 9 Sep 2022 19:29:21 +0200 Subject: Don't bind `s' in the normal backtrace map * lisp/emacs-lisp/backtrace.el (backtrace-mode-map): Don't bind the "s" command, because it's meaningless outside modes that have set the backtrace-goto-source-functions variable (and only edebug does that) (bug#57674). * lisp/emacs-lisp/edebug.el (edebug-pop-to-backtrace): Use it. (edebug-backtrace-mode-map, edebug-backtrace-mode): New mode. --- lisp/emacs-lisp/backtrace.el | 1 - lisp/emacs-lisp/edebug.el | 9 +++++++++ test/lisp/emacs-lisp/edebug-tests.el | 3 ++- 3 files changed, 11 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el index 70473770d16..4ffe6f573c6 100644 --- a/lisp/emacs-lisp/backtrace.el +++ b/lisp/emacs-lisp/backtrace.el @@ -209,7 +209,6 @@ frames where the source code location is known.") "v" #'backtrace-toggle-locals "#" #'backtrace-toggle-print-circle ":" #'backtrace-toggle-print-gensym - "s" #'backtrace-goto-source "RET" #'backtrace-help-follow-symbol "+" #'backtrace-multi-line "-" #'backtrace-single-line diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 763848c0c9b..c916ec431e4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4179,6 +4179,7 @@ from Edebug instrumentation found in the backtrace." (backtrace-mode) (add-hook 'backtrace-goto-source-functions #'edebug--backtrace-goto-source nil t)) + (edebug-backtrace-mode) (setq edebug-instrumented-backtrace-frames (backtrace-get-frames 'edebug-debugger :constructor #'edebug--make-frame) @@ -4255,6 +4256,14 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME." (setf (edebug--frame-before-index frame) before-index) (setf (edebug--frame-after-index frame) after-index)) +(defvar-keymap edebug-backtrace-mode-map + "s" #'backtrace-goto-source) + +(define-minor-mode edebug-backtrace-mode + "Minor mode for showing backtraces from edebug." + :lighter nil + :interactive nil) + (defun edebug--backtrace-goto-source () (let* ((index (backtrace-get-index)) (frame (nth index backtrace-frames))) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 008e1e467ba..dea6e9ed611 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -428,7 +428,8 @@ test and possibly others should be updated." (verify-keybinding "-" 'negative-argument) (verify-keybinding "=" 'edebug-temp-display-freq-count) (should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame)) - (should (eq (lookup-key backtrace-mode-map "s") 'backtrace-goto-source)))) + (should (eq (lookup-key edebug-backtrace-mode-map "s") + 'backtrace-goto-source)))) (ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function () "Edebug stops at the beginning of an instrumented function." -- cgit v1.2.3 From 6cd9e586cc065f02d69c97b23163ec91ccc2b5dd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 10 Sep 2022 07:37:36 +0200 Subject: New function substitute-quotes * lisp/help.el (substitute-quotes): New function. (Bug#51040) * doc/lispref/help.texi (Keys in Documentation): Document substitute-quotes. * test/lisp/help-tests.el (help-tests-substitute-quotes): New test. * lisp/cedet/srecode/srt-mode.el (srecode-macro-help): * lisp/cus-theme.el (describe-theme-1): * lisp/emacs-lisp/cl-extra.el (cl--describe-class): * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): * lisp/emacs-lisp/package.el (describe-package-1): * lisp/help-fns.el (help-fns--parent-mode, help-fns--var-risky) (help-fns--var-file-local, help-fns--var-bufferlocal) (describe-face): * lisp/help.el (substitute-command-keys): * lisp/progmodes/octave.el (octave-help): Use the new function instead of 'substitute-command-keys'. --- doc/lispref/help.texi | 5 ++++ etc/NEWS | 5 ++++ lisp/cedet/srecode/srt-mode.el | 4 ++-- lisp/cus-theme.el | 2 +- lisp/emacs-lisp/cl-extra.el | 10 ++++---- lisp/emacs-lisp/eieio-opt.el | 2 +- lisp/emacs-lisp/package.el | 2 +- lisp/help-fns.el | 18 +++++++-------- lisp/help.el | 16 +++++++++++-- lisp/progmodes/octave.el | 4 ++-- test/lisp/help-tests.el | 52 +++++++++++++++++++++++++++++------------- 11 files changed, 81 insertions(+), 39 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index ac284f745f4..154a7abeb63 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -384,6 +384,11 @@ given a special face @code{help-key-binding}, but if the optional argument @var{no-face} is non-@code{nil}, the function doesn't add this face to the produced string. +@defun substitute-quotes string +This function works like @code{substitute-command-keys}, but only +replaces quote characters. +@end defun + @cindex advertised binding If a command has multiple bindings, this function normally uses the first one it finds. You can specify one particular key binding by diff --git a/etc/NEWS b/etc/NEWS index 35b74aa7de6..ba2f57772c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -144,6 +144,11 @@ and then execute the rest of the script file as Emacs Lisp. When it reaches the end of the script, Emacs will exit with an exit code from the value of the final form. ++++ +** New function 'substitute-quotes'. +This function works like 'substitute-command-keys' but only +substitutes quote characters. + +++ ** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 724a6e0a941..56b482e1001 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -260,9 +260,9 @@ we can tell font lock about them.") (when (class-abstract-p C) (throw 'skip nil)) - (princ (substitute-command-keys "`")) + (princ (substitute-quotes "`")) (princ name) - (princ (substitute-command-keys "'")) + (princ (substitute-quotes "'")) (when (slot-exists-p C 'key) (when key (princ " - Character Key: ") diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 69ec837db88..90680ff68f8 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -496,7 +496,7 @@ It includes all faces in list FACES." (princ (substitute-command-keys " in `")) (help-insert-xref-button (file-name-nondirectory fn) 'help-theme-def fn) - (princ (substitute-command-keys "'"))) + (princ (substitute-quotes "'"))) (princ ".\n") (if (custom-theme-p theme) (progn diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 607810ee141..7c7f027d777 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -772,7 +772,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (help-insert-xref-button (help-fns-short-filename location) 'cl-type-definition type location 'define-type) - (insert (substitute-command-keys "'"))) + (insert (substitute-quotes "'"))) (insert ".\n") ;; Parents. @@ -782,7 +782,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (insert " Inherits from ") (while (setq cur (pop pl)) (setq cur (cl--class-name cur)) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) 'cl-help-type cur) (insert (substitute-command-keys (if pl "', " "'")))) @@ -796,7 +796,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (when ch (insert " Children ") (while (setq cur (pop ch)) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name cur) 'cl-help-type cur) (insert (substitute-command-keys (if ch "', " "'")))) @@ -815,10 +815,10 @@ PROPLIST is a list of the sort returned by `symbol-plist'. (when generics (insert (propertize "Specialized Methods:\n\n" 'face 'bold)) (dolist (generic generics) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) (help-insert-xref-button (symbol-name generic) 'help-function generic) - (insert (substitute-command-keys "'")) + (insert (substitute-quotes "'")) (pcase-dolist (`(,qualifiers ,args ,doc) (cl--generic-method-documentation generic type)) (insert (format " %s%S\n" qualifiers args) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 5f67263f177..b599aabb7f7 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -153,7 +153,7 @@ are not abstract." (help-insert-xref-button (help-fns-short-filename location) 'cl-type-definition ctr location 'define-type) - (insert (substitute-command-keys "'"))) + (insert (substitute-quotes "'"))) (insert ".\nCreates an object of class " (symbol-name ctr) ".") (goto-char (point-max)) (if (autoloadp def) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index ed23ee5f221..bf71447681b 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2648,7 +2648,7 @@ Helper function for `describe-package'." "',\n shadowing a ") (propertize "built-in package" 'font-lock-face 'package-status-built-in)) - (insert (substitute-command-keys "'"))) + (insert (substitute-quotes "'"))) (if signed (insert ".") (insert " (unsigned).")) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index dac4a03cd94..d5b576de285 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -712,13 +712,13 @@ the C sources, too." (get function 'derived-mode-parent)))) (when parent-mode - (insert (substitute-command-keys " Parent mode: `")) + (insert (substitute-quotes " Parent mode: `")) (let ((beg (point))) (insert (format "%s" parent-mode)) (make-text-button beg (point) 'type 'help-function 'help-args (list parent-mode))) - (insert (substitute-command-keys "'.\n"))))) + (insert (substitute-quotes "'.\n"))))) (defun help-fns--obsolete (function) ;; Ignore lambda constructs, keyboard macros, etc. @@ -1559,7 +1559,7 @@ This cancels value editing without updating the value." (princ " This variable may be risky if used as a \ file-local variable.\n") (when (assq variable safe-local-variable-values) - (princ (substitute-command-keys + (princ (substitute-quotes " However, you have added it to \ `safe-local-variable-values'.\n"))))) @@ -1609,8 +1609,8 @@ variable.\n"))) (insert-text-button file 'type 'help-dir-local-var-def 'help-args (list variable file))) - (princ (substitute-command-keys "'.\n")))) - (princ (substitute-command-keys + (princ (substitute-quotes "'.\n")))) + (princ (substitute-quotes " This variable's value is file-local.\n"))))))) (add-hook 'help-fns-describe-variable-functions #'help-fns--var-watchpoints) @@ -1690,10 +1690,10 @@ variable.\n"))) ((not permanent-local)) ((bufferp locus) (princ - (substitute-command-keys + (substitute-quotes " This variable's buffer-local value is permanent.\n"))) (t - (princ (substitute-command-keys + (princ (substitute-quotes " This variable's value is permanent \ if it is given a local binding.\n")))))) @@ -1770,9 +1770,9 @@ If FRAME is omitted or nil, use the selected frame." (setq help-mode--current-data (list :symbol f)) (setq help-mode--current-data (list :symbol f :file file-name)) - (princ (substitute-command-keys "Defined in `")) + (princ (substitute-quotes "Defined in `")) (princ (help-fns-short-filename file-name)) - (princ (substitute-command-keys "'")) + (princ (substitute-quotes "'")) ;; Make a hyperlink to the library. (save-excursion (re-search-backward diff --git a/lisp/help.el b/lisp/help.el index 15ab3192ad7..92b87cf7999 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1260,9 +1260,9 @@ Otherwise, return a new string." (cond ((null this-keymap) (insert "\nUses keymap " - (substitute-command-keys "`") + (substitute-quotes "`") (symbol-name name) - (substitute-command-keys "'") + (substitute-quotes "'") ", which is not currently defined.\n") (unless generate-summary (setq keymap nil))) @@ -1291,6 +1291,18 @@ Otherwise, return a new string." (t (forward-char 1))))) (buffer-string))))) +(defun substitute-quotes (string) + "Substitute quote characters for display. +Each grave accent \\=` is replaced by left quote, and each +apostrophe \\=' is replaced by right quote. Left and right quote +characters are specified by `text-quoting-style'." + (cond ((eq (text-quoting-style) 'curve) + (string-replace "`" "‘" + (string-replace "'" "’" string))) + ((eq (text-quoting-style) 'straight) + (string-replace "`" "'" string)) + (t string))) + (defvar help--keymaps-seen nil) (defun describe-map-tree (startmap &optional partial shadow prefix title no-menu transl always-title mention-shadow diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 721dfa51ad3..18b98991692 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1722,12 +1722,12 @@ code line." (dir (file-name-directory (directory-file-name (file-name-directory file))))) (replace-match "" nil nil nil 1) - (insert (substitute-command-keys "`")) + (insert (substitute-quotes "`")) ;; Include the parent directory which may be regarded as ;; the category for the FN. (help-insert-xref-button (file-relative-name file dir) 'octave-help-file fn) - (insert (substitute-command-keys "'")))) + (insert (substitute-quotes "'")))) ;; Make 'See also' clickable. (with-syntax-table octave-mode-syntax-table (when (re-search-forward "^\\s-*See also:" nil t) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 833c32ffb27..6f1dcfa5b6b 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -200,25 +200,45 @@ M-g M-c switch-to-completions "\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n"))) (ert-deftest help-tests-substitute-command-keys/quotes () - (with-substitute-command-keys-test + (with-substitute-command-keys-test + (let ((text-quoting-style 'curve)) + (test "quotes ‘like this’" "quotes ‘like this’") + (test "`x'" "‘x’") + (test "`" "‘") + (test "'" "’") + (test "\\`" "\\‘")) + (let ((text-quoting-style 'straight)) + (test "quotes `like this'" "quotes 'like this'") + (test "`x'" "'x'") + (test "`" "'") + (test "'" "'") + (test "\\`" "\\'")) + (let ((text-quoting-style 'grave)) + (test "quotes `like this'" "quotes `like this'") + (test "`x'" "`x'") + (test "`" "`") + (test "'" "'") + (test "\\`" "\\`")))) + +(ert-deftest help-tests-substitute-quotes () (let ((text-quoting-style 'curve)) - (test "quotes ‘like this’" "quotes ‘like this’") - (test "`x'" "‘x’") - (test "`" "‘") - (test "'" "’") - (test "\\`" "\\‘")) + (should (string= (substitute-quotes "quotes ‘like this’") "quotes ‘like this’")) + (should (string= (substitute-quotes "`x'") "‘x’")) + (should (string= (substitute-quotes "`") "‘")) + (should (string= (substitute-quotes "'") "’")) + (should (string= (substitute-quotes "\\`") "\\‘"))) (let ((text-quoting-style 'straight)) - (test "quotes `like this'" "quotes 'like this'") - (test "`x'" "'x'") - (test "`" "'") - (test "'" "'") - (test "\\`" "\\'")) + (should (string= (substitute-quotes "quotes `like this'") "quotes 'like this'")) + (should (string= (substitute-quotes "`x'") "'x'")) + (should (string= (substitute-quotes "`") "'")) + (should (string= (substitute-quotes "'") "'")) + (should (string= (substitute-quotes "\\`") "\\'"))) (let ((text-quoting-style 'grave)) - (test "quotes `like this'" "quotes `like this'") - (test "`x'" "`x'") - (test "`" "`") - (test "'" "'") - (test "\\`" "\\`")))) + (should (string= (substitute-quotes "quotes `like this'") "quotes `like this'")) + (should (string= (substitute-quotes "`x'") "`x'")) + (should (string= (substitute-quotes "`") "`")) + (should (string= (substitute-quotes "'") "'")) + (should (string= (substitute-quotes "\\`") "\\`")))) (ert-deftest help-tests-substitute-command-keys/literals () (with-substitute-command-keys-test -- cgit v1.2.3 From 10573e0db7789f933a578d9a89d18b83a1cf6729 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Tue, 28 Jun 2022 01:10:48 -0400 Subject: ert-x: New `ert-with-test-buffer-selected' convenience macro * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer-selected): New convenience macro that extends `ert-with-test-buffer' by displaying the test buffer in a temporary selected window. This makes it easier to simulate user input in the body via `execute-kbd-macro'. * test/lisp/emacs-lisp/ert-x-tests.el (ert-test-test-buffer-selected/*): Add tests. --- lisp/emacs-lisp/ert-x.el | 29 +++++++++++++++++++++++++++++ test/lisp/emacs-lisp/ert-x-tests.el | 15 +++++++++++++++ 2 files changed, 44 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 4436d0a4b16..fe291290a28 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -102,6 +102,35 @@ the name of the test and the result of NAME-FORM." (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) +(cl-defmacro ert-with-test-buffer-selected ((&key name) + &body body) + "Create a test buffer, switch to it, and run BODY. + +This extends `ert-with-test-buffer' by displaying the test +buffer (whose name is derived from NAME) in a temporary window. +The temporary window becomes the `selected-window' before BODY is +evaluated. The modification hooks `before-change-functions' and +`after-change-functions' are not inhibited during the evaluation +of BODY, which makes it easier to use `execute-kbd-macro' to +simulate user interaction. The window configuration is restored +before returning, even if BODY exits nonlocally. The return +value is the last form in BODY." + (declare (debug ((":name" form) def-body)) + (indent 1)) + (let ((ret (make-symbol "ert--with-test-buffer-selected-ret"))) + `(save-window-excursion + (let (,ret) + (ert-with-test-buffer (:name ,name) + (with-current-buffer-window (current-buffer) + `(display-buffer-below-selected + (body-function + . ,(lambda (window) + (select-window window t) + (let ((inhibit-modification-hooks nil)) + (setq ,ret (progn ,@body)))))) + nil)) + ,ret)))) + ;;;###autoload (defun ert-kill-all-test-buffers () "Kill all test buffers that are still live." diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 38698041102..63e7cd7608f 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -82,6 +82,21 @@ (should-not (buffer-live-p buffer-1)) (should (buffer-live-p buffer-2)))))) +(ert-deftest ert-test-with-test-buffer-selected/selected () + (ert-with-test-buffer-selected () + (should (eq (window-buffer) (current-buffer))))) + +(ert-deftest ert-test-with-test-buffer-selected/modification-hooks () + (ert-with-test-buffer-selected () + (should (null inhibit-modification-hooks)))) + +(ert-deftest ert-test-with-test-buffer-selected/return-value () + (should (equal (ert-with-test-buffer-selected () "foo") "foo"))) + +(ert-deftest ert-test-with-test-buffer-selected/buffer-name () + (should (equal (ert-with-test-buffer (:name "foo") (buffer-name)) + (ert-with-test-buffer-selected (:name "foo") + (buffer-name))))) (ert-deftest ert-filter-string () (should (equal (ert-filter-string "foo bar baz" "quux") -- cgit v1.2.3 From 76bec09a42de5da8876b5cc6c905dac2d55241a5 Mon Sep 17 00:00:00 2001 From: Arthur Miller Date: Mon, 12 Sep 2022 12:38:09 +0200 Subject: Remove edebug props in edebug-remove-instrumentation * lisp/emacs-lisp/edebug.el (edebug--strip-plist): New function (bug#51026). (edebug-remove-instrumentation): Use it to remove pros added while running edebug. --- lisp/emacs-lisp/edebug.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index c916ec431e4..31c05057bfa 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4573,6 +4573,12 @@ With prefix argument, make it a temporary breakpoint." (was-macro `(macro . ,unwrapped)) (t unwrapped)))))) +(defun edebug--strip-plist (symbol) + "Remove edebug related properties from plist for SYMBOL." + (dolist (prop '( edebug edebug-behavior edebug-coverage + edebug-freq-count ghost-edebug)) + (cl-remprop symbol prop))) + (defun edebug-remove-instrumentation (functions) "Remove Edebug instrumentation from FUNCTIONS. Interactively, the user is prompted for the function to remove @@ -4604,6 +4610,7 @@ instrumentation for, defaulting to all functions." (dolist (symbol functions) (when-let ((unwrapped (edebug--unwrap*-symbol-function symbol))) + (edebug--strip-plist symbol) (defalias symbol unwrapped))) (message "Removed edebug instrumentation from %s" (mapconcat #'symbol-name functions ", "))) -- cgit v1.2.3 From 26e56540da8588dfde4228c4a0fafac840e03268 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 12 Sep 2022 14:17:25 +0200 Subject: Don't overwrite error message in `x' in package.el * lisp/emacs-lisp/package.el (package-menu--perform-transaction): Return whether there were errors. (package-menu-execute): Don't overwrite the error message(s) with a success message (bug#51201). --- lisp/emacs-lisp/package.el | 56 +++++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 26 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bf71447681b..70c15d2793c 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3700,30 +3700,34 @@ objects removed." `((delete . ,del) (install . ,ins) (upgrade . ,upg)))) (defun package-menu--perform-transaction (install-list delete-list) - "Install packages in INSTALL-LIST and delete DELETE-LIST." - (if install-list - (let ((status-format (format ":Installing %%d/%d" - (length install-list))) - (i 0) - (package-menu--transaction-status)) - (dolist (pkg install-list) - (setq package-menu--transaction-status - (format status-format (cl-incf i))) - (force-mode-line-update) - (redisplay 'force) - ;; Don't mark as selected, `package-menu-execute' already - ;; does that. - (package-install pkg 'dont-select)))) - (let ((package-menu--transaction-status ":Deleting")) - (force-mode-line-update) - (redisplay 'force) - (dolist (elt (package--sort-by-dependence delete-list)) - (condition-case-unless-debug err - (let ((inhibit-message (or inhibit-message package-menu-async))) - (package-delete elt nil 'nosave)) - (error (message "Error trying to delete `%s': %S" - (package-desc-full-name elt) - err)))))) + "Install packages in INSTALL-LIST and delete DELETE-LIST. +Return nil if there were no errors; non-nil otherwise." + (let ((errors nil)) + (if install-list + (let ((status-format (format ":Installing %%d/%d" + (length install-list))) + (i 0) + (package-menu--transaction-status)) + (dolist (pkg install-list) + (setq package-menu--transaction-status + (format status-format (cl-incf i))) + (force-mode-line-update) + (redisplay 'force) + ;; Don't mark as selected, `package-menu-execute' already + ;; does that. + (package-install pkg 'dont-select)))) + (let ((package-menu--transaction-status ":Deleting")) + (force-mode-line-update) + (redisplay 'force) + (dolist (elt (package--sort-by-dependence delete-list)) + (condition-case-unless-debug err + (let ((inhibit-message (or inhibit-message package-menu-async))) + (package-delete elt nil 'nosave)) + (error + (push (package-desc-full-name elt) errors) + (message "Error trying to delete `%s': %S" + (package-desc-full-name elt) err))))) + errors)) (defun package--update-selected-packages (add remove) "Update the `package-selected-packages' list according to ADD and REMOVE. @@ -3796,8 +3800,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (message "Operation %s started" message-template) ;; Packages being upgraded are not marked as selected. (package--update-selected-packages .install .delete) - (package-menu--perform-transaction install-list delete-list) - (when package-selected-packages + (unless (package-menu--perform-transaction install-list delete-list) + ;; If there weren't errors, output data. (if-let* ((removable (package--removable-packages))) (message "Operation finished. Packages that are no longer needed: %d. Type `%s' to remove them" (length removable) -- cgit v1.2.3 From 6d8f5161ead689b7a2e44a7de0a695f0ab4c833b Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 13 Sep 2022 17:11:53 +0200 Subject: Signal an error if a fallback cl-case is misplaced * lisp/emacs-lisp/cl-macs.el (cl-case): Warn if the user passes a nil key list (which would never match). Warn about quoted symbols that should probably be unquoted. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-case-warning): New unit test (bug#51368). --- lisp/emacs-lisp/cl-macs.el | 9 +++++++-- test/lisp/emacs-lisp/cl-macs-tests.el | 11 +++++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f8fdc50251f..946d2c09a92 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -775,11 +775,16 @@ compared by `eql'. \(fn EXPR (KEYLIST BODY...)...)" (declare (indent 1) (debug (form &rest (sexp body)))) (macroexp-let2 macroexp-copyable-p temp expr - (let* ((head-list nil)) + (let* ((head-list nil) + (has-otherwise nil)) `(cond ,@(mapcar (lambda (c) - (cons (cond ((memq (car c) '(t otherwise)) t) + (cons (cond (has-otherwise + (error "Misplaced t or `otherwise' clause")) + ((memq (car c) '(t otherwise)) + (setq has-otherwise t) + t) ((eq (car c) 'cl--ecase-error-flag) `(error "cl-ecase failed: %s, %s" ,temp ',(reverse head-list))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 68898720d9c..77817abd85c 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -747,4 +747,15 @@ collection clause." ;; Just make sure the forms can be instrumented. (eval-buffer)))) +(ert-deftest cl-case-error () + "Test that `cl-case' and `cl-ecase' signal an error if a t or +`otherwise' key is misplaced." + (dolist (form '((cl-case val (t 1) (123 2)) + (cl-ecase val (t 1) (123 2)) + (cl-ecase val (123 2) (t 1)))) + (ert-info ((prin1-to-string form) :prefix "Form: ") + (let ((error (should-error (macroexpand form)))) + (should (equal (cdr error) + '("Misplaced t or `otherwise' clause"))))))) + ;;; cl-macs-tests.el ends here -- cgit v1.2.3 From fffa53ff1afe097fe38f7664df5debe9811201d1 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 13 Sep 2022 17:12:57 +0200 Subject: Have 'cl-case' warn about suspicious cases * lisp/emacs-lisp/cl-macs.el (cl-case): Warn if the user passes a nil key list (which would never match). Warn about quoted symbols that should probably be unquoted. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-case-warning): New unit test (bug#51368). --- lisp/emacs-lisp/cl-macs.el | 15 +++++++++++++++ test/lisp/emacs-lisp/cl-macs-tests.el | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 946d2c09a92..5d330f32d66 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -788,6 +788,21 @@ compared by `eql'. ((eq (car c) 'cl--ecase-error-flag) `(error "cl-ecase failed: %s, %s" ,temp ',(reverse head-list))) + ((null (car c)) + (macroexp-warn-and-return + "Case nil will never match" + nil 'suspicious)) + ((and (consp (car c)) (not (cddar c)) + (memq (caar c) '(quote function))) + (macroexp-warn-and-return + (format-message + (concat "Case %s will match `%s'. If " + "that's intended, write %s " + "instead. Otherwise, don't " + "quote `%s'.") + (car c) (caar c) (list (cadar c) (caar c)) + (cadar c)) + `(cl-member ,temp ',(car c)) 'suspicious)) ((listp (car c)) (setq head-list (append (car c) head-list)) `(cl-member ,temp ',(car c))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 77817abd85c..427b8f46893 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -25,6 +25,8 @@ (require 'cl-macs) (require 'edebug) (require 'ert) +(require 'ert-x) +(require 'pcase) ;;;; cl-loop tests -- many adapted from Steele's CLtL2 @@ -758,4 +760,34 @@ collection clause." (should (equal (cdr error) '("Misplaced t or `otherwise' clause"))))))) +(ert-deftest cl-case-warning () + "Test that `cl-case' and `cl-ecase' warn about suspicious +constructs." + (pcase-dolist (`(,case . ,message) + `((nil . "Case nil will never match") + ('nil . ,(concat "Case 'nil will match `quote'. " + "If that's intended, write " + "(nil quote) instead. " + "Otherwise, don't quote `nil'.")) + ('t . ,(concat "Case 't will match `quote'. " + "If that's intended, write " + "(t quote) instead. " + "Otherwise, don't quote `t'.")) + ('foo . ,(concat "Case 'foo will match `quote'. " + "If that's intended, write " + "(foo quote) instead. " + "Otherwise, don't quote `foo'.")) + (#'foo . ,(concat "Case #'foo will match " + "`function'. If that's " + "intended, write (foo function) " + "instead. Otherwise, don't " + "quote `foo'.")))) + (dolist (macro '(cl-case cl-ecase)) + (let ((form `(,macro val (,case 1)))) + (ert-info ((prin1-to-string form) :prefix "Form: ") + (ert-with-message-capture messages + (macroexpand form) + (should (equal messages + (concat "Warning: " message "\n"))))))))) + ;;; cl-macs-tests.el ends here -- cgit v1.2.3 From 6e6a3efa2e806738b4c88e67db1b9bc87969831d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 13 Sep 2022 18:24:14 +0200 Subject: Remove a nil cl-case case * lisp/emacs-lisp/testcover.el (testcover-coverage-combine): Remove the nil case, which will never match (bug#51368). --- lisp/emacs-lisp/testcover.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index cd2e388ce42..760063d1f9d 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -637,8 +637,7 @@ argument is maybe, return maybe. Return 1value only if both arguments are 1value." (cl-case val (testcover-1value result) - (maybe (and result 'maybe)) - (nil nil))) + (maybe (and result 'maybe)))) (defun testcover-analyze-coverage-compose (forms func) "Analyze a list of FORMS for code coverage using FUNC. -- cgit v1.2.3 From 5fe9a1a85ae6d54196031157a735352f6ab655ff Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Sep 2022 09:12:13 +0300 Subject: ; Fix doc string of 'loaddefs-generate' * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Doc fix. (Bug#57815) --- lisp/emacs-lisp/loaddefs-gen.el | 4 ++-- src/w32fns.c | 45 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 47 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 005a46c2d75..5819a26eb54 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -512,7 +512,7 @@ If COMPILE, don't include a \"don't compile\" cookie." (defun loaddefs-generate (dir output-file &optional excluded-files extra-data include-package-version generate-full) - "Generate loaddefs files for Lisp files in the directories DIRS. + "Generate loaddefs files for Lisp files in one or more directories given by DIR. DIR can be either a single directory or a list of directories. The autoloads will be written to OUTPUT-FILE. If any Lisp file @@ -520,7 +520,7 @@ 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 by DIRS. +directories specified by DIR. Optional argument EXCLUDED-FILES, if non-nil, should be a list of files, such as preloaded files, whose autoloads should not be written diff --git a/src/w32fns.c b/src/w32fns.c index 745458d0a03..57296bd4e07 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10447,6 +10447,51 @@ w32_get_resource (const char *key, const char *name, LPDWORD lpdwtype) return (NULL); } +#ifdef WINDOWSNT + +/*********************************************************************** + Wallpaper + ***********************************************************************/ + +#if 0 + +typedef BOOL (WINAPI * SystemParametersInfoW_Proc) (UINT,UINT,PVOID,UINT); +static SystemParametersInfoW_Proc system_parameters_info_w_fn; + +DEFUN ("w32-set-wallpaper", Fw32_set_wallpaper, Sw32_set_wallpaper, 1, 1, 0, + doc: /* Set the desktop wallpaper image to IMAGE-FILE. */) + (Lisp_Object image_file) +{ + Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (image_file, Qnil)); + char *fname = SSDATA (encoded); + + if (w32_unicode_filenames) + { + } + else + { + char fname_a[MAX_PATH]; + + if (filename_to_ansi (fname, fname_a) != 0) + error ("Wallpaper file %s does not exist or cannot be accessed", fname); + + BOOL result = SystemParametersInfoA (SPI_SETDESKWALLPAPER, 0, fname_a, + SPIF_SENDCHANGE); + if (!result) + { + DWORD err = GetLastError (); + if (err) + error ("Could not set wallpaper: %s", w32_strerror (err)); + else + error ("Could not set wallpaper"); + } + } + return Qnil; +} +#endif + +#endif + /*********************************************************************** Initialization ***********************************************************************/ -- cgit v1.2.3 From 52a3ba102c0bcfda1b69e33be2a93a245a4c3a84 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Sep 2022 09:14:59 +0300 Subject: Revert "; Fix doc string of 'loaddefs-generate'" This reverts commit 5fe9a1a85ae6d54196031157a735352f6ab655ff. It included unrelated changes. --- lisp/emacs-lisp/loaddefs-gen.el | 4 ++-- src/w32fns.c | 45 ----------------------------------------- 2 files changed, 2 insertions(+), 47 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 5819a26eb54..005a46c2d75 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -512,7 +512,7 @@ If COMPILE, don't include a \"don't compile\" cookie." (defun loaddefs-generate (dir output-file &optional excluded-files extra-data include-package-version generate-full) - "Generate loaddefs files for Lisp files in one or more directories given by DIR. + "Generate loaddefs files for Lisp files in the directories DIRS. DIR can be either a single directory or a list of directories. The autoloads will be written to OUTPUT-FILE. If any Lisp file @@ -520,7 +520,7 @@ 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 -directories specified by DIR. +directory or directories specified by DIRS. Optional argument EXCLUDED-FILES, if non-nil, should be a list of files, such as preloaded files, whose autoloads should not be written diff --git a/src/w32fns.c b/src/w32fns.c index 57296bd4e07..745458d0a03 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10447,51 +10447,6 @@ w32_get_resource (const char *key, const char *name, LPDWORD lpdwtype) return (NULL); } -#ifdef WINDOWSNT - -/*********************************************************************** - Wallpaper - ***********************************************************************/ - -#if 0 - -typedef BOOL (WINAPI * SystemParametersInfoW_Proc) (UINT,UINT,PVOID,UINT); -static SystemParametersInfoW_Proc system_parameters_info_w_fn; - -DEFUN ("w32-set-wallpaper", Fw32_set_wallpaper, Sw32_set_wallpaper, 1, 1, 0, - doc: /* Set the desktop wallpaper image to IMAGE-FILE. */) - (Lisp_Object image_file) -{ - Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (image_file, Qnil)); - char *fname = SSDATA (encoded); - - if (w32_unicode_filenames) - { - } - else - { - char fname_a[MAX_PATH]; - - if (filename_to_ansi (fname, fname_a) != 0) - error ("Wallpaper file %s does not exist or cannot be accessed", fname); - - BOOL result = SystemParametersInfoA (SPI_SETDESKWALLPAPER, 0, fname_a, - SPIF_SENDCHANGE); - if (!result) - { - DWORD err = GetLastError (); - if (err) - error ("Could not set wallpaper: %s", w32_strerror (err)); - else - error ("Could not set wallpaper"); - } - } - return Qnil; -} -#endif - -#endif - /*********************************************************************** Initialization ***********************************************************************/ -- cgit v1.2.3 From 48d8543ff134e08332bf35d96409cb8e3c2cbfb9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Sep 2022 09:16:41 +0300 Subject: ; Fix doc string of 'loaddefs-generate' * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Doc fix. (Bug#57815) --- lisp/emacs-lisp/loaddefs-gen.el | 4 ++-- 1 file changed, 2 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 005a46c2d75..5819a26eb54 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -512,7 +512,7 @@ If COMPILE, don't include a \"don't compile\" cookie." (defun loaddefs-generate (dir output-file &optional excluded-files extra-data include-package-version generate-full) - "Generate loaddefs files for Lisp files in the directories DIRS. + "Generate loaddefs files for Lisp files in one or more directories given by DIR. DIR can be either a single directory or a list of directories. The autoloads will be written to OUTPUT-FILE. If any Lisp file @@ -520,7 +520,7 @@ 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 by DIRS. +directories specified by DIR. Optional argument EXCLUDED-FILES, if non-nil, should be a list of files, such as preloaded files, whose autoloads should not be written -- cgit v1.2.3 From 824ae5faeec9cfa5e14e750030d55800b08ad7f2 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 27 Aug 2022 14:20:38 +0200 Subject: Use `eql` or `eq` instead of `=` in some places For a switch op to be generated, comparisons must be made using `eq`, `eql` or `equal`, not `=`. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): * lisp/files.el (file-modes-char-to-who, file-modes-char-to-right): * lisp/international/titdic-cnv.el (tit-process-header): * lisp/language/ethio-util.el (ethio-input-special-character) (ethio-fidel-to-tex-buffer): * lisp/language/lao.el (consonant): Use `eq` or `eql` instead of `=`. In these cases either `eq` or `eql` would do and the choice does not affect the resulting code. We compare numbers with `eql` and characters with `eq` as a matter of style. --- lisp/emacs-lisp/byte-opt.el | 8 ++++---- lisp/files.el | 38 +++++++++++++++++------------------ lisp/international/titdic-cnv.el | 10 +++++----- lisp/language/ethio-util.el | 43 ++++++++++++++++++++-------------------- lisp/language/lao.el | 6 +++--- 5 files changed, 53 insertions(+), 52 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 27b0d33d3ef..0d5f8c26eb2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1999,20 +1999,20 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq keep-going t) (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) (setq rest (cdr rest)) - (cond ((= tmp 1) + (cond ((eql tmp 1) (byte-compile-log-lap " %s discard\t-->\t" lap0) (setq lap (delq lap0 (delq lap1 lap)))) - ((= tmp 0) + ((eql tmp 0) (byte-compile-log-lap " %s discard\t-->\t discard" lap0) (setq lap (delq lap0 lap))) - ((= tmp -1) + ((eql tmp -1) (byte-compile-log-lap " %s discard\t-->\tdiscard discard" lap0) (setcar lap0 'byte-discard) (setcdr lap0 0)) - ((error "Optimizer error: too much on the stack")))) + (t (error "Optimizer error: too much on the stack")))) ;; ;; goto*-X X: --> X: ;; diff --git a/lisp/files.el b/lisp/files.el index 540bc2a6a85..0f2d3ca4b9a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -8271,10 +8271,10 @@ CHAR is in [ugoa] and represents the category of users (Owner, Group, Others, or All) for whom to produce the mask. The bit-mask that is returned extracts from mode bits the access rights for the specified category of users." - (cond ((= char ?u) #o4700) - ((= char ?g) #o2070) - ((= char ?o) #o1007) - ((= char ?a) #o7777) + (cond ((eq char ?u) #o4700) + ((eq char ?g) #o2070) + ((eq char ?o) #o1007) + ((eq char ?a) #o7777) (t (error "%c: Bad `who' character" char)))) (defun file-modes-char-to-right (char &optional from) @@ -8282,22 +8282,22 @@ for the specified category of users." CHAR is in [rwxXstugo] and represents symbolic access permissions. If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." (or from (setq from 0)) - (cond ((= char ?r) #o0444) - ((= char ?w) #o0222) - ((= char ?x) #o0111) - ((= char ?s) #o6000) - ((= char ?t) #o1000) + (cond ((eq char ?r) #o0444) + ((eq char ?w) #o0222) + ((eq char ?x) #o0111) + ((eq char ?s) #o6000) + ((eq char ?t) #o1000) ;; Rights relative to the previous file modes. - ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) - ((= char ?u) (let ((uright (logand #o4700 from))) - ;; FIXME: These divisions/shifts seem to be right - ;; for the `7' part of the #o4700 mask, but not - ;; for the `4' part. Same below for `g' and `o'. - (+ uright (/ uright #o10) (/ uright #o100)))) - ((= char ?g) (let ((gright (logand #o2070 from))) - (+ gright (/ gright #o10) (* gright #o10)))) - ((= char ?o) (let ((oright (logand #o1007 from))) - (+ oright (* oright #o10) (* oright #o100)))) + ((eq char ?X) (if (= (logand from #o111) 0) 0 #o0111)) + ((eq char ?u) (let ((uright (logand #o4700 from))) + ;; FIXME: These divisions/shifts seem to be right + ;; for the `7' part of the #o4700 mask, but not + ;; for the `4' part. Same below for `g' and `o'. + (+ uright (/ uright #o10) (/ uright #o100)))) + ((eq char ?g) (let ((gright (logand #o2070 from))) + (+ gright (/ gright #o10) (* gright #o10)))) + ((eq char ?o) (let ((oright (logand #o1007 from))) + (+ oright (* oright #o10) (* oright #o100)))) (t (error "%c: Bad right character" char)))) (defun file-modes-rights-to-number (rights who-mask &optional from) diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index 080045e7520..d2a6ee1e9d1 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -281,7 +281,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (while (not (eobp)) (let ((ch (following-char)) (pos (point))) - (cond ((= ch ?C) ; COMMENT + (cond ((eq ch ?C) ; COMMENT (cond ((looking-at "COMMENT") (let ((pos (match-end 0)) (to (progn (end-of-line) (point)))) @@ -295,7 +295,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (setq tit-comments (cons (buffer-substring-no-properties pos (point)) tit-comments)))))) - ((= ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT + ((eq ch ?M) ; MULTICHOICE, MOVERIGHT, MOVELEFT (cond ((looking-at "MULTICHOICE:[ \t]*") (goto-char (match-end 0)) (setq tit-multichoice (looking-at "YES"))) @@ -305,7 +305,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, ((looking-at "MOVELEFT:[ \t]*") (goto-char (match-end 0)) (setq tit-moveleft (tit-read-key-value))))) - ((= ch ?P) ; PROMPT + ((eq ch ?P) ; PROMPT (cond ((looking-at "PROMPT:[ \t]*") (goto-char (match-end 0)) (setq tit-prompt (tit-read-key-value)) @@ -316,7 +316,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (if (or (eq (nth 1 split) 32) (eq (nth 2 split) 32)) (setq tit-prompt (substring tit-prompt 0 -1))))))) - ((= ch ?B) ; BACKSPACE, BEGINDICTIONARY, + ((eq ch ?B) ; BACKSPACE, BEGINDICTIONARY, ; BEGINPHRASE (cond ((looking-at "BACKSPACE:[ \t]*") (goto-char (match-end 0)) @@ -325,7 +325,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:陰平, 6:陽平, 3:上聲, 4:去聲, (setq tit-dictionary t)) ((looking-at "BEGINPHRASE") (setq tit-dictionary nil)))) - ((= ch ?K) ; KEYPROMPT + ((eq ch ?K) ; KEYPROMPT (cond ((looking-at "KEYPROMPT(\\(.*\\)):[ \t]*") (let ((key-char (match-string 1))) (goto-char (match-end 0)) diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index a0159679da2..2f76acfe7cb 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -794,15 +794,15 @@ The 2nd and 3rd arguments BEGIN and END specify the region." "This function is deprecated." (interactive "*cInput number: 1. 2. 3. 4. 5.") (cond - ((= arg ?1) + ((eq arg ?1) (insert "")) - ((= arg ?2) + ((eq arg ?2) (insert "")) - ((= arg ?3) + ((eq arg ?3) (insert "")) - ((= arg ?4) + ((eq arg ?4) (insert "")) - ((= arg ?5) + ((eq arg ?5) (insert "")) (t (error "")))) @@ -816,7 +816,7 @@ The 2nd and 3rd arguments BEGIN and END specify the region." "Convert each fidel characters in the current buffer into a fidel-tex command." (interactive) (let ((buffer-read-only nil) - comp ch) + comp) ;; Special treatment for geminated characters. ;; Geminated characters la", etc. change into \geminateG{\laG}, etc. @@ -835,21 +835,22 @@ The 2nd and 3rd arguments BEGIN and END specify the region." ;; Special Ethiopic punctuation. (goto-char (point-min)) (while (re-search-forward "\\ce[».?]\\|«\\ce" nil t) - (cond - ((= (setq ch (preceding-char)) ?\») - (delete-char -1) - (insert "\\rquoteG")) - ((= ch ?.) - (delete-char -1) - (insert "\\dotG")) - ((= ch ??) - (delete-char -1) - (insert "\\qmarkG")) - (t - (forward-char -1) - (delete-char -1) - (insert "\\lquoteG") - (forward-char 1)))) + (let ((ch (preceding-char))) + (cond + ((eq ch ?\») + (delete-char -1) + (insert "\\rquoteG")) + ((eq ch ?.) + (delete-char -1) + (insert "\\dotG")) + ((eq ch ??) + (delete-char -1) + (insert "\\qmarkG")) + (t + (forward-char -1) + (delete-char -1) + (insert "\\lquoteG") + (forward-char 1))))) ;; Ethiopic characters to TeX macros (robin-invert-region (point-min) (point-max) "ethiopic-tex") diff --git a/lisp/language/lao.el b/lisp/language/lao.el index 1861eff15eb..0ad5b9f84e3 100644 --- a/lisp/language/lao.el +++ b/lisp/language/lao.el @@ -60,9 +60,9 @@ (len (length chars)) ;; Replace `c', `t', `v' to consonant, tone, and vowel. (regexp (mapconcat (lambda (c) - (cond ((= c ?c) consonant) - ((= c ?t) tone) - ((= c ?v) vowel-upper-lower) + (cond ((eq c ?c) consonant) + ((eq c ?t) tone) + ((eq c ?v) vowel-upper-lower) (t (string c)))) (cdr l) "")) ;; Element of composition-function-table. -- cgit v1.2.3 From 8b29b296931a20ee9f3b3e19aab07ba71b9a12c1 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 16 Sep 2022 10:09:20 +0300 Subject: Add outline open/close images (bug#57813) * etc/images/outline-open.svg: * etc/images/outline-close.svg: New files. * lisp/outline.el (outline-open, outline-close): Use images outline-open.svg and outline-close.svg. * lisp/emacs-lisp/icons.el (icons--create): Add :ascent 'center'. --- etc/images/outline-close.svg | 6 ++++++ etc/images/outline-open.svg | 4 ++++ lisp/emacs-lisp/icons.el | 2 +- lisp/outline.el | 10 ++++++---- 4 files changed, 17 insertions(+), 5 deletions(-) create mode 100644 etc/images/outline-close.svg create mode 100644 etc/images/outline-open.svg (limited to 'lisp/emacs-lisp') diff --git a/etc/images/outline-close.svg b/etc/images/outline-close.svg new file mode 100644 index 00000000000..ea9157a5fb5 --- /dev/null +++ b/etc/images/outline-close.svg @@ -0,0 +1,6 @@ + +outline-close + + + + diff --git a/etc/images/outline-open.svg b/etc/images/outline-open.svg new file mode 100644 index 00000000000..75cf6aff9f9 --- /dev/null +++ b/etc/images/outline-open.svg @@ -0,0 +1,4 @@ + +outline-open + + diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index 93749a3451e..ff4f20c2071 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -202,7 +202,7 @@ present if the icon is represented by an image." :height (if (eq height 'line) (window-default-line-height) height) - :scale 1) + :scale 1 :ascent 'center) (create-image file)))))) (cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords) diff --git a/lisp/outline.el b/lisp/outline.el index c9d1a4ac64b..aee6f696b5b 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -292,16 +292,18 @@ buffers (yet) -- that will be amended in a future version." :safe #'booleanp :version "29.1") -(define-icon outline-open button - '((emoji "🔽") +(define-icon outline-open nil + '((image "outline-open.svg" :height 15 :ascent center) + (emoji "🔽") (symbol " ▼ ") (text " open ")) "Icon used for buttons for opening a section in outline buffers." :version "29.1" :help-echo "Open this section") -(define-icon outline-close button - '((emoji "▶️") +(define-icon outline-close nil + '((image "outline-close.svg" :height 15 :ascent center) + (emoji "▶️") (symbol " ▶ ") (text " close ")) "Icon used for buttons for closing a section in outline buffers." -- cgit v1.2.3 From 7be7ad279e96f90cc70e384a350331de8e1607df Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 16 Sep 2022 12:36:15 +0200 Subject: Don't use autoloaded functions for safe-local-variable * doc/lispref/symbols.texi (Standard Properties): Clarify how safe-local-variable should look. * lisp/emacs-lisp/checkdoc.el (checkdoc-ispell-lisp-words) (checkdoc-symbol-words): Use list-of-strings-p. (checkdoc-list-of-strings-p): Obsolete. * lisp/vc/vc-git.el (vc-git-annotate-switches): Remove. (vc-git-annotate-switches): Open-code the check. --- doc/lispref/symbols.texi | 5 ++++- lisp/emacs-lisp/checkdoc.el | 6 +++--- lisp/vc/vc-git.el | 19 ++++++------------- 3 files changed, 13 insertions(+), 17 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 336fa9c9182..ea1e086ebf1 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -613,7 +613,10 @@ file-local evaluation forms. @xref{File Local Variables}. @item safe-local-variable The value specifies a function for determining safe file-local values -for the named variable. @xref{File Local Variables}. +for the named variable. @xref{File Local Variables}. Since this +value is consulted when loading files, the function should be +efficient and should ideally not lead to loading any libraries to +determine the safeness (e.g., it should not be an autoloaded function). @item side-effect-free @cindex @code{side-effect-free} property diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 20d64b59158..3f9bc28e0b0 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -250,7 +250,7 @@ with these words enabled." (defvar checkdoc-ispell-lisp-words '("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) +;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable #'list-of-strings-p) (defcustom checkdoc-max-keyref-before-warn nil "If non-nil, number of \\\\=[command-to-keystroke] tokens allowed in a doc string. @@ -320,7 +320,7 @@ These words are ignored when unquoted symbols are searched for. This should be set in an Emacs Lisp file's local variables." :type '(repeat (string :tag "Word")) :version "28.1") -;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p) +;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable #'list-of-strings-p) (defcustom checkdoc-column-zero-backslash-before-paren t "Non-nil means to warn if there is no \"\\\" before \"(\" in column zero. @@ -360,9 +360,9 @@ large number of libraries means it is impractical to fix all of these warnings masse. In almost any other case, setting this to anything but t is likely to be counter-productive.") -;;;###autoload (defun checkdoc-list-of-strings-p (obj) "Return t when OBJ is a list of strings." + (declare (obsolete list-of-strings-p "29.1")) ;; this is a function so it might be shared by checkdoc-proper-noun-list ;; and/or checkdoc-ispell-lisp-words in the future (and (listp obj) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index b1025ed7149..a5d12f03bcf 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -119,18 +119,6 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (repeat :tag "Argument List" :value ("") string)) :version "23.1") -;; We put the entire function into the autoload file so that we don't -;; have to load a whole bunch of vc.*el files just to see whether the -;; file-local variable is safe. -;;;###autoload -(progn - (defun vc-git-annotate-switches-safe-p (switches) - "Check if local value of `vc-git-annotate-switches' is safe. -Currently only \"-w\" (ignore whitespace) is considered safe, but -this list might be extended in the future." - ;; TODO: Probably most options are perfectly safe. - (equal switches "-w"))) - (defcustom vc-git-annotate-switches nil "String or list of strings specifying switches for Git blame under VC. If nil, use the value of `vc-annotate-switches'. If t, use no switches." @@ -139,7 +127,12 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) :version "25.1") -;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable #'vc-git-annotate-switches-safe-p) + +;; Check if local value of `vc-git-annotate-switches' is safe. +;; Currently only "-w" (ignore whitespace) is considered safe, but +;; this list might be extended in the future (probably most options +;; are perfectly safe.) +;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable (lambda (switches) (equal switches "-w"))) (defcustom vc-git-log-switches nil "String or list of strings specifying switches for Git log under VC." -- cgit v1.2.3 From 6938a2ddd2d9861a0f04e79d05ba976bdf91cc8c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 16 Sep 2022 22:24:20 +0200 Subject: Accept more wide function signatures in docstrings * test/lisp/emacs-lisp/bytecomp-tests.el ("warn-wide-docstring-ignore-function-signature.el"): New test. * lisp/emacs-lisp/bytecomp.el (byte-compile--wide-docstring-p): Make regexp more allowing to silence warning. * test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el: New file. --- lisp/emacs-lisp/bytecomp.el | 2 +- .../warn-wide-docstring-ignore-function-signature.el | 4 ++++ test/lisp/emacs-lisp/bytecomp-tests.el | 4 ++++ 3 files changed, 9 insertions(+), 1 deletion(-) create mode 100644 test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 48929e62bdf..3b3f7bb6190 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1705,7 +1705,7 @@ URLs." (+ " " (or ;; Arguments. (+ (or (syntax symbol) - (any word "-/:[]&=().?^\\#'"))) + (any word "-/:[]&=()<>.,?^\\#*'\""))) ;; Argument that is a list. (seq "(" (* (not ")")) ")"))) ")"))) diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el new file mode 100644 index 00000000000..e83f516e58c --- /dev/null +++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-wide-docstring-ignore-function-signature.el @@ -0,0 +1,4 @@ +;;; -*- lexical-binding: t -*- +(defun foo-bar () + "This should not warn: +(fn COMMAND &rest ARGS &key (MARGIN (rx bol (+ \" \"))) (ARGUMENT (rx \"-\" (+ (any \"-\" alnum)) (32 \"=\"))) (METAVAR (rx (32 \" \") (or (+ (any alnum \"_-\")) (seq \"[\" (+? nonl) \"]\") (seq \"<\" (+? nonl) \">\") (seq \"{\" (+? nonl) \"}\")))) (SEPARATOR (rx \", \" symbol-start)) (DESCRIPTION (rx (* nonl) (* \"\\=\\n\" (>= 9 \" \") (* nonl)))) NARROW-START NARROW-END)") diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index bc9f8d802a6..1ca44dc7a48 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1006,6 +1006,10 @@ byte-compiled. Run with dynamic binding." "warn-wide-docstring-ignore-fill-column.el" "defvar .foo-bar. docstring wider than .* characters" 'reverse) +(bytecomp--define-warning-file-test + "warn-wide-docstring-ignore-function-signature.el" + "defvar .foo-bar. docstring wider than .* characters" 'reverse) + (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-override.el" "defvar .foo-bar. docstring wider than .* characters" 'reverse) -- cgit v1.2.3 From 84801d468ae1e9fed271151a9c7e259cf05488e8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 17 Sep 2022 12:31:24 +0200 Subject: Autoload string-join * lisp/emacs-lisp/subr-x.el (string-join): Autoload since it's being used more now. --- lisp/emacs-lisp/subr-x.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index bd7c3c82f97..6e4d88b4df3 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -97,6 +97,7 @@ threading." (maphash (lambda (_ v) (push v values)) hash-table) values)) +;;;###autoload (defsubst string-join (strings &optional separator) "Join all STRINGS using SEPARATOR. Optional argument SEPARATOR must be a string, a vector, or a list of -- cgit v1.2.3 From baf1a7a4a0f21636ea8314a6a927f69a0c66aac5 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Wed, 31 Aug 2022 03:13:09 +0200 Subject: Turn gv-synthetic-place into a function This fixes Bug#57397. * lisp/emacs-lisp/gv.el (gv-synthetic-place): Make a function and add trivial compiler macro to avoid decreasing efficiency. --- lisp/emacs-lisp/gv.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 1db9d96d999..d4aed3ac391 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -536,13 +536,13 @@ The return value is the last VAL in the list. (funcall do `(error . ,args) (lambda (v) `(progn ,v (error . ,args)))))) -(defmacro gv-synthetic-place (getter setter) +(defun gv-synthetic-place (getter setter) "Special place described by its setter and getter. GETTER and SETTER (typically obtained via `gv-letplace') get and -set that place. I.e. This macro allows you to do the \"reverse\" of what -`gv-letplace' does. -This macro only makes sense when used in a place." - (declare (gv-expander funcall)) +set that place. I.e. this function allows you to do the +\"reverse\" of what `gv-letplace' does. This function only makes +sense when used in a place." + (declare (gv-expander funcall) (compiler-macro (lambda (_) getter))) (ignore setter) getter) -- cgit v1.2.3 From 97b928ce09d6034ebcb541fb548e5d4862302add Mon Sep 17 00:00:00 2001 From: Gerd Möllmann Date: Sun, 18 Sep 2022 08:05:52 +0200 Subject: MacOS ld warning from native compilation (bug#57849) * lisp/emacs-lisp/comp.el (native-comp-driver-options): Add "-Wl,-w" on Darwin systems. * etc/NEWS: Describe change. --- etc/NEWS | 9 +++++++++ lisp/emacs-lisp/comp.el | 5 +++-- 2 files changed, 12 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 8694b575a7a..6e5ddfa0662 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -30,6 +30,15 @@ with a prefix argument or by typing 'C-u C-h C-n'. * Changes in Specialized Modes and Packages in Emacs 28.3 +** 'native-comp-driver-options' on macOS + +The value of 'native-comp-driver-options' has been changed to contain +"-Wl,-w" to suppress warnings of the form + + ld: warning: -undefined dynamic_lookup may not work with chained fixups + +emitted during native compilation on macOS 12.6 with Xcode 14. + * New Modes and Packages in Emacs 28.3 diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a5ab12ae388..d0234a81aa5 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -178,14 +178,15 @@ and above." :type '(repeat string) :version "28.1") -(defcustom native-comp-driver-options nil +(defcustom native-comp-driver-options (when (eq system-type 'darwin) + '("-Wl,-w")) "Options passed verbatim to the native compiler's back-end driver. Note that not all options are meaningful; typically only the options affecting the assembler and linker are likely to be useful. Passing these options is only available in libgccjit version 9 and above." - :type '(repeat string) ; FIXME is this right? + :type '(repeat string) :version "28.1") (defcustom comp-libgccjit-reproducer nil -- cgit v1.2.3 From a71de4b52d3de14349ded7d88c4cae6e2a9376ae Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 19 Sep 2022 13:34:51 +0200 Subject: Improve check for misleading 'cl-case' cases (Bug#57915). * lisp/emacs-lisp/cl-macs.el (cl-case): Check that the case is of the form (quote FOO), not just (quote). * test/lisp/emacs-lisp/cl-macs-tests.el (cl-case-no-warning): New unit test. --- lisp/emacs-lisp/cl-macs.el | 2 +- test/lisp/emacs-lisp/cl-macs-tests.el | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 5d330f32d66..beafee1d631 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -792,7 +792,7 @@ compared by `eql'. (macroexp-warn-and-return "Case nil will never match" nil 'suspicious)) - ((and (consp (car c)) (not (cddar c)) + ((and (consp (car c)) (cdar c) (not (cddar c)) (memq (caar c) '(quote function))) (macroexp-warn-and-return (format-message diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 83928775f18..f742637ee35 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -792,4 +792,15 @@ constructs." (should (equal messages (concat "Warning: " message "\n")))))))))) +(ert-deftest cl-case-no-warning () + "Test that `cl-case' and `cl-ecase' don't warn in some valid cases. +See Bug#57915." + (dolist (case '(quote (quote) function (function))) + (dolist (macro '(cl-case cl-ecase)) + (let ((form `(,macro val (,case 1)))) + (ert-info ((prin1-to-string form) :prefix "Form: ") + (ert-with-message-capture messages + (macroexpand form) + (should (string-empty-p messages)))))))) + ;;; cl-macs-tests.el ends here -- cgit v1.2.3 From 60102016e416e5c19fa5945aeb80693dac7ff2e6 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 19 Sep 2022 10:55:09 +0200 Subject: Abolish max-specpdl-size (bug#57911) The max-lisp-eval-depth limit is sufficient to prevent unbounded stack growth including the specbind stack; simplify matters for the user by not having them to worry about two different limits. This change turns max-specpdl-size into a harmless variable with no effects, to keep existing code happy. * lisp/subr.el (max-specpdl-size): Define as an ordinary (but obsolete) dynamic variable. * admin/grammars/Makefile.in: * doc/lispintro/emacs-lisp-intro.texi (Loops & Recursion): * doc/lispref/control.texi (Cleanups): * doc/lispref/edebug.texi (Checking Whether to Stop): * doc/lispref/eval.texi (Eval): * doc/lispref/variables.texi (Local Variables): * doc/misc/calc.texi (Recursion Depth): Update documentation. * etc/NEWS: Announce. * src/eval.c (FletX): Use safe iteration to guard against circular bindings list. (syms_of_eval): Remove old max-specpdl-size definition. (init_eval_once, restore_stack_limits, call_debugger) (signal_or_quit, grow_specpdl_allocation): * leim/Makefile.in: * lisp/Makefile.in: * lisp/calc/calc-stuff.el (calc-more-recursion-depth) (calc-less-recursion-depth): * lisp/calc/calc.el (calc-do): * lisp/cedet/semantic/ede-grammar.el (ede-proj-makefile-insert-rules): * lisp/cedet/semantic/grammar.el (semantic-grammar-batch-build-one-package): * lisp/cus-start.el (standard): * lisp/emacs-lisp/comp.el (comp--native-compile): * lisp/emacs-lisp/edebug.el (edebug-max-depth): (edebug-read-and-maybe-wrap-form, edebug-default-enter): * lisp/emacs-lisp/regexp-opt.el (regexp-opt): * lisp/eshell/esh-mode.el (eshell-mode): * lisp/loadup.el (max-specpdl-size): * lisp/mh-e/mh-e.el (mh-invisible-headers): * lisp/net/shr.el (shr-insert-document, shr-descend): * lisp/play/hanoi.el (hanoi-internal): * lisp/progmodes/cperl-mode.el: * src/fileio.c (Fdo_auto_save): Remove references to and modifications of max-specpdl-size. --- admin/grammars/Makefile.in | 2 +- doc/lispintro/emacs-lisp-intro.texi | 5 ++- doc/lispref/control.texi | 5 --- doc/lispref/edebug.texi | 5 ++- doc/lispref/eval.texi | 5 +-- doc/lispref/variables.texi | 21 ------------- doc/misc/calc.texi | 4 --- etc/NEWS | 6 ++++ leim/Makefile.in | 2 -- lisp/Makefile.in | 8 ++--- lisp/calc/calc-stuff.el | 8 ++--- lisp/calc/calc.el | 3 +- lisp/cedet/semantic/ede-grammar.el | 7 ++--- lisp/cedet/semantic/grammar.el | 1 - lisp/cus-start.el | 1 - lisp/emacs-lisp/comp.el | 1 - lisp/emacs-lisp/edebug.el | 6 ++-- lisp/emacs-lisp/regexp-opt.el | 1 - lisp/eshell/esh-mode.el | 1 - lisp/loadup.el | 4 +-- lisp/mh-e/mh-e.el | 4 +-- lisp/net/shr.el | 62 ++++++++++++++++--------------------- lisp/play/hanoi.el | 5 ++- lisp/progmodes/cperl-mode.el | 1 - lisp/subr.el | 8 +++++ src/eval.c | 60 ++++------------------------------- src/fileio.c | 5 --- 27 files changed, 68 insertions(+), 173 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 4ca88982cde..178c79b7a02 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -35,7 +35,7 @@ unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH EMACS = ${top_builddir}/src/emacs emacs = "${EMACS}" -batch --no-site-file --no-site-lisp \ - --eval '(setq max-specpdl-size 5000)' --eval '(setq load-prefer-newer t)' + --eval '(setq load-prefer-newer t)' make_bovine = ${emacs} -l semantic/bovine/grammar -f bovine-batch-make-parser make_wisent = ${emacs} -l semantic/wisent/grammar -f wisent-batch-make-parser diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 47a5a870fde..df8fa2f8e79 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -10100,9 +10100,8 @@ resources; as it happens, methods that people find easy---that are frugal of mental resources---sometimes use considerable computer resources. Emacs was designed to run on machines that we now consider limited and its default settings are conservative. You may want to -increase the values of @code{max-specpdl-size} and -@code{max-lisp-eval-depth}. In my @file{.emacs} file, I set them to -15 and 30 times their default value.}. +increase the value of @code{max-lisp-eval-depth}. In my @file{.emacs} +file, I set it to 30 times its default value.}. @menu * while:: Causing a stretch of code to repeat. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index d4520ebdee5..ee2acdb002b 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2366,11 +2366,6 @@ of the @var{cleanup-forms} themselves exits nonlocally (via a guaranteed to evaluate the rest of them. If the failure of one of the @var{cleanup-forms} has the potential to cause trouble, then protect it with another @code{unwind-protect} around that form. - -The number of currently active @code{unwind-protect} forms counts, -together with the number of local variable bindings, against the limit -@code{max-specpdl-size} (@pxref{Definition of max-specpdl-size,, Local -Variables}). @end defspec For example, here we make an invisible buffer for temporary use, and diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 56f7b7bdfad..6a51489d8a4 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1032,9 +1032,8 @@ program. @itemize @bullet @item @vindex edebug-max-depth -@code{max-lisp-eval-depth} (@pxref{Eval}) and @code{max-specpdl-size} -(@pxref{Local Variables}) are both increased to reduce Edebug's impact -on the stack. You could, however, still run out of stack space when +@code{max-lisp-eval-depth} (@pxref{Eval}) is increased to reduce Edebug's +impact on the stack. You could, however, still run out of stack space when using Edebug. You can also enlarge the value of @code{edebug-max-depth} if Edebug reaches the limit of recursion depth instrumenting code that contains very large quoted lists. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 6e29a5403f1..11c321b32ed 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -830,7 +830,7 @@ This variable defines the maximum depth allowed in calls to @code{eval}, @code{apply}, and @code{funcall} before an error is signaled (with error message @code{"Lisp nesting exceeds max-lisp-eval-depth"}). -This limit, with the associated error when it is exceeded, is one way +This limit, with the associated error when it is exceeded, is how Emacs Lisp avoids infinite recursion on an ill-defined function. If you increase the value of @code{max-lisp-eval-depth} too much, such code can cause stack overflow instead. On some systems, this overflow @@ -851,9 +851,6 @@ less than 100, Lisp will reset it to 100 if the given value is reached. Entry to the Lisp debugger increases the value, if there is little room left, to make sure the debugger itself has room to execute. - -@code{max-specpdl-size} provides another limit on nesting. -@xref{Definition of max-specpdl-size,, Local Variables}. @end defopt @defvar values diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 975e945b343..ccd19630bf7 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -358,27 +358,6 @@ Variables}); a few variables have terminal-local bindings like ordinary local bindings, but they are localized depending on where you are in Emacs. -@defopt max-specpdl-size -@anchor{Definition of max-specpdl-size} -@cindex variable limit error -@cindex evaluation error -@cindex infinite recursion -This variable defines the limit on the total number of local variable -bindings and @code{unwind-protect} cleanups (@pxref{Cleanups,, -Cleaning Up from Nonlocal Exits}) that are allowed before Emacs -signals an error (with data @code{"Variable binding depth exceeds -max-specpdl-size"}). - -This limit, with the associated error when it is exceeded, is one way -that Lisp avoids infinite recursion on an ill-defined function. -@code{max-lisp-eval-depth} provides another limit on depth of nesting. -@xref{Definition of max-lisp-eval-depth,, Eval}. - -The default value is 2500. Entry to the Lisp debugger increases the -value, if there is little room left, to make sure the debugger itself -has room to execute. -@end defopt - @node Void Variables @section When a Variable is Void @cindex @code{void-variable} error diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 98f59b89c01..89a340e7343 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10392,7 +10392,6 @@ memory than it would otherwise, but it's guaranteed to fix the problem. @cindex Recursion depth @cindex ``Computation got stuck'' message @cindex @code{max-lisp-eval-depth} -@cindex @code{max-specpdl-size} Calc uses recursion in many of its calculations. Emacs Lisp keeps a variable @code{max-lisp-eval-depth} which limits the amount of recursion possible in an attempt to recover from program bugs. If a calculation @@ -10406,9 +10405,6 @@ is also an @kbd{I M} (@code{calc-less-recursion-depth}) command which decreases this limit by a factor of two, down to a minimum value of 200. The default value is 1000. -These commands also double or halve @code{max-specpdl-size}, another -internal Lisp recursion limit. The minimum value for this limit is 600. - @node Caches @subsection Caches diff --git a/etc/NEWS b/etc/NEWS index a739d74b650..723bdd7c75d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3806,6 +3806,12 @@ the same but works by modifying LIST destructively. --- ** 'string-split' is now an alias for 'split-string'. ++++ +** The variable 'max-specpdl-size' has been made obsolete. +Now 'max-lisp-eval-depth' alone is used for limiting Lisp recursion +and stack usage. 'max-specpdl-size' is still present as a plain +variable for compatibility but its limiting powers have been taken away. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/leim/Makefile.in b/leim/Makefile.in index 29b9f3b2f86..fbd733b7f66 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -128,7 +128,6 @@ leim-list.el: ${leimdir}/leim-list.el ${leimdir}/leim-list.el: ${srcdir}/leim-ext.el ${TIT_MISC} $(AM_V_GEN)rm -f $@ $(AM_V_at)${RUN_EMACS} -l international/quail \ - --eval "(setq max-specpdl-size 5000)" \ --eval "(update-leim-list-file (unmsys--file-name \"${leimdir}\"))" $(AM_V_at)sed -n -e '/^[^;]/p' -e 's/^;\(;*\)inc /;\1 /p' < $< >> $@ @@ -139,7 +138,6 @@ ${leimdir}/ja-dic/ja-dic.el: | $(leimdir)/ja-dic generate-ja-dic: ${leimdir}/ja-dic/ja-dic.el ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L $(AM_V_GEN)$(RUN_EMACS) -batch -l ja-dic-cnv \ - --eval "(setq max-specpdl-size 5000)" \ -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map diff --git a/lisp/Makefile.in b/lisp/Makefile.in index c73a623cce9..bcf4a3146d4 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -70,9 +70,7 @@ BYTE_COMPILE_FLAGS = \ --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \ $(BYTE_COMPILE_EXTRA_FLAGS) # ... but we must prefer .elc files for those in the early bootstrap. -# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el. -compile-first: BYTE_COMPILE_FLAGS = \ - --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS) +compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. They're ordered by size, so we use @@ -342,8 +340,8 @@ compile-first: $(COMPILE_FIRST) .PHONY: compile-targets # TARGETS is set dynamically in the recursive call from 'compile-main'. -# Do not build comp.el unless necessary not to exceed max-specpdl-size and -# max-lisp-eval-depth in normal builds. +# Do not build comp.el unless necessary not to exceed max-lisp-eval-depth +# in normal builds. ifneq ($(HAVE_NATIVE_COMP),yes) compile-targets: $(filter-out ./emacs-lisp/comp-cstr.elc,$(filter-out ./emacs-lisp/comp.elc,$(TARGETS))) else diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index 0e8ea42bedc..758b9201843 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -52,18 +52,14 @@ With a prefix, push that prefix as a number onto the stack." (calc-less-recursion-depth n) (let ((n (if n (prefix-numeric-value n) 2))) (if (> n 1) - (setq max-specpdl-size (* max-specpdl-size n) - max-lisp-eval-depth (* max-lisp-eval-depth n)))) + (setq max-lisp-eval-depth (* max-lisp-eval-depth n)))) (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)))) (defun calc-less-recursion-depth (n) (interactive "P") (let ((n (if n (prefix-numeric-value n) 2))) (if (> n 1) - (setq max-specpdl-size - (max (/ max-specpdl-size n) 600) - max-lisp-eval-depth - (max (/ max-lisp-eval-depth n) 200)))) + (setq max-lisp-eval-depth (max (/ max-lisp-eval-depth n) 200)))) (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 5077c8c8528..c0f87ad3d42 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1625,8 +1625,7 @@ See calc-keypad for details." (error (if (and (eq (car err) 'error) (stringp (nth 1 err)) - (string-match "max-specpdl-size\\|max-lisp-eval-depth" - (nth 1 err))) + (string-search "max-lisp-eval-depth" (nth 1 err))) (error (substitute-command-keys "Computation got stuck or ran too long. Type \\`M' to increase the limit")) (setq calc-aborted-prefix nil) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index ff9f991ff4a..40ff8fc86d3 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -177,10 +177,9 @@ Lays claim to all -by.el, and -wy.el files." (cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar)) "Insert rules needed by THIS target. -This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be -needed for the compilation of the resulting parsers." - (insert (format "%s: EMACSFLAGS+= --eval '(setq max-specpdl-size 1500 \ -max-lisp-eval-depth 700)'\n" +This raises `max-lisp-eval-depth', which can be needed for the compilation +of the resulting parsers." + (insert (format "%s: EMACSFLAGS+= --eval '(setq max-lisp-eval-depth 700)'\n" (oref this name)))) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar)) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 72037f47108..8ba0e346fff 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1009,7 +1009,6 @@ Return non-nil if there were no errors, nil if errors." packagename (byte-compile-dest-file packagename)) (let (;; Some complex grammar table expressions need a few ;; more resources than the default. - (max-specpdl-size (max 3000 max-specpdl-size)) (max-lisp-eval-depth (max 1000 max-lisp-eval-depth)) ) ;; byte compile the resultant file diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 0e1cb4589da..d7fb56c9854 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -251,7 +251,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; emacs.c (report-emacs-bug-address emacsbug string) ;; eval.c - (max-specpdl-size limits integer) (max-lisp-eval-depth limits integer) (max-mini-window-height limits (choice (const :tag "quarter screen" nil) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a9087313b18..35acbff9b17 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4044,7 +4044,6 @@ the deferred compilation mechanism." (list "Not a function symbol or file" function-or-file))) (catch 'no-native-compile (let* ((print-symbols-bare t) - (max-specpdl-size (max max-specpdl-size 5000)) (data function-or-file) (comp-native-compiling t) (byte-native-qualities nil) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 31c05057bfa..67704bdb51c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -129,7 +129,7 @@ contains an infinite loop. When Edebug is instrumenting code containing very large quoted lists, it may reach this limit and give the error message \"Too deep - perhaps infinite loop in spec?\". Make this limit larger to countermand that, but you may also need to -increase `max-lisp-eval-depth' and `max-specpdl-size'." +increase `max-lisp-eval-depth'." :type 'integer :version "26.1") @@ -1107,8 +1107,7 @@ purpose by adding an entry to this alist, and setting edebug-best-error edebug-error-point ;; Do this once here instead of several times. - (max-lisp-eval-depth (+ 800 max-lisp-eval-depth)) - (max-specpdl-size (+ 2000 max-specpdl-size))) + (max-lisp-eval-depth (+ 800 max-lisp-eval-depth))) (let ((no-match (catch 'no-match (setq result (edebug-read-and-maybe-wrap-form1)) @@ -2317,7 +2316,6 @@ and run its entry function, and set up `edebug-before' and ;; but not inside an unwind-protect. ;; Doing it here also keeps it from growing too large. (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? - (max-specpdl-size (+ 200 max-specpdl-size)) (debugger edebug-debugger) ; only while edebug is active. (edebug-outside-debug-on-error debug-on-error) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index cae5dd00d1d..4d5a39458d2 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -133,7 +133,6 @@ usually more efficient than that of a simplified version: (save-match-data ;; Recurse on the sorted list. (let* ((max-lisp-eval-depth 10000) - (max-specpdl-size 10000) (completion-ignore-case nil) (completion-regexp-list nil) (open (cond ((stringp paren) paren) (paren "\\("))) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 69069183a3f..8f11e6f04a4 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -331,7 +331,6 @@ and the hook `eshell-exit-hook'." (setq-local require-final-newline nil) (setq-local max-lisp-eval-depth (max 3000 max-lisp-eval-depth)) - (setq-local max-specpdl-size (max 6000 max-lisp-eval-depth)) (setq-local eshell-last-input-start (point-marker)) (setq-local eshell-last-input-end (point-marker)) diff --git a/lisp/loadup.el b/lisp/loadup.el index 634a3314361..c01c827a75e 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -244,9 +244,7 @@ (load "language/indonesian") (load "indent") -(let ((max-specpdl-size (max max-specpdl-size 1800))) - ;; A particularly demanding file to load; 1600 does not seem to be enough. - (load "emacs-lisp/cl-generic")) +(load "emacs-lisp/cl-generic") (load "simple") (load "emacs-lisp/seq") (load "emacs-lisp/nadvice") diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 0ad934107d3..9a04d890973 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -2831,9 +2831,7 @@ removed and entries from `mh-invisible-header-fields' are added." (setq mh-invisible-header-fields-compiled (concat "^" - ;; workaround for insufficient default - (let ((max-specpdl-size 1000)) - (regexp-opt fields t)))) + (regexp-opt fields t))) (setq mh-invisible-header-fields-compiled nil)))) ;; Compile invisible header fields. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 54ce9b1a41c..d56420eb02e 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -373,7 +373,6 @@ DOM should be a parse tree as generated by shr-width (* shr-width (frame-char-width))) (shr--window-width))) - (max-specpdl-size max-specpdl-size) (shr--link-targets nil) (hscroll (window-hscroll)) ;; `bidi-display-reordering' is supposed to be only used for @@ -625,41 +624,34 @@ size, and full-buffer size." (shr-stylesheet shr-stylesheet) (shr-depth (1+ shr-depth)) (start (point))) - ;; shr uses many frames per nested node. - (if (and (> shr-depth (/ max-specpdl-size 15)) - (not (and shr-offer-extend-specpdl - (y-or-n-p "Too deeply nested to render properly; increase `max-specpdl-size'?") - (setq max-specpdl-size (* max-specpdl-size 2))))) - (setq shr-warning - "Not rendering the complete page because of too-deep nesting") + (when style + (if (string-match-p "color\\|display\\|border-collapse" style) + (setq shr-stylesheet (nconc (shr-parse-style style) + shr-stylesheet)) + (setq style nil))) + ;; If we have a display:none, then just ignore this part of the DOM. + (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none") + (and shr-discard-aria-hidden + (equal (dom-attr dom 'aria-hidden) "true"))) + ;; We don't use shr-indirect-call here, since shr-descend is + ;; the central bit of shr.el, and should be as fast as + ;; possible. Having one more level of indirection with its + ;; negative effect on performance is deemed unjustified in + ;; this case. + (cond (external + (funcall external dom)) + ((fboundp function) + (funcall function dom)) + (t + (shr-generic dom))) + (when-let ((id (dom-attr dom 'id))) + (push (cons id (set-marker (make-marker) start)) shr--link-targets)) + ;; If style is set, then this node has set the color. (when style - (if (string-match-p "color\\|display\\|border-collapse" style) - (setq shr-stylesheet (nconc (shr-parse-style style) - shr-stylesheet)) - (setq style nil))) - ;; If we have a display:none, then just ignore this part of the DOM. - (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none") - (and shr-discard-aria-hidden - (equal (dom-attr dom 'aria-hidden) "true"))) - ;; We don't use shr-indirect-call here, since shr-descend is - ;; the central bit of shr.el, and should be as fast as - ;; possible. Having one more level of indirection with its - ;; negative effect on performance is deemed unjustified in - ;; this case. - (cond (external - (funcall external dom)) - ((fboundp function) - (funcall function dom)) - (t - (shr-generic dom))) - (when-let ((id (dom-attr dom 'id))) - (push (cons id (set-marker (make-marker) start)) shr--link-targets)) - ;; If style is set, then this node has set the color. - (when style - (shr-colorize-region - start (point) - (cdr (assq 'color shr-stylesheet)) - (cdr (assq 'background-color shr-stylesheet)))))))) + (shr-colorize-region + start (point) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet))))))) (defun shr-fill-text (text) (if (zerop (length text)) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 58fb82b6ed0..1a4b6dbeb11 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -149,10 +149,9 @@ BITS must be of length nrings. Start at START-TIME." (setq show-trailing-whitespace nil) (unwind-protect (let* - (;; These lines can cause Emacs to crash if you ask for too - ;; many rings. If you uncomment them, on most systems you + (;; This line can cause Emacs to crash if you ask for too + ;; many rings. If you uncomment it, on most systems you ;; can get 10,000+ rings. - ;;(max-specpdl-size (max max-specpdl-size (* nrings 15))) ;;(max-lisp-eval-depth (max max-lisp-eval-depth (+ nrings 20))) (vert (not hanoi-horizontal-flag)) (pole-width (length (format "%d" (max 0 (1- nrings))))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 614ee60fa03..c3704a05dbb 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3718,7 +3718,6 @@ This is part of `cperl-find-pods-heres' (below)." overshoot warning-message))) -;; Debugging this may require (setq max-specpdl-size 2000)... (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) "Scan the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is non-nil after evaluation, diff --git a/lisp/subr.el b/lisp/subr.el index d7cdc28abba..59f9308f31e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1859,6 +1859,14 @@ be a list of the form returned by `event-start' and `event-end'." ;; in warnings when using `values' in let-bindings. ;;(make-obsolete-variable 'values "no longer used" "28.1") +(defvar max-specpdl-size 2500 + "Former limit on specbindings, now without effect. +This variable used to limit the size of the specpdl stack which, +among other things, holds dynamic variable bindings and `unwind-protect' +activations. To prevent runaway recursion, use `max-lisp-eval-depth' +instead; it will indirectly limit the specpdl stack size as well.") +(make-obsolete-variable 'max-specpdl-size nil "29.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/eval.c b/src/eval.c index bd414fb8687..7da1d8fb989 100644 --- a/src/eval.c +++ b/src/eval.c @@ -211,9 +211,7 @@ backtrace_thread_next (struct thread_state *tstate, union specbinding *pdl) void init_eval_once (void) { - /* Don't forget to update docs - (lispref nodes "Local Variables" and "Eval"). */ - max_specpdl_size = 2500; + /* Don't forget to update docs (lispref node "Eval"). */ max_lisp_eval_depth = 1600; Vrun_hooks = Qnil; pdumper_do_now_and_after_load (init_eval_once_for_pdumper); @@ -265,8 +263,7 @@ max_ensure_room (intmax_t *m, intmax_t a, intmax_t b) static void restore_stack_limits (Lisp_Object data) { - integer_to_intmax (XCAR (data), &max_specpdl_size); - integer_to_intmax (XCDR (data), &max_lisp_eval_depth); + integer_to_intmax (data, &max_lisp_eval_depth); } /* Call the Lisp debugger, giving it argument ARG. */ @@ -278,9 +275,6 @@ call_debugger (Lisp_Object arg) specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; intmax_t old_depth = max_lisp_eval_depth; - /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ - ptrdiff_t counti = specpdl_ref_to_count (count); - intmax_t old_max = max (max_specpdl_size, counti); /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 @@ -288,20 +282,8 @@ call_debugger (Lisp_Object arg) currently requires 77 additional frames. See bug#31919. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - /* While debugging Bug#16603, previous value of 100 was found - too small to avoid specpdl overflow in the debugger itself. */ - max_ensure_room (&max_specpdl_size, counti, 200); - - if (old_max == counti) - { - /* We can enter the debugger due to specpdl overflow (Bug#16603). */ - specpdl_ptr--; - grow_specpdl (); - } - /* Restore limits after leaving the debugger. */ - record_unwind_protect (restore_stack_limits, - Fcons (make_int (old_max), make_int (old_depth))); + record_unwind_protect (restore_stack_limits, make_int (old_depth)); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -933,12 +915,9 @@ usage: (let* VARLIST BODY...) */) lexenv = Vinternal_interpreter_environment; Lisp_Object varlist = XCAR (args); - while (CONSP (varlist)) + FOR_EACH_TAIL (varlist) { - maybe_quit (); - elt = XCAR (varlist); - varlist = XCDR (varlist); if (SYMBOLP (elt)) { var = elt; @@ -1752,8 +1731,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - ptrdiff_t counti = specpdl_ref_to_count (SPECPDL_INDEX ()); - max_ensure_room (&max_specpdl_size, counti, 40); call2 (Vsignal_hook_function, error_symbol, data); } @@ -1822,8 +1799,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t counti = specpdl_ref_to_count (count); - max_ensure_room (&max_specpdl_size, counti, 200); specbind (Qdebugger, Qdebug_early); call_debugger (list2 (Qerror, Fcons (error_symbol, data))); unbind_to (count, Qnil); @@ -1839,12 +1814,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t counti = specpdl_ref_to_count (count); AUTO_STRING (redisplay_trace, "*Redisplay_trace*"); Lisp_Object redisplay_trace_buffer; AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ Lisp_Object delayed_warning; - max_ensure_room (&max_specpdl_size, counti, 200); redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil); current_buffer = XBUFFER (redisplay_trace_buffer); if (!backtrace_yet) /* Are we on the first backtrace of the command? */ @@ -2376,17 +2349,12 @@ grow_specpdl_allocation (void) eassert (specpdl_ptr == specpdl_end); specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + ptrdiff_t max_size = PTRDIFF_MAX - 1000; union specbinding *pdlvec = specpdl - 1; ptrdiff_t size = specpdl_end - specpdl; ptrdiff_t pdlvecsize = size + 1; if (max_size <= size) - { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; - if (max_size <= size) - xsignal0 (Qexcessive_variable_binding); - } + xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */ pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); specpdl = pdlvec + 1; specpdl_end = specpdl + pdlvecsize - 1; @@ -4229,22 +4197,6 @@ Lisp_Object backtrace_top_function (void) void syms_of_eval (void) { - DEFVAR_INT ("max-specpdl-size", max_specpdl_size, - doc: /* Limit on number of Lisp variable bindings and `unwind-protect's. - -If Lisp code tries to use more bindings than this amount, an error is -signaled. - -You can safely increase this variable substantially if the default -value proves inconveniently small. However, if you increase it too -much, Emacs could run out of memory trying to make the stack bigger. -Note that this limit may be silently increased by the debugger if -`debug-on-error' or `debug-on-quit' is set. - -\"spec\" is short for \"special variables\", i.e., dynamically bound -variables. \"PDL\" is short for \"push-down list\", which is an old -term for \"stack\". */); - DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, doc: /* Limit on depth in `eval', `apply' and `funcall' before error. diff --git a/src/fileio.c b/src/fileio.c index 6efea8ac369..dd7f85ec97f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6019,11 +6019,6 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) bool old_message_p = 0; struct auto_save_unwind auto_save_unwind; - intmax_t sum = INT_ADD_WRAPV (specpdl_end - specpdl, 40, &sum) - ? INTMAX_MAX : sum; - if (max_specpdl_size < sum) - max_specpdl_size = sum; - if (minibuf_level) no_message = Qt; -- cgit v1.2.3 From 0a15956f495338b4f2260c7676a6040436a90645 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 19 Sep 2022 22:35:51 +0300 Subject: * lisp/outline.el (outline-minor-mode-use-margins): New user option. (outline--use-margins, outline--use-buttons, outline--use-rtl): New buffer-local internal variables. (outline-open, outline-close): Move :ascent center to default of define-icon. Use ASCII-art for text. Fix docstring and help-echo. (outline-close-rtl, outline-open-in-margins) (outline-close-in-margins, outline-close-rtl-in-margins): New icon definitions. (outline-minor-mode-highlight-buffer): Remove outline--insert-open-button since initial outline--fix-up-all-buttons is added now to outline-minor-mode. (outline-minor-mode): Set buffer-local outline--use-buttons, outline--use-margins and outline--use-rtl. Show/hide margins for outline--use-margins. Add hook after-change-functions for editable buffers. Move outline--fix-up-all-buttons for both cases: font-lock and non-font-lock. (outline--use-buttons-p): Remove function. (outline--make-button-overlay): Use outline--use-rtl icon outline-close-rtl. (outline--make-margin-overlay): New function. (outline--insert-open-button, outline--insert-close-button): Add optional arg 'use-margins'. (outline--fix-up-all-buttons): Call outline--insert-close-button and outline--insert-open-button with arg outline--use-margins. (outline-cycle-buffer): Remove outline--fix-up-all-buttons that is already called from outline-flag-region. * lisp/emacs-lisp/icons.el (icons--create): Handle keywords :rotation and :ascent with the default value 'center (bug#57813). * doc/emacs/text.texi (Outline Mode): Mention outline-minor-mode-use-margins. --- doc/emacs/text.texi | 5 ++ etc/NEWS | 13 +++- lisp/emacs-lisp/icons.el | 6 +- lisp/outline.el | 169 ++++++++++++++++++++++++++++++++++++++--------- 4 files changed, 157 insertions(+), 36 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index fa8eaf09245..35dce18d022 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1003,6 +1003,11 @@ addition to ellipsis to show that a section is hidden. Using @kbd{RET} (or clicking on the button with a mouse) will toggle displaying the section. +@vindex outline-minor-mode-use-margins + If @code{outline-minor-mode-use-margins} is non-@code{nil}, Outline +minor mode will use the window margins in addition to ellipsis to show +that a section is hidden. + @vindex outline-minor-mode-cycle If the @code{outline-minor-mode-cycle} user option is non-@code{nil}, the @kbd{TAB} and @kbd{S-@key{TAB}} keys are enabled on the diff --git a/etc/NEWS b/etc/NEWS index ee333a84e45..821da805ca2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -962,7 +962,14 @@ or is itself too long. *** New user option 'outline-minor-mode-use-buttons'. If non-nil, Outline Minor Mode will use buttons to hide/show outlines in addition to the ellipsis. The default is nil in editing modes, but -non-nil in 'special-mode' and its derivatives. +non-nil in 'help-mode' and its derivatives. + ++++ +*** New user option 'outline-minor-mode-use-margins'. +If non-nil, Outline Minor Mode will use the window margins to +hide/show outlines in addition to the ellipsis. The default is +non-nil in 'special-mode' and its derivatives, and it can be used in +editing modes. ** Windows @@ -1489,8 +1496,8 @@ characters instead of just 'SPC' and 'TAB'. This mode adds some highlighting, fixes the 'M-q' command, and has commands for doing maintenance of the Emacs NEWS files. In addition, this mode turns on 'outline-minor-mode', and thus displays -customizable icons (see 'icon-preference') on heading lines. To -disable these icons, customize 'outline-minor-mode-use-buttons' to a +customizable icons (see 'icon-preference') in the margins. To +disable these icons, customize 'outline-minor-mode-use-margins' to a nil value. --- diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index ff4f20c2071..ccc36577932 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -202,7 +202,11 @@ present if the icon is represented by an image." :height (if (eq height 'line) (window-default-line-height) height) - :scale 1 :ascent 'center) + :scale 1 + :rotation (plist-get keywords :rotation) + :ascent (if (plist-member keywords :ascent) + (plist-get keywords :ascent) + 'center)) (create-image file)))))) (cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords) diff --git a/lisp/outline.el b/lisp/outline.el index e3fbd8b3272..ab37e398e98 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -292,25 +292,65 @@ buffers (yet) -- that will be amended in a future version." :safe #'booleanp :version "29.1") +(defvar-local outline--use-buttons nil + "Non-nil when buffer displays clickable buttons on the headings.") + +(defvar-local outline--use-rtl nil + "Non-nil when direction of clickable buttons is right-to-left.") + +(defcustom outline-minor-mode-use-margins '(derived-mode . special-mode) + "Whether to display clickable buttons in the margins. +The value should be a `buffer-match-p' condition. + +These buttons can be used to hide and show the body under the heading. +Note that this feature is meant to be used in editing buffers." + :type 'buffer-predicate + :safe #'booleanp + :version "29.1") + +(defvar-local outline--use-margins nil + "Non-nil when buffer displays clickable buttons in the margins.") + (define-icon outline-open nil - '((image "outline-open.svg" "outline-open.pbm" - :height 15 :ascent center) + '((image "outline-open.svg" "outline-open.pbm" :height 15) (emoji "🔽") (symbol " ▼ ") - (text " open ")) - "Icon used for buttons for opening a section in outline buffers." + (text " v ")) + "Icon used for buttons for opened sections in outline buffers." :version "29.1" - :help-echo "Open this section") + :help-echo "Close this section") (define-icon outline-close nil - '((image "outline-close.svg" "outline-close.pbm" - :height 15 :ascent center) + '((image "outline-close.svg" "outline-close.pbm" :height 15) (emoji "▶️") (symbol " ▶ ") - (text " close ")) - "Icon used for buttons for closing a section in outline buffers." + (text " > ")) + "Icon used for buttons for closed sections in outline buffers." :version "29.1" - :help-echo "Close this section") + :help-echo "Open this section") + +(define-icon outline-close-rtl outline-close + '((image "outline-close.svg" "outline-close.pbm" :height 15 :rotation 180) + (emoji "◀️") + (symbol " ◀ ") + (text " < ")) + "Right-to-left icon used for buttons in closed outline sections." + :version "29.1") + +(define-icon outline-open-in-margins outline-open + '((image "outline-open.svg" "outline-open.pbm" :height 10)) + "Icon used for buttons for opened sections in margins." + :version "29.1") + +(define-icon outline-close-in-margins outline-close + '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90)) + "Icon used for buttons for closed sections in margins." + :version "29.1") + +(define-icon outline-close-rtl-in-margins outline-close-rtl + '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90)) + "Right-to-left icon used for closed sections in margins." + :version "29.1") (defvar outline-level #'outline-level @@ -439,9 +479,7 @@ outline font-lock faces to those of major mode." (when (or (memq outline-minor-mode-highlight '(append override)) (and (eq outline-minor-mode-highlight t) (not (get-text-property (match-beginning 0) 'face)))) - (overlay-put overlay 'face (outline-font-lock-face))) - (when (outline--use-buttons-p) - (outline--insert-open-button))) + (overlay-put overlay 'face (outline-font-lock-face)))) (goto-char (match-end 0)))))) ;;;###autoload @@ -456,13 +494,37 @@ See the command `outline-mode' for more information on this mode." (key-description outline-minor-mode-prefix) outline-mode-prefix-map) (if outline-minor-mode (progn + (cond + ((buffer-match-p outline-minor-mode-use-margins (current-buffer)) + (setq-local outline--use-margins t)) + ((buffer-match-p outline-minor-mode-use-buttons (current-buffer)) + (setq-local outline--use-buttons t))) + (when (and (or outline--use-buttons outline--use-margins) + (eq (current-bidi-paragraph-direction) 'right-to-left)) + (setq-local outline--use-rtl t)) + (when outline--use-margins + (if outline--use-rtl + (setq-local right-margin-width (1+ right-margin-width)) + (setq-local left-margin-width (1+ left-margin-width))) + (setq-local fringes-outside-margins t) + ;; Force display of margins + (set-window-buffer nil (window-buffer))) + (when (or outline--use-buttons outline--use-margins) + (add-hook 'after-change-functions + (lambda (beg end _len) + (when outline--use-buttons + (remove-overlays beg end 'outline-button t)) + (when outline--use-margins + (remove-overlays beg end 'outline-margin t)) + (outline--fix-up-all-buttons beg end)) + nil t)) (when outline-minor-mode-highlight (if (and global-font-lock-mode (font-lock-specified-p major-mode)) (progn (font-lock-add-keywords nil outline-font-lock-keywords t) - (font-lock-flush) - (outline--fix-up-all-buttons)) + (font-lock-flush)) (outline-minor-mode-highlight-buffer))) + (outline--fix-up-all-buttons) ;; Turn off this mode if we change major modes. (add-hook 'change-major-mode-hook (lambda () (outline-minor-mode -1)) @@ -476,16 +538,19 @@ See the command `outline-mode' for more information on this mode." (font-lock-remove-keywords nil outline-font-lock-keywords)) (remove-overlays nil nil 'outline-overlay t) (font-lock-flush)) + (when outline--use-margins + (if outline--use-rtl + (setq-local right-margin-width (1- right-margin-width)) + (setq-local left-margin-width (1- left-margin-width))) + (setq-local fringes-outside-margins nil) + ;; Force removal of margins + (set-window-buffer nil (window-buffer))) (setq line-move-ignore-invisible nil) ;; Cause use of ellipses for invisible text. (remove-from-invisibility-spec '(outline . t)) ;; When turning off outline mode, get rid of any outline hiding. (outline-show-all))) -(defun outline--use-buttons-p () - (and outline-minor-mode - (buffer-match-p outline-minor-mode-use-buttons (current-buffer)))) - (defvar-local outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). @@ -1000,8 +1065,11 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'follow-link 'mouse-face) (overlay-put o 'mouse-face 'highlight) (overlay-put o 'outline-button t)) - (let ((icon - (icon-elements (if (eq type 'close) 'outline-close 'outline-open))) + (let ((icon (icon-elements (if (eq type 'close) + (if outline--use-rtl + 'outline-close-rtl + 'outline-close) + 'outline-open))) (inhibit-read-only t)) ;; In editing buffers we use overlays only, but in other buffers ;; we use a mix of text properties, text and overlays to make @@ -1015,10 +1083,40 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'face (plist-get icon 'face)))) o)) -(defun outline--insert-open-button () +(defun outline--make-margin-overlay (type) + (let ((o (seq-find (lambda (o) + (overlay-get o 'outline-margin)) + (overlays-at (point))))) + (unless o + (setq o (make-overlay (point) (1+ (point)))) + (overlay-put o 'follow-link 'mouse-face) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'outline-margin t)) + (let ((icon (icon-elements (if (eq type 'close) + (if outline--use-rtl + 'outline-close-rtl-in-margins + 'outline-close-in-margins) + 'outline-open-in-margins))) + (inhibit-read-only t)) + (overlay-put + o 'before-string + (propertize " " 'display + `((margin ,(if outline--use-rtl + 'right-margin 'left-margin)) + ,(or (plist-get icon 'image) + (plist-get icon 'string)))))) + o)) + +(defun outline--insert-open-button (&optional use-margins) (with-silent-modifications (save-excursion - (beginning-of-line) + (beginning-of-line) + (if use-margins + (let ((o (outline--make-margin-overlay 'open))) + (overlay-put o 'help-echo "Click to hide") + (overlay-put o 'keymap + (define-keymap + "" #'outline-hide-subtree))) (when (derived-mode-p 'special-mode) (let ((inhibit-read-only t)) (insert " ") @@ -1028,12 +1126,19 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'keymap (define-keymap "RET" #'outline-hide-subtree - "" #'outline-hide-subtree)))))) + "" #'outline-hide-subtree + " " #'outline-hide-subtree))))))) -(defun outline--insert-close-button () +(defun outline--insert-close-button (&optional use-margins) (with-silent-modifications (save-excursion - (beginning-of-line) + (beginning-of-line) + (if use-margins + (let ((o (outline--make-margin-overlay 'close))) + (overlay-put o 'help-echo "Click to show") + (overlay-put o 'keymap + (define-keymap + "" #'outline-show-subtree))) (when (derived-mode-p 'special-mode) (let ((inhibit-read-only t)) (insert " ") @@ -1043,10 +1148,11 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'keymap (define-keymap "RET" #'outline-show-subtree - "" #'outline-show-subtree)))))) + "" #'outline-show-subtree + " " #'outline-show-subtree))))))) (defun outline--fix-up-all-buttons (&optional from to) - (when (outline--use-buttons-p) + (when (or outline--use-buttons outline--use-margins) (when from (save-excursion (goto-char from) @@ -1057,8 +1163,8 @@ If non-nil, EVENT should be a mouse event." (outline-end-of-heading) (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline)) (overlays-at (point)))) - (outline--insert-close-button) - (outline--insert-open-button))) + (outline--insert-close-button outline--use-margins) + (outline--insert-open-button outline--use-margins))) (or from (point-min)) (or to (point-max))))) (define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") @@ -1627,8 +1733,7 @@ With a prefix argument, show headings up to that LEVEL." (t (outline-show-all) (setq outline--cycle-buffer-state 'show-all) - (message "Show all"))) - (outline--fix-up-all-buttons))) + (message "Show all"))))) (defvar-keymap outline-navigation-repeat-map -- cgit v1.2.3 From bd40ec5d57c0787530ebac1e14352a34fe235844 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 19 Sep 2022 16:19:44 -0400 Subject: * lisp/emacs-lisp/cl-generic.el (cl--generic-lambda): Fix bug#57903 Fall back to old slower calling convention in dynbound code (bug#56596). --- lisp/emacs-lisp/cl-generic.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 0560ddda268..3fd85bcb880 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -425,11 +425,13 @@ the specializer used will be the one returned by BODY." ;; only called with explicit arguments. (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)) (λ-lift (mapcar #'car uses-cnm))) - (if (not uses-cnm) - (cons nil - `#'(lambda (,@args) - ,@(car parsed-body) - ,nbody)) + (cond + ((not uses-cnm) + (cons nil + `#'(lambda (,@args) + ,@(car parsed-body) + ,nbody))) + (lexical-binding (cons 'curried `#'(lambda (,nm) ;Called when constructing the effective method. (let ((,nmp (if (cl--generic-isnot-nnm-p ,nm) @@ -465,7 +467,20 @@ the specializer used will be the one returned by BODY." ;; A destructuring-bind would do the trick ;; as well when/if it's more efficient. (apply (lambda (,@λ-lift ,@args) ,nbody) - ,@λ-lift ,arglist))))))))) + ,@λ-lift ,arglist))))))) + (t + (cons t + `#'(lambda (,cnm ,@args) + ,@(car parsed-body) + ,(macroexp-warn-and-return + "cl-defmethod used without lexical-binding" + (if (not (assq nmp uses-cnm)) + nbody + `(let ((,nmp (lambda () + (cl--generic-isnot-nnm-p ,cnm)))) + ,nbody)) + 'lexical t))))) + )) (f (error "Unexpected macroexpansion result: %S" f)))))) (put 'cl-defmethod 'function-documentation -- cgit v1.2.3 From 616dcf27e57388403d4c28d441bf7310bb665241 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 20 Sep 2022 12:21:40 +0200 Subject: ; Fix typos in Lisp symbols --- lisp/allout-widgets.el | 4 ++-- lisp/autorevert.el | 2 +- lisp/cedet/ede/autoconf-edit.el | 3 +-- lisp/emacs-lisp/benchmark.el | 2 +- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/epa-ks.el | 4 ++-- lisp/eshell/em-glob.el | 2 +- lisp/frame.el | 2 +- lisp/hexl.el | 2 +- lisp/hilit-chg.el | 1 - lisp/imenu.el | 2 +- lisp/international/mule.el | 2 +- lisp/org/ox.el | 2 +- lisp/progmodes/cperl-mode.el | 2 +- lisp/progmodes/flymake.el | 2 +- lisp/progmodes/hideif.el | 4 ++-- lisp/progmodes/python.el | 4 ++-- lisp/tar-mode.el | 2 +- lisp/vc/add-log.el | 2 +- test/lisp/electric-tests.el | 2 +- 20 files changed, 23 insertions(+), 25 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 736fb7d99d6..7a65777d323 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -312,7 +312,7 @@ enhancements, directly.") (defvar-local allout-inhibit-body-modification-hook nil "Override de-escaping of text-prefixes in item bodies during specific changes. -This is used by `allout-buffer-modification-handler' to signal such changes +This is used by `allout-body-modification-handler' to signal such changes to `allout-body-modification-handler', and is always reset by `allout-post-command-business'.") ;;;_ = allout-widgets-icons-cache @@ -2180,7 +2180,7 @@ Operation is inhibited by `allout-inhibit-body-modification-handler'." ;; `allout-before-modification-handler' and ;; `allout-inhibit-body-modification-handler'. ;; -;; Adds the overlay to the `allout-unresolved-body-mod-workhash' during +;; Adds the overlay to the `allout-unresolved-body-mod-workroster' during ;; before-change operation, and removes from that list during after-change ;; operation. (cond (allout-inhibit-body-modification-hook nil))) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 97a122b7bcf..f66c4935d70 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -677,7 +677,7 @@ will use an up-to-date value of `auto-revert-interval'." ;; ;; We do this by reverting immediately in response to the first in a ;; flurry of notifications. Any notifications during the following -;; `auto-revert-lockout-interval' seconds are noted but not acted upon +;; `auto-revert--lockout-interval' seconds are noted but not acted upon ;; until the end of that interval. (defconst auto-revert--lockout-interval 2.5 diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index faf50edaa13..e7a15220550 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -34,8 +34,7 @@ "Initialize a new configure.ac in ROOTDIR for PROGRAM using TESTFILE. ROOTDIR is the root directory of a given autoconf controlled project. PROGRAM is the program to be configured. -TESTFILE is the file used with AC_INIT. -Configure the initial configure script using `autoconf-new-automake-string'." +TESTFILE is the file used with AC_INIT." (interactive "DRoot Dir: \nsProgram: \nsTest File: ") (require 'ede/srecode) (if (bufferp rootdir) diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index c5f621c6c86..7535f0e2f51 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -70,7 +70,7 @@ number of repetitions actually used." (defun benchmark--adaptive (func time) "Measure the run time of FUNC, calling it enough times to last TIME seconds. -Result is (REPETITIONS . DATA) where DATA is as returned by `branchmark-call'." +Result is (REPETITIONS . DATA) where DATA is as returned by `benchmark-call'." (named-let loop ((repetitions 1) (data (let ((x (list 0))) (setcdr x x) x))) ;; (message "Running %d iteration" repetitions) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7629e190401..21cd747518f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1666,7 +1666,7 @@ URLs." (seq "(" (* (not ")")) ")"))) ")"))) "" - ;; Heuristic: We can't reliably do `subsititute-command-keys' + ;; Heuristic: We can't reliably do `substitute-command-keys' ;; substitutions, since the value of a keymap in general can't be ;; known at compile time. So instead, we assume that these ;; substitutions are of some length N. diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el index 8ece09d1488..fc32061449d 100644 --- a/lisp/epa-ks.el +++ b/lisp/epa-ks.el @@ -41,7 +41,7 @@ (defcustom epa-keyserver "pgp.mit.edu" "Domain of keyserver. -This is used by `epa-ks-lookup-key', for looking up public keys." +This is used by `epa-search-keys', for looking up public keys." :type '(choice :tag "Keyserver" (repeat :tag "Random pool" (string :tag "Keyserver address")) @@ -182,7 +182,7 @@ If EXACT is non-nil, don't accept approximate matches." "Prepare KEYS for `tabulated-list-mode', for buffer BUF. KEYS is a list of `epa-ks-key' structures, as parsed by -`epa-ks-parse-result'." +`epa-ks--parse-buffer'." (when (buffer-live-p buf) (let (entries) (dolist (key keys) diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 842f27a4920..a94fb276b83 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -198,7 +198,7 @@ The basic syntax is: [a-b] [a-b] matches a character or range [^a] [^a] excludes a character or range -If any characters in PATTERN have the text property `eshell-escaped' +If any characters in PATTERN have the text property `escaped' set to true, then these characters will match themselves in the resulting regular expression." (let ((matched-in-pattern 0) ; How much of PATTERN handled diff --git a/lisp/frame.el b/lisp/frame.el index a6b0f17189f..96914cd2b25 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1776,7 +1776,7 @@ of frames like calls to map a frame or change its visibility." (insert (format ", DS=%sx%s" (nth 0 item) (nth 1 item)))) (insert "\n")) ((and (eq (nth 0 item) frame) (= (nth 1 item) 5)) - ;; Length 5 is an `adjust-frame-size' item. + ;; Length 5 is an 'adjust_frame_size' item. (insert (format "%s (%s)" (nth 3 item) (nth 2 item))) (setq item (nth 0 (cdr entry))) (unless (and (= (nth 0 item) (nth 2 item)) diff --git a/lisp/hexl.el b/lisp/hexl.el index 7f965486eae..b8d25bfb1f0 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -687,7 +687,7 @@ If there is no byte at the target address move to the last byte in that line." (defun hexl-beginning-of-buffer (arg) "Move to the beginning of the hexl buffer. -Leaves `hexl-mark' at previous position. +Leaves mark at previous position. With prefix arg N, puts point N bytes of the way from the true beginning." (interactive "p") (push-mark) diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 10e2512e9d9..b245d9df16d 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -118,7 +118,6 @@ ;; ;; Other interactive functions (that could be bound if desired): ;; `highlight-changes-mode' -;; `highlight-changes-toggle-visibility' ;; `highlight-changes-remove-highlight' ;; `highlight-compare-with-file' ;; `highlight-compare-buffers' diff --git a/lisp/imenu.el b/lisp/imenu.el index a87860f0065..c18b5f00a6e 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -310,7 +310,7 @@ element recalculates the buffer's index alist.") (defvar imenu--history-list nil ;; Making this buffer local caused it not to work! - "History list for `jump-to-function-in-buffer'.") + "History list for `imenu-choose-buffer-index'.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 8978a97e793..2788a93a5ad 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -755,7 +755,7 @@ VALUE must be a translation table to use on encoding. VALUE must be a function to call after some text is inserted and decoded by the coding system itself and before any functions in -`after-insert-functions' are called. This function is passed one +`after-insert-file-functions' are called. This function is passed one argument: the number of characters in the text to convert, with point at the start of the text. The function should leave point and the match data unchanged, and should return the new character diff --git a/lisp/org/ox.el b/lisp/org/ox.el index a6209ee98f6..6316c687db2 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -4605,7 +4605,7 @@ from the export back-end." ;; a given element, excluded. Note: "-n" switches reset that count. ;; ;; `org-export-unravel-code' extracts source code (along with a code -;; references alist) from an `element-block' or `src-block' type +;; references alist) from an `example-block' or `src-block' type ;; element. ;; ;; `org-export-format-code' applies a formatting function to each line diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 04e4a62c607..eaedf987c5e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3188,7 +3188,7 @@ Returns true if comment is found. In POD will not move the point." Mark as generic string if STRING, as generic comment otherwise. A single character is marked as punctuation and directly fontified. Do nothing if BEGIN and END are equal. If -`cperl-use-syntax-text-property' is nil, just fontify." +`cperl-use-syntax-table-text-property' is nil, just fontify." (if (and cperl-use-syntax-table-text-property (> end begin)) (progn diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 1e9f3e1f9bb..de98e0458b7 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1526,7 +1526,7 @@ POS can be a buffer position or a button" (flymake-show-diagnostic (if (button-type pos) (button-start pos) pos)))) (defun flymake--tabulated-entries-1 (diags project-root) - "Helper for `flymake--diagnostic-buffer-entries'. + "Helper for `flymake--diagnostics-buffer-entries'. PROJECT-ROOT indicates that each entry should be preceded by the filename of the diagnostic relative to that directory." (cl-loop diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index f6a4711e244..8eee8bd0929 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -413,7 +413,7 @@ overlays created." ;; hidden with `hide-ifdef-lines' equals to nil while another part with 't, ;; this case happens. ;; TODO: Should we merge? or just create a container overlay? -- this can - ;; prevent `hideif-show-ifdef' expanding too many hidden contents since there + ;; prevent `show-ifdefs' expanding too many hidden contents since there ;; is only a big overlay exists there without any smaller overlays. (save-restriction (widen) ; Otherwise `point-min' and `point-max' will be restricted and thus @@ -733,7 +733,7 @@ Assuming we've just regexp-matched with `hif-decfloat-regexp' and it matched. if REMATCH is t, do a rematch." ;; In elisp `(string-to-number "01.e2")' will return 1 instead of the expected ;; 100.0; therefore we need to write our own. - ;; This function relies on the regexp groups of `hif-dexfloat-regexp' + ;; This function relies on the regexp groups of `hif-hexfloat-regexp' (if (or fix exp) (setq fix (hif-delete-char-in-string ?' fix) exp (hif-delete-char-in-string ?' exp)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f7f1784b172..d73c1d4b239 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2909,8 +2909,8 @@ interpreter is run. Variables `python-shell-font-lock-enable', `python-shell-completion-setup-code', `python-shell-completion-string-code', -`python-eldoc-setup-code', `python-eldoc-string-code', -`python-ffap-setup-code' and `python-ffap-string-code' can +`python-eldoc-setup-code', +`python-ffap-setup-code' can customize this mode for different Python interpreters. This mode resets `comint-output-filter-functions' locally, so you diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index d9085323d9a..c59536e85a1 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -169,7 +169,7 @@ This information is useful, but it takes screen space away from file names." (defun tar-swap-data () "Swap buffer contents between current buffer and `tar-data-buffer'. -Preserve the modified states of the buffers and set `buffer-swapped-with'." +Preserve the modified states of the buffers and set `tar-data-swapped'." (let ((data-buffer-modified-p (buffer-modified-p tar-data-buffer)) (current-buffer-modified-p (buffer-modified-p))) (buffer-swap-text tar-data-buffer) diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 8b55a78f84d..ab67f450a43 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -812,7 +812,7 @@ if it were to exist." (defun add-log-find-changelog-buffer (changelog-file-name) "Find a ChangeLog buffer for CHANGELOG-FILE-NAME. -Respect `add-log-use-pseudo-changelog', which see." +Respect `add-log--pseudo-changelog-buffer-name', which see." (if (or (file-exists-p changelog-file-name) (not add-log-dont-create-changelog-file)) (find-file-noselect changelog-file-name) diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 1263767476e..efa42429b37 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -909,7 +909,7 @@ baz\"\"" (should (equal (buffer-string) "int main () {\n \n}")))) (ert-deftest electric-layout-control-reindentation () - "Same as `emacs-lisp-int-main-kernel-style', but checking + "Same as `electric-layout-int-main-kernel-style', but checking Bug#35254." (ert-with-test-buffer () (plainer-c-mode) -- cgit v1.2.3 From e5de29aa47e96f675b7f4ef3a7f84bd30d68ea0f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 20 Sep 2022 11:46:18 +0200 Subject: Obsolete unused variable in debug.el * lisp/emacs-lisp/debug.el (debugger-previous-backtrace): Make unused variable obsolete. --- lisp/emacs-lisp/debug.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 460057b3afd..f78d44cf98e 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -110,10 +110,6 @@ The value used here is passed to `quit-restore-window'." (defvar debugger-previous-window-height nil "The last recorded height of `debugger-previous-window'.") -(defvar debugger-previous-backtrace nil - "The contents of the previous backtrace (including text properties). -This is to optimize `debugger-make-xrefs'.") - (defvar debugger-outer-match-data) (defvar debugger-will-be-back nil "Non-nil if we expect to get back in the debugger soon.") @@ -836,6 +832,10 @@ To specify a nil argument interactively, exit with an empty minibuffer." ;;;###autoload (defalias 'cancel-debug-watch #'cancel-debug-on-variable-change) +(make-obsolete-variable 'debugger-previous-backtrace + "no longer used." "29.1") +(defvar debugger-previous-backtrace nil) + (provide 'debug) ;;; debug.el ends here -- cgit v1.2.3 From a498e5f8301eeb3bf7b15136469449ab4c93b99a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 20 Sep 2022 13:33:07 +0200 Subject: Get fewer false positives for :keyword and &options * lisp/emacs-lisp/lisp-mode.el (lisp-mode--search-key): New function to check more carefully for start of :keywords and &options (bug#51574). (lisp-fdefs): Use it. --- lisp/emacs-lisp/lisp-mode.el | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c906ee6e31d..7e39a77aed5 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -325,6 +325,20 @@ This will generate compile-time constants from BINDINGS." (throw 'matched t))) (throw 'matched nil))))) +(defun lisp-mode--search-key (char bound) + (catch 'found + (while (re-search-forward + (concat "\\_<" char (rx lisp-mode-symbol) "\\_>") + bound t) + (when (or (< (match-beginning 0) (+ (point-min) 2)) + ;; A quoted white space before the &/: means that this + ;; is not the start of a :keyword or an &option. + (not (eql (char-after (- (match-beginning 0) 2)) + ?\\)) + (not (memq (char-after (- (match-beginning 0) 1)) + '(?\s ?\n ?\t)))) + (throw 'found t))))) + (let-when-compile ((lisp-fdefs '("defmacro" "defun")) (lisp-vdefs '("defvar")) @@ -496,11 +510,11 @@ This will generate compile-time constants from BINDINGS." (,(rx "\\\\=") (0 font-lock-builtin-face prepend)) ;; Constant values. - (,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>") + (,(lambda (bound) (lisp-mode--search-key ":" bound)) (0 font-lock-builtin-face)) ;; ELisp and CLisp `&' keywords as types. - (,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>") - . font-lock-type-face) + (,(lambda (bound) (lisp-mode--search-key "&" bound)) + (0 font-lock-builtin-face)) ;; ELisp regexp grouping constructs (,(lambda (bound) (catch 'found @@ -549,11 +563,12 @@ This will generate compile-time constants from BINDINGS." ;; must come before keywords below to have effect (,(concat "#:" (rx lisp-mode-symbol) "") 0 font-lock-builtin-face) ;; Constant values. - (,(concat "\\_<:" (rx lisp-mode-symbol) "\\_>") + (,(lambda (bound) (lisp-mode--search-key ":" bound)) (0 font-lock-builtin-face)) ;; ELisp and CLisp `&' keywords as types. - (,(concat "\\_<&" (rx lisp-mode-symbol) "\\_>") - . font-lock-type-face) + (,(lambda (bound) (lisp-mode--search-key "&" bound)) + (0 font-lock-builtin-face)) + ;; ELisp regexp grouping constructs ;; This is too general -- rms. ;; A user complained that he has functions whose names start with `do' ;; and that they get the wrong color. -- cgit v1.2.3 From 5f6e1c059c601a1be1981347b29604eda2e2f385 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 21 Sep 2022 17:18:40 +0300 Subject: ; * lisp/emacs-lisp/gv.el (gv-synthetic-place): Doc fix. --- lisp/emacs-lisp/gv.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index d4aed3ac391..ade8064114d 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -540,8 +540,10 @@ The return value is the last VAL in the list. "Special place described by its setter and getter. GETTER and SETTER (typically obtained via `gv-letplace') get and set that place. I.e. this function allows you to do the -\"reverse\" of what `gv-letplace' does. This function only makes -sense when used in a place." +\"reverse\" of what `gv-letplace' does. + +This function is only useful when used in conjunction with +generalized variables in place forms." (declare (gv-expander funcall) (compiler-macro (lambda (_) getter))) (ignore setter) getter) -- cgit v1.2.3 From e4964de952a8246307faaf9875d2c278f42c53fc Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 22 Sep 2022 14:15:56 +0200 Subject: Don't rewrite `set` to `setq` of lexical variables Only perform the rewrite (set 'VAR X) -> (setq VAR X) for dynamic variables, as `set` isn't supposed to affect lexical vars (and never does so when interpreted). * lisp/emacs-lisp/byte-opt.el (byte-optimize-set): * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--xx): New. (bytecomp-tests--test-cases): Add test cases. * test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el: Remove obsolete test. --- lisp/emacs-lisp/byte-opt.el | 19 ++++++++++--------- .../warn-variable-set-nonvariable.el | 3 --- test/lisp/emacs-lisp/bytecomp-tests.el | 15 ++++++++++++--- 3 files changed, 22 insertions(+), 15 deletions(-) delete mode 100644 test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0d5f8c26eb2..4ef9cb0a1e4 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1531,15 +1531,16 @@ See Info node `(elisp) Integer Basics'." (put 'set 'byte-optimizer #'byte-optimize-set) (defun byte-optimize-set (form) - (let ((var (car-safe (cdr-safe form)))) - (cond - ((and (eq (car-safe var) 'quote) (consp (cdr var))) - `(setq ,(cadr var) ,@(cddr form))) - ((and (eq (car-safe var) 'make-local-variable) - (eq (car-safe (setq var (car-safe (cdr var)))) 'quote) - (consp (cdr var))) - `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form)))) - (t form)))) + (pcase (cdr form) + ;; Make sure we only turn `set' into `setq' for dynamic variables. + (`((quote ,(and var (guard (and (symbolp var) + (not (macroexp--const-symbol-p var)) + (not (assq var byte-optimize--lexvars)))))) + ,newval) + `(setq ,var ,newval)) + (`(,(and ml `(make-local-variable ,(and v `(quote ,_)))) ,newval) + `(progn ,ml (,(car form) ,v ,newval))) + (_ form))) ;; enumerating those functions which need not be called if the returned ;; value is not used. That is, something like diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el deleted file mode 100644 index 0c76c4d388b..00000000000 --- a/test/lisp/emacs-lisp/bytecomp-resources/warn-variable-set-nonvariable.el +++ /dev/null @@ -1,3 +0,0 @@ -;;; -*- lexical-binding: t -*- -(defun foo () - (set '(a) nil)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 1ca44dc7a48..e7c308213e4 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -59,6 +59,8 @@ inner loops respectively." (setq i (1- i))) res)) +(defvar bytecomp-tests--xx nil) + (defconst bytecomp-tests--test-cases '( ;; some functional tests @@ -692,6 +694,16 @@ inner loops respectively." (f (lambda () (let ((y x)) (list y 3 y))))) (funcall f)) + + ;; Test rewriting of `set' to `setq' (only done on dynamic variables). + (let ((xx 1)) (set 'xx 2) xx) + (let ((bytecomp-tests--xx 1)) + (set 'bytecomp-tests--xx 2) + bytecomp-tests--xx) + (let ((aaa 1)) (set (make-local-variable 'aaa) 2) aaa) + (let ((bytecomp-tests--xx 1)) + (set (make-local-variable 'bytecomp-tests--xx) 2) + bytecomp-tests--xx) ) "List of expressions for cross-testing interpreted and compiled code.") @@ -953,9 +965,6 @@ byte-compiled. Run with dynamic binding." (bytecomp--define-warning-file-test "warn-variable-set-constant.el" "attempt to set constant") -(bytecomp--define-warning-file-test "warn-variable-set-nonvariable.el" - "variable reference to nonvariable") - (bytecomp--define-warning-file-test "warn-variable-setq-nonvariable.el" "attempt to set non-variable") -- cgit v1.2.3 From 212e94c3f445ebe1388f6fab134133ebad9316d0 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 23 Sep 2022 17:58:41 +0200 Subject: Make loaddefs-gen register parent :groups from defcustom * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Also register parent :groups from `defgroup' entries (bug#58015). --- lisp/emacs-lisp/loaddefs-gen.el | 8 ++++++-- 1 file changed, 6 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 5819a26eb54..095d6b14e63 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -287,10 +287,14 @@ expression, in which case we want to handle forms differently." ;; In Emacs this is normally handled separately by cus-dep.el, but for ;; third party packages, it can be convenient to explicitly autoload ;; a group. - (let ((groupname (nth 1 form))) + (let ((groupname (nth 1 form)) + (parent (eval (plist-get form :group) t))) `(let ((loads (get ',groupname 'custom-loads))) (if (member ',file loads) nil - (put ',groupname 'custom-loads (cons ',file loads)))))) + (put ',groupname 'custom-loads (cons ',file loads)) + ,@(when parent + `((put ',parent 'custom-loads + (cons ',groupname (get ',parent 'custom-loads))))))))) ;; When processing a macro expansion, any expression ;; before a :autoload-end should be included. These are typically (put -- cgit v1.2.3 From c244d4af57deb96ce399c70c2781c54e14e1f0bd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Sep 2022 16:36:16 -0400 Subject: cconv.el: Fix interactive closure bug#51695 Make cconv.el detect when a closure's interactive form needs to capture variables from the context and tweak the code accordingly if so. * lisp/emacs-lisp/cconv.el (cconv--interactive-form-funs): New var. (cconv-convert): Handle the case where the interactive form captures vars from the surrounding context. Remove left over handling of `declare` which was already removed from the cconv-analyze` phase. (cconv-analyze-form): Adjust analysis of interactive forms accordingly. * lisp/emacs-lisp/oclosure.el (cconv--interactive-helper): New type and function. * lisp/simple.el (function-documentation, oclosure-interactive-form): Add methods for it. * test/lisp/emacs-lisp/cconv-tests.el (cconv-tests-interactive-closure-bug51695): New test. --- lisp/emacs-lisp/cconv.el | 51 ++++++++++++++++++++++++++----------- lisp/emacs-lisp/oclosure.el | 15 +++++++++++ lisp/simple.el | 6 +++++ test/lisp/emacs-lisp/cconv-tests.el | 10 ++++++++ 4 files changed, 67 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 7f95fa94fa1..23d0f121948 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -137,6 +137,11 @@ is less than this number.") ;; Alist associating to each function body the list of its free variables. ) +(defvar cconv--interactive-form-funs + ;; Table used to hold the functions we create internally for + ;; interactive forms. + (make-hash-table :test #'eq :weakness 'key)) + ;;;###autoload (defun cconv-closure-convert (form) "Main entry point for closure conversion. @@ -503,9 +508,23 @@ places where they originally did not directly appear." cond-forms))) (`(function (lambda ,args . ,body) . ,_) - (let ((docstring (if (eq :documentation (car-safe (car body))) - (cconv-convert (cadr (pop body)) env extend)))) - (cconv--convert-function args body env form docstring))) + (let* ((docstring (if (eq :documentation (car-safe (car body))) + (cconv-convert (cadr (pop body)) env extend))) + (bf (if (stringp (car body)) (cdr body) body)) + (if (when (eq 'interactive (car-safe (car bf))) + (gethash form cconv--interactive-form-funs))) + (cif (when if (cconv-convert if env extend))) + (_ (pcase cif + (`#'(lambda () ,form) (setf (cadr (car bf)) form) (setq cif nil)) + ('nil nil) + ;; The interactive form needs special treatment, so the form + ;; inside the `interactive' won't be used any further. + (_ (setf (cadr (car bf)) nil)))) + (cf (cconv--convert-function args body env form docstring))) + (if (not cif) + ;; Normal case, the interactive form needs no special treatment. + cf + `(cconv--interactive-helper ,cf ,cif)))) (`(internal-make-closure . ,_) (byte-compile-report-error @@ -589,12 +608,12 @@ places where they originally did not directly appear." (cconv-convert arg env extend)) (cons fun args))))))) - (`(interactive . ,forms) - `(,(car form) . ,(mapcar (lambda (form) - (cconv-convert form nil nil)) - forms))) + ;; The form (if any) is converted beforehand as part of the `lambda' case. + (`(interactive . ,_) form) - (`(declare . ,_) form) ;The args don't contain code. + ;; `declare' should now be macro-expanded away (and if they're not, we're + ;; in trouble because they *can* contain code nowadays). + ;; (`(declare . ,_) form) ;The args don't contain code. (`(oclosure--fix-type (ignore . ,vars) ,exp) (dolist (var vars) @@ -739,6 +758,13 @@ This function does not return anything but instead fills the (`(function (lambda ,vrs . ,body-forms)) (when (eq :documentation (car-safe (car body-forms))) (cconv-analyze-form (cadr (pop body-forms)) env)) + (let ((bf (if (stringp (car body-forms)) (cdr body-forms) body-forms))) + (when (eq 'interactive (car-safe (car bf))) + (let ((if (cadr (car bf)))) + (unless (macroexp-const-p if) ;Optimize this common case. + (let ((f `#'(lambda () ,if))) + (setf (gethash form cconv--interactive-form-funs) f) + (cconv-analyze-form f env)))))) (cconv--analyze-function vrs body-forms env form)) (`(setq ,var ,expr) @@ -803,13 +829,8 @@ This function does not return anything but instead fills the (cconv-analyze-form fun env))) (dolist (form args) (cconv-analyze-form form env))) - (`(interactive . ,forms) - ;; These appear within the function body but they don't have access - ;; to the function's arguments. - ;; We could extend this to allow interactive specs to refer to - ;; variables in the function's enclosing environment, but it doesn't - ;; seem worth the trouble. - (dolist (form forms) (cconv-analyze-form form nil))) + ;; The form (if any) is converted beforehand as part of the `lambda' case. + (`(interactive . ,_) nil) ;; `declare' should now be macro-expanded away (and if they're not, we're ;; in trouble because they *can* contain code nowadays). diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 9775e8cc656..c77ac151d77 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -557,6 +557,21 @@ This has 2 uses: (oclosure-define (save-some-buffers-function (:predicate save-some-buffers-function--p))) +;; This OClosure type is used internally by `cconv.el' to handle +;; the case where we need to build a closure whose `interactive' spec +;; captures variables from the context. +;; It arguably belongs with `cconv.el' but is needed at runtime, +;; so we placed it here. +(oclosure-define (cconv--interactive-helper) fun if) +(defun cconv--interactive-helper (fun if) + "Add interactive \"form\" IF to FUN. +Returns a new command that otherwise behaves like FUN. +IF should actually not be a form but a function of no arguments." + (oclosure-lambda (cconv--interactive-helper (fun fun) (if if)) + (&rest args) + (apply (if (called-interactively-p 'any) + #'funcall-interactively #'funcall) + fun args))) (provide 'oclosure) ;;; oclosure.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index aed1547b15b..10a610e0c64 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2653,6 +2653,9 @@ function as needed." (cl-defmethod function-documentation ((function accessor)) (oclosure--accessor-docstring function)) ;; FIXME: η-reduce! +(cl-defmethod function-documentation ((f cconv--interactive-helper)) + (function-documentation (cconv--interactive-helper--fun f))) + ;; This should be in `oclosure.el' but that file is loaded before `cl-generic'. (cl-defgeneric oclosure-interactive-form (_function) "Return the interactive form of FUNCTION or nil if none. @@ -2664,6 +2667,9 @@ instead." ;; (interactive-form function) nil) +(cl-defmethod oclosure-interactive-form ((f cconv--interactive-helper)) + `(interactive (funcall ',(cconv--interactive-helper--if f)))) + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index 9904c6a969c..37470f863f3 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el @@ -347,5 +347,15 @@ (list x (funcall g closed-x) (funcall h closed-x)))))))) ) +(ert-deftest cconv-tests-interactive-closure-bug51695 () + (let ((f (let ((d 51695)) + (lambda (data) + (interactive (progn (setq d (1+ d)) (list d))) + (list (called-interactively-p 'any) data))))) + (should (equal (list (call-interactively f) + (funcall f 51695) + (call-interactively f)) + '((t 51696) (nil 51695) (t 51697)))))) + (provide 'cconv-tests) ;;; cconv-tests.el ends here -- cgit v1.2.3 From 40bc027bf44e540fdf702bb56f139a7d95ee55c0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Sep 2022 17:42:55 -0400 Subject: * lisp/emacs-lisp/eieio.el (defclass): Fix bug#51068 Accept (defclass (.. ..)) without having to wrap the slot name within parentheses. --- lisp/emacs-lisp/eieio.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 984166b593a..a6c900a3355 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -136,6 +136,7 @@ and reference them using the function `class-option'." (accessors ())) ;; Collect the accessors we need to define. + (setq slots (mapcar (lambda (x) (if (consp x) x (list x))) slots)) (pcase-dolist (`(,sname . ,soptions) slots) (let* ((acces (plist-get soptions :accessor)) (initarg (plist-get soptions :initarg)) -- cgit v1.2.3 From 8a224e5124f4a64054d570054a37d2e56d3fe500 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 24 Sep 2022 02:15:53 +0200 Subject: * lisp/emacs-lisp/shortdoc.el (file-name): Improve examples. --- lisp/emacs-lisp/shortdoc.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 2472479bad6..fe4f2ae3acf 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -357,11 +357,9 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eg-result "~some-user") (file-parent-directory :eval (file-parent-directory "/foo/bar") - :eval (file-parent-directory "~") - :eval (file-parent-directory "/tmp/") + :eval (file-parent-directory "/foo/") :eval (file-parent-directory "foo/bar") - :eval (file-parent-directory "foo") - :eval (file-parent-directory "/")) + :eval (file-parent-directory "foo")) "Quoted File Names" (file-name-quote :args (name) -- cgit v1.2.3 From bbd7059da4555586ecedd091cf8a223086bd6201 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 24 Sep 2022 12:44:44 +0200 Subject: Rename file-name-directory * lisp/emacs-lisp/shortdoc.el (file-name): * doc/lispref/files.texi (Directory Names): Adjust. * lisp/files.el (file-name-parent-directory): Rename from `file-name-directory' (bug#58039). --- doc/lispref/files.texi | 2 +- etc/NEWS | 2 +- lisp/emacs-lisp/shortdoc.el | 10 +++++----- lisp/files.el | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 986fb22c75b..e1aa2de523c 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2445,7 +2445,7 @@ You can use this function for directory names and for file names, because it recognizes abbreviations even as part of the name. @end defun -@defun file-parent-directory filename +@defun file-name-parent-directory filename This function returns the directory name of the parent directory of @var{filename}. If @var{filename} is at the root directory of the filesystem, it returns @code{nil}. A relative @var{filename} is diff --git a/etc/NEWS b/etc/NEWS index 0d69e87907e..ff97c2350f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -482,7 +482,7 @@ user option 'global-text-scale-adjust-resizes-frames' controls whether the frames are resized when the font size is changed. +++ -** New function 'file-parent-directory'. +** New function 'file-name-parent-directory'. Get the parent directory of a file. ** New config variable 'syntax-wholeline-max' to reduce the cost of long lines. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index fe4f2ae3acf..d07d1019b4d 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -355,11 +355,11 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (abbreviate-file-name :no-eval (abbreviate-file-name "/home/some-user") :eg-result "~some-user") - (file-parent-directory - :eval (file-parent-directory "/foo/bar") - :eval (file-parent-directory "/foo/") - :eval (file-parent-directory "foo/bar") - :eval (file-parent-directory "foo")) + (file-name-parent-directory + :eval (file-name-parent-directory "/foo/bar") + :eval (file-name-parent-directory "/foo/") + :eval (file-name-parent-directory "foo/bar") + :eval (file-name-parent-directory "foo")) "Quoted File Names" (file-name-quote :args (name) diff --git a/lisp/files.el b/lisp/files.el index 7fde8720fa7..1e1ec6127de 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5173,7 +5173,7 @@ On most systems, this will be true: (setq filename nil)))) components)) -(defun file-parent-directory (filename) +(defun file-name-parent-directory (filename) "Return the directory name of the parent directory of FILENAME. If FILENAME is at the root of the filesystem, return nil. If FILENAME is relative, it is interpreted to be relative -- cgit v1.2.3 From 06de788529bb385462bc2539443d775328f82341 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 24 Sep 2022 14:06:26 +0200 Subject: Tweak how :override advice is formatted in *Help* * lisp/emacs-lisp/nadvice.el (advice--make-single-doc): Format :overrides specially (bug#57974). (advice--make-docstring): Put overrides at the front. --- lisp/emacs-lisp/nadvice.el | 40 ++++++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 12 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index a9a20ab5abf..db33474c605 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -108,19 +108,26 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (format "%s\n%s" name doc) (format "%s" name)) (or doc "No documentation"))))) - "\n"))) + "\n" + (and + (eq how :override) + (concat + (format-message + "\nThis is an :override advice, which means that `%s' isn't\n" function) + "run at all, and the documentation below may be irrelevant.\n"))))) (defun advice--make-docstring (function) "Build the raw docstring for FUNCTION, presumably advised." (let* ((flist (indirect-function function)) (docfun nil) (macrop (eq 'macro (car-safe flist))) - (docstring nil)) + (before nil) + (after nil)) (when macrop (setq flist (cdr flist))) (if (and (autoloadp flist) (get function 'advice--pending)) - (setq docstring + (setq after (advice--make-single-doc (get function 'advice--pending) function macrop)) (while (advice--p flist) @@ -130,9 +137,13 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") ;; object instead! So here we try to undo the damage. (when (integerp (aref flist 4)) (setq docfun flist)) - (setq docstring (concat docstring (advice--make-single-doc - flist function macrop)) - flist (advice--cdr flist)))) + (let ((doc-bit (advice--make-single-doc flist function macrop))) + ;; We want :overrides to go to the front, because they mean + ;; that the doc string may be irrelevant. + (if (eq (advice--how flist) :override) + (setq before (concat before doc-bit)) + (setq after (concat after doc-bit)))) + (setq flist (advice--cdr flist)))) (unless docfun (setq docfun flist)) (let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops. @@ -145,12 +156,17 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (if (stringp arglist) t (help--make-usage-docstring function arglist))) (setq origdoc (cdr usage)) (car usage))) - (help-add-fundoc-usage (concat origdoc - (if (string-suffix-p "\n" origdoc) - "\n" - "\n\n") - docstring) - usage)))) + (help-add-fundoc-usage + (with-temp-buffer + (when before + (insert before) + (ensure-empty-lines 1)) + (insert origdoc) + (when after + (ensure-empty-lines 1) + (insert after)) + (buffer-string)) + usage)))) (defun advice-eval-interactive-spec (spec) "Evaluate the interactive spec SPEC." -- cgit v1.2.3 From b7fb82bc41b807545a369c5ee61de5a557927c7f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 24 Sep 2022 16:46:22 +0200 Subject: Remove "manual" package--builtin-versions updates * lisp/emacs-lisp/nadvice.el: * lisp/emacs-lisp/cl-generic.el: Don't push to package--builtin-versions "manually", because loaddefs-gen does this correctly now. --- lisp/emacs-lisp/cl-generic.el | 5 ----- lisp/emacs-lisp/nadvice.el | 6 +----- 2 files changed, 1 insertion(+), 10 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 3fd85bcb880..b3ade3b8943 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -94,11 +94,6 @@ ;; This second one is closely related to what we do here (and that's ;; the name "generalizer" comes from). -;; The autoloads.el mechanism which adds package--builtin-versions -;; maintenance to loaddefs.el doesn't work for preloaded packages (such -;; as this one), so we have to do it by hand! -(push (purecopy '(cl-generic 1 0)) package--builtin-versions) - ;; Note: For generic functions that dispatch on several arguments (i.e. those ;; which use the multiple-dispatch feature), we always use the same "tagcodes" ;; and the same set of arguments on which to dispatch. This works, but is diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index db33474c605..b4acd423b8d 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -4,6 +4,7 @@ ;; Author: Stefan Monnier ;; Keywords: extensions, lisp, tools +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -37,11 +38,6 @@ ;;; Code: -;; The autoloads.el mechanism which adds package--builtin-versions -;; maintenance to loaddefs.el doesn't work for preloaded packages (such -;; as this one), so we have to do it by hand! -(push (purecopy '(nadvice 1 0)) package--builtin-versions) - (oclosure-define (advice (:predicate advice--p) (:copier advice--cons (cdr)) -- cgit v1.2.3 From 8574ae625e3144d92bb59a0107a4404cc3d0ab86 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 24 Sep 2022 20:17:28 +0300 Subject: * lisp/emacs-lisp/icons.el (icons--create): Use default rotation 0 (bug#57813) --- lisp/emacs-lisp/icons.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index ccc36577932..a08ac7463ce 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -203,7 +203,7 @@ present if the icon is represented by an image." (window-default-line-height) height) :scale 1 - :rotation (plist-get keywords :rotation) + :rotation (or (plist-get keywords :rotation) 0) :ascent (if (plist-member keywords :ascent) (plist-get keywords :ascent) 'center)) -- cgit v1.2.3 From 3af2f9cce312a2e9fff1bfc5f7689c5b9db369bd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 25 Sep 2022 13:22:17 +0200 Subject: Bind "N"/"P" to next/prev section in shortdoc * lisp/emacs-lisp/shortdoc.el (shortdoc-mode-map): Bind "N" and "P" to 'shortdoc-next-section' and 'shortdoc-previous-section'. --- etc/NEWS | 6 ++++++ lisp/emacs-lisp/shortdoc.el | 2 ++ 2 files changed, 8 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 835fcf8bcaf..139e65a4f19 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1712,6 +1712,12 @@ This fills the region to be no wider than a specified pixel width. This will take you to the gnu.org web server's version of the current info node. This command only works for the Emacs and Emacs Lisp manuals. +** Shortdoc + +--- +*** 'N' and 'P' are now bound to 'shortdoc-(next|previous)-section'. +This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. + ** VC --- diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index d07d1019b4d..13d99adcf08 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1512,6 +1512,8 @@ Example: :doc "Keymap for `shortdoc-mode'." "n" #'shortdoc-next "p" #'shortdoc-previous + "N" #'shortdoc-next-section + "P" #'shortdoc-previous-section "C-c C-n" #'shortdoc-next-section "C-c C-p" #'shortdoc-previous-section) -- cgit v1.2.3 From e5896907813a9540d0a6b3e60f682afd273fc8e9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 25 Sep 2022 13:48:12 +0200 Subject: Add new command 'shortdoc-copy-function-as-kill' * lisp/emacs-lisp/shortdoc.el (shortdoc-copy-function-as-kill): New command. (shortdoc-mode-map): Bind above new command to "w". --- etc/NEWS | 4 ++++ lisp/emacs-lisp/shortdoc.el | 17 ++++++++++++++++- 2 files changed, 20 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 139e65a4f19..0a5b7bc29c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1714,6 +1714,10 @@ info node. This command only works for the Emacs and Emacs Lisp manuals. ** Shortdoc +--- +*** New command 'shortdoc-copy-function-as-kill' bound to 'w'. +It copies the name of the function near point into the kill ring. + --- *** 'N' and 'P' are now bound to 'shortdoc-(next|previous)-section'. This is in addition to the old keybindings 'C-c C-n' and 'C-c C-p'. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 13d99adcf08..33106808d28 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1515,7 +1515,8 @@ Example: "N" #'shortdoc-next-section "P" #'shortdoc-previous-section "C-c C-n" #'shortdoc-next-section - "C-c C-p" #'shortdoc-previous-section) + "C-c C-p" #'shortdoc-previous-section + "w" #'shortdoc-copy-function-as-kill) (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc." @@ -1557,6 +1558,20 @@ With ARG, do it that many times." (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) +(defun shortdoc-copy-function-as-kill () + "Copy name of the function near point into the kill ring." + (interactive) + (save-excursion + (goto-char (pos-bol)) + (when-let* ((re (rx bol "(" (group (+ (not (in " ")))))) + (string + (and (or (looking-at re) + (re-search-backward re nil t)) + (match-string 1)))) + (set-text-properties 0 (length string) nil string) + (kill-new string) + (message string)))) + (provide 'shortdoc) ;;; shortdoc.el ends here -- cgit v1.2.3 From 971566e88a9fdb414b3c821cb55a7fc0e903eeba Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 25 Sep 2022 13:54:37 +0200 Subject: Fix shortdoc movement commands * lisp/emacs-lisp/shortdoc.el (shortdoc--goto-section): Don't skip over current function or section when searching. --- lisp/emacs-lisp/shortdoc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 33106808d28..b5c99cf2c9a 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1529,7 +1529,7 @@ Example: (funcall (if reverse 'text-property-search-backward 'text-property-search-forward) - sym nil t t) + sym nil t) (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) -- cgit v1.2.3 From 489bca19b7a55ba00dbc1d917cd8832268cebcee Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 25 Sep 2022 14:26:40 +0200 Subject: Improve shortdoc documentation * doc/emacs/help.texi (Name Help): * doc/lispref/help.texi (Documentation Groups): Refer to 'shortdoc' convenience alias instead of 'shortdoc-display-group'. * lisp/emacs-lisp/shortdoc.el: Add Commentary. (shortdoc-next, shortdoc-previous) (shortdoc-next-section, shortdoc-previous-section): Doc fixes. --- doc/emacs/help.texi | 9 ++++----- doc/lispref/help.texi | 2 +- lisp/emacs-lisp/shortdoc.el | 25 +++++++++++++++++-------- 3 files changed, 22 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 84b082825c2..6d9c028b742 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -311,12 +311,11 @@ doc string to display. In that case, if to load the file in which the function is defined to see whether there's a doc string there. -@findex shortdoc-display-group +@findex shortdoc You can get an overview of functions relevant for a particular topic -by using the @kbd{M-x shortdoc-display-group} command. This will -prompt you for an area of interest, e.g., @code{string}, and pop you -to a buffer where many of the functions relevant for handling strings -are listed. +by using the @kbd{M-x shortdoc} command. This will prompt you for an +area of interest, e.g., @code{string}, and pop you to a buffer where +many of the functions relevant for handling strings are listed. @kindex C-h v @findex describe-variable diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 154a7abeb63..65ad5f05542 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -827,7 +827,7 @@ if the user types the help character again. Emacs can list functions based on various groupings. For instance, @code{string-trim} and @code{mapconcat} are ``string'' functions, so -@kbd{M-x shortdoc-display-group RET string RET} will give an overview +@kbd{M-x shortdoc RET string RET} will give an overview of functions that operate on strings. The documentation groups are created with the diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index b5c99cf2c9a..6d61ed4ac16 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -22,6 +22,15 @@ ;;; Commentary: +;; This package lists functions based on various groupings. +;; +;; For instance, `string-trim' and `mapconcat' are `string' functions, +;; so `M-x shortdoc RET string RET' will give an overview of functions +;; that operate on strings. +;; +;; The documentation groups are created with the +;; `define-short-documentation-group' macro. + ;;; Code: (require 'seq) @@ -1533,27 +1542,27 @@ Example: (setq arg (1- arg)))) (defun shortdoc-next (&optional arg) - "Move cursor to the next function. -With ARG, do it that many times." + "Move point to the next function. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function)) (defun shortdoc-previous (&optional arg) - "Move cursor to the previous function. -With ARG, do it that many times." + "Move point to the previous function. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function t) (backward-char 1)) (defun shortdoc-next-section (&optional arg) - "Move cursor to the next section. -With ARG, do it that many times." + "Move point to the next section. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section)) (defun shortdoc-previous-section (&optional arg) - "Move cursor to the previous section. -With ARG, do it that many times." + "Move point to the previous section. +With prefix argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) -- cgit v1.2.3 From f761869a563866d55da437d06f267979e90cf3a0 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 25 Sep 2022 16:16:30 +0200 Subject: Add :buffer argument to ert-with-temp-file * lisp/emacs-lisp/ert-x.el (ert-with-temp-file): Add new keyword argument :buffer SYMBOL to visit the file with `find-file-literally' before running the body, and cleaning up after. --- lisp/emacs-lisp/ert-x.el | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index fe291290a28..f00f1b33d78 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -451,6 +451,10 @@ The following keyword arguments are supported: :text STRING If non-nil, pass STRING to `make-temp-file' as the TEXT argument. +:buffer SYMBOL Open the temporary file using `find-file-noselect' + and bind SYMBOL to the buffer. Kill the buffer + after BODY exits normally or non-locally. + :coding CODING If non-nil, bind `coding-system-for-write' to CODING when executing BODY. This is handy when STRING includes non-ASCII characters or the temporary file must have a @@ -459,14 +463,17 @@ The following keyword arguments are supported: See also `ert-with-temp-directory'." (declare (indent 1) (debug (symbolp body))) (cl-check-type name symbol) - (let (keyw prefix suffix directory text extra-keywords coding) + (let (keyw prefix suffix directory text extra-keywords buffer coding) (while (keywordp (setq keyw (car body))) (setq body (cdr body)) (pcase keyw (:prefix (setq prefix (pop body))) (:suffix (setq suffix (pop body))) + ;; This is only for internal use by `ert-with-temp-directory' + ;; and is therefore not documented. (:directory (setq directory (pop body))) (:text (setq text (pop body))) + (:buffer (setq buffer (pop body))) (:coding (setq coding (pop body))) (_ (push keyw extra-keywords) (pop body)))) (when extra-keywords @@ -481,9 +488,16 @@ See also `ert-with-temp-directory'." (make-temp-file ,prefix ,directory ,suffix ,text))) (,name ,(if directory `(file-name-as-directory ,temp-file) - temp-file))) + temp-file)) + ,@(when buffer + (list `(,buffer (find-file-literally ,temp-file))))) (unwind-protect (progn ,@body) + (ignore-errors + ,@(when buffer + (list `(with-current-buffer buf + (set-buffer-modified-p nil)) + `(kill-buffer ,buffer)))) (ignore-errors ,(if directory `(delete-directory ,temp-file :recursive) -- cgit v1.2.3 From b55b2f1c316ba6a488cc381513a17cf3eec27a0f Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 25 Sep 2022 17:47:39 +0200 Subject: Boolean constant detection additions * lisp/emacs-lisp/byte-opt.el (byte-opt--bool-value-form): `set` is boolean identity in its second argument. (byte-compile-trueconstp): `set-marker` is always true. --- lisp/emacs-lisp/byte-opt.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4ef9cb0a1e4..ed6b7b08a49 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -737,7 +737,7 @@ for speeding up processing.") reverse nreverse sort)) (setq form (nth 1 form)) t) - ((memq head '(mapc setq setcar setcdr puthash)) + ((memq head '(mapc setq setcar setcdr puthash set)) (setq form (nth 2 form)) t) ((memq head '(aset put function-put)) @@ -793,6 +793,7 @@ for speeding up processing.") sxhash sxhash-equal sxhash-eq sxhash-eql sxhash-equal-including-properties make-marker copy-marker point-marker mark-marker + set-marker kbd key-description always)) t) -- cgit v1.2.3 From 76b7a593675c95910881b6551b94ddd23f3b1656 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 25 Sep 2022 22:49:32 +0300 Subject: ; Clarify wording of some doc strings in shortdoc.el * lisp/emacs-lisp/shortdoc.el (shortdoc-next, shortdoc-previous) (shortdoc-next-section, shortdoc-previous-section): Clarify wording. --- lisp/emacs-lisp/shortdoc.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 6d61ed4ac16..4cfd658e10d 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1543,26 +1543,26 @@ Example: (defun shortdoc-next (&optional arg) "Move point to the next function. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function)) (defun shortdoc-previous (&optional arg) "Move point to the previous function. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-function t) (backward-char 1)) (defun shortdoc-next-section (&optional arg) "Move point to the next section. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section)) (defun shortdoc-previous-section (&optional arg) "Move point to the previous section. -With prefix argument ARG, do it that many times." +With prefix numeric argument ARG, do it that many times." (interactive "p" shortdoc-mode) (shortdoc--goto-section arg 'shortdoc-section t) (forward-line -2)) -- cgit v1.2.3 From e2f2f6b9e869e8cf2714b35d5645fbbbcf2975de Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 26 Sep 2022 13:28:30 +0200 Subject: Fix percentage width computation in vtable * lisp/emacs-lisp/vtable.el (vtable--compute-width): Fix percentage computation (bug#58067). --- lisp/emacs-lisp/vtable.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 61265c97c28..9bdf90bf1d6 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -770,7 +770,8 @@ If NEXT, do the next column." ((string-match "\\([0-9.]+\\)px" spec) (string-to-number (match-string 1 spec))) ((string-match "\\([0-9.]+\\)%" spec) - (* (string-to-number (match-string 1 spec)) (window-width nil t))) + (/ (* (string-to-number (match-string 1 spec)) (window-width nil t)) + 100)) (t (error "Invalid spec: %s" spec)))) -- cgit v1.2.3 From 29b7d740006fe2190a729bd1c30ccab9356cee36 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Mon, 26 Sep 2022 17:07:52 -0400 Subject: ert-x: Improve realism of `ert-with-test-buffer-selected' * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer-selected): Set `inhibit-read-only' and `buffer-read-only' to nil when executing the body to provide a more realistic test environment. --- lisp/emacs-lisp/ert-x.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index f00f1b33d78..bfd796586da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -126,7 +126,15 @@ value is the last form in BODY." (body-function . ,(lambda (window) (select-window window t) - (let ((inhibit-modification-hooks nil)) + ;; body-function is intended to initialize the + ;; contents of a temporary read-only buffer, so + ;; it is executed with some convenience + ;; changes. Undo those changes so that the + ;; test buffer behaves more like an ordinary + ;; buffer while the body executes. + (let ((inhibit-modification-hooks nil) + (inhibit-read-only nil) + (buffer-read-only nil)) (setq ,ret (progn ,@body)))))) nil)) ,ret)))) -- cgit v1.2.3 From ec121e035bfed692634faf3a67e97de68c991ea3 Mon Sep 17 00:00:00 2001 From: Lin Sun Date: Wed, 28 Sep 2022 13:05:26 +0200 Subject: package-update would always re-install package * lisp/emacs-lisp/package.el (package--updateable-packages): fix version comparison between available packages and archived packages (bug#58129). --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 70c15d2793c..4abee9d0538 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2189,8 +2189,8 @@ to install it but still mark it as selected." (assq (car elt) package-archive-contents))) (and available (version-list-< - (package-desc-priority-version (cadr elt)) - (package-desc-priority-version (cadr available)))))) + (package-desc-version (cadr elt)) + (package-desc-version (cadr available)))))) package-alist))) ;;;###autoload -- cgit v1.2.3 From 423bdd5f7f273f40f750eac83017074501d52823 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 29 Sep 2022 15:19:01 +0200 Subject: ; Fix typos (prefer American spelling) --- doc/misc/modus-themes.org | 6 +++--- etc/themes/modus-themes.el | 2 +- lisp/comint.el | 2 +- lisp/emacs-lisp/byte-opt.el | 4 ++-- lisp/ielm.el | 2 +- lisp/progmodes/cc-fonts.el | 2 +- lisp/shell.el | 2 +- test/lisp/net/mailcap-tests.el | 2 +- 8 files changed, 11 insertions(+), 11 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 1b4bf88a0cc..fdc1dfcaba1 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -5852,7 +5852,7 @@ interface virtually unusable. [[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]]. -Again, one must exercise judgement in order to avoid discrimination, +Again, one must exercise judgment in order to avoid discrimination, where "discrimination" refers to: + The treatment of substantially different magnitudes as if they were of @@ -5868,11 +5868,11 @@ usability beyond matters of color---they would be making a not-so-obvious error of treating different cases as if they were the same. -The Modus themes prioritise "thematic consistency" over abstract harmony +The Modus themes prioritize "thematic consistency" over abstract harmony or regularity among their applicable colors. In concrete terms, we do not claim that, say, our yellows are the best complements for our blues because we generally avoid using complementary colors side-by-side, so -it is wrong to optimise for a decontextualised blue+yellow combination. +it is wrong to optimize for a decontextualised blue+yellow combination. Not to imply that our colors do not work well together because they do, just to clarify that consistency of context is what themes must strive for, and that requires widening the scope of the design beyond the diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index 6296bf90251..a6bbdfe0bb8 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -1435,7 +1435,7 @@ By default, customizing a theme-related user option through the Custom interfaces or with `customize-set-variable' will not reload the currently active Modus theme. -Enable this behaviour by setting this variable to nil." +Enable this behavior by setting this variable to nil." :group 'modus-themes :package-version '(modus-themes . "1.5.0") :version "28.1" diff --git a/lisp/comint.el b/lisp/comint.el index b2a04ea55ae..e7d2136c841 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3966,7 +3966,7 @@ an indirect buffer, whose major mode and syntax highlighting are set up according to `comint-indirect-setup-function'. After this setup is done, run this hook with the indirect buffer as the current buffer. This can be used to further customize -fontification and other behaviour of the indirect buffer." +fontification and other behavior of the indirect buffer." :group 'comint :type 'hook :version "29.1") diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ed6b7b08a49..5ef2d7fe827 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -812,7 +812,7 @@ for speeding up processing.") (defun byte-compile-nilconstp (form) "Return non-nil if FORM always evaluates to a nil value." (setq form (byte-opt--bool-value-form form)) - (or (not form) ; assume (quote nil) always being normalised to nil + (or (not form) ; assume (quote nil) always being normalized to nil (and (consp form) (let ((head (car form))) ;; FIXME: There are many other expressions that are statically nil. @@ -1184,7 +1184,7 @@ See Info node `(elisp) Integer Basics'." (if (equal new-args (cdr form)) ;; Input is unchanged: keep original form, and don't represent ;; a nil result explicitly because that would lead to infinite - ;; growth when the optimiser is iterated. + ;; growth when the optimizer is iterated. (setq nil-result nil) (setq form (cons (car form) new-args))) diff --git a/lisp/ielm.el b/lisp/ielm.el index 4a10c002976..ad41cb1f6bd 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -491,7 +491,7 @@ and syntax highlighting are set up with `emacs-lisp-mode'. In addition to `comint-indirect-setup-hook', run this hook with the indirect buffer as the current buffer after its setup is done. This can be used to further customize fontification and other -behaviour of the indirect buffer." +behavior of the indirect buffer." :type 'boolean :safe 'booleanp :version "29.1") diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 753ae480878..d2af53e837c 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1972,7 +1972,7 @@ casts and declarations are fontified. Used on level 2 and higher." (c-forward-syntactic-ws limit)))) (defun c-font-lock-c++-modules (limit) - ;; Fontify the C++20 module stanzas, characterised by the keywords `module', + ;; Fontify the C++20 module stanzas, characterized by the keywords `module', ;; `export' and `import'. Note that this has to be done by a function (as ;; opposed to regexps) due to the presence of optional C++ attributes. ;; diff --git a/lisp/shell.el b/lisp/shell.el index 87fd36a5929..18bb3722427 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -324,7 +324,7 @@ enabled, is performed in an indirect buffer, whose indentation and syntax highlighting is set up with `sh-mode'. In addition to `comint-indirect-setup-hook', run this hook with the indirect buffer as the current buffer after its setup is done. This can -be used to further customize fontification and other behaviour of +be used to further customize fontification and other behavior of the indirect buffer." :type 'boolean :group 'shell diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el index 8d047c7ff50..9e60a243b3d 100644 --- a/test/lisp/net/mailcap-tests.el +++ b/test/lisp/net/mailcap-tests.el @@ -515,7 +515,7 @@ in ‘mailcap-mime-data’." In its current implementation ‘mailcap-add-mailcap-entry’ loses extra fields of an entry already existing in ‘mailcap-mime-data’. This test does not actually verify a correct result; it merely -checks whether ‘mailcap-add-mailcap-entry’ behaviour is still the +checks whether ‘mailcap-add-mailcap-entry’ behavior is still the incorrect one. As such, it can be satisfied by any other result than the expected and known wrong one, and its success does not help to verify the correct addition and merging of an entry." -- cgit v1.2.3 From 0a40120b40356ce43c084f44cedba8566a5685be Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 2 Oct 2022 17:28:04 +0200 Subject: Fix overly wide docstrings generated by eieio * lisp/emacs-lisp/eieio-core.el (eieio-make-class-predicate) (eieio-make-child-predicate, eieio-defclass-internal): Don't generate overly wide docstrings. (Bug#58252) --- lisp/emacs-lisp/eieio-core.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 5e7b5cbfb2f..65aa6aa6df7 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -249,16 +249,22 @@ use '%s or turn off `eieio-backward-compatibility' instead" cname) (defun eieio-make-class-predicate (class) (lambda (obj) (:documentation - (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)" - class)) + (concat + (internal--format-docstring-line + "Return non-nil if OBJ is an object of type `%S'." + class) + "\n\n(fn OBJ)")) (and (eieio-object-p obj) (same-class-p obj class)))) (defun eieio-make-child-predicate (class) (lambda (obj) (:documentation - (format "Return non-nil if OBJ is an object of type `%S' or a subclass. -\n(fn OBJ)" class)) + (concat + (internal--format-docstring-line + "Return non-nil if OBJ is an object of type `%S' or a subclass." + class) + "\n\n(fn OBJ)")) (and (eieio-object-p obj) (object-of-class-p obj class)))) @@ -353,8 +359,8 @@ See `defclass' for more information." (defalias csym (lambda (obj) (:documentation - (format - "Test OBJ to see if it a list of objects which are a child of type %s" + (internal--format-docstring-line + "Test OBJ to see if it a list of objects which are a child of type `%s'." cname)) (when (listp obj) (let ((ans t)) ;; nil is valid -- cgit v1.2.3 From 655c92ce4aa9ba2d21622074f74064c86f7f2fad Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 3 Oct 2022 00:03:34 +0200 Subject: Fix more overly long docstrings in eieio * lisp/emacs-lisp/eieio.el (defclass): Fix more overly long docstrings. (Bug#58252) --- lisp/emacs-lisp/eieio.el | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index a6c900a3355..8351d97b13d 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -218,10 +218,11 @@ and reference them using the function `class-option'." (when (and eieio-backward-compatibility (eq alloc :class)) ;; FIXME: How could I declare this *method* as obsolete. (push `(cl-defmethod ,acces ((this (subclass ,name))) - ,(format - "Retrieve the class slot `%S' from a class `%S'. -This method is obsolete." - sname name) + ,(concat + (internal--format-docstring-line + "Retrieve the class slot `%S' from a class `%S'." + sname name) + "\nThis method is obsolete.") (if (slot-boundp this ',sname) (eieio-oref-default this ',sname))) accessors))) @@ -230,16 +231,18 @@ This method is obsolete." ;; name whose purpose is to set the value of the slot. (if writer (push `(cl-defmethod ,writer ((this ,name) value) - ,(format "Set the slot `%S' of an object of class `%S'." - sname name) + ,(internal--format-docstring-line + "Set the slot `%S' of an object of class `%S'." + sname name) (setf (slot-value this ',sname) value)) accessors)) ;; If a reader is defined, then create a generic method ;; of that name whose purpose is to access this slot value. (if reader (push `(cl-defmethod ,reader ((this ,name)) - ,(format "Access the slot `%S' from object of class `%S'." - sname name) + ,(internal--format-docstring-line + "Access the slot `%S' from object of class `%S'." + sname name) (slot-value this ',sname)) accessors)) )) -- cgit v1.2.3 From 5fec9182dbeffa88cef6651d8c798ef9665d6681 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 3 Oct 2022 15:26:04 +0200 Subject: Add new variable 'inhibit-native-compilation' * doc/lispref/compile.texi (Native-Compilation Variables): Document it. * lisp/startup.el (normal-top-level): Set inhibit-native-compilation from environment variable. * lisp/subr.el (native-comp-deferred-compilation): Make obsolete. * lisp/emacs-lisp/comp.el (comp-trampoline-compile): Don't write trampolines to disk. * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile-and-load): Adjust. * src/comp.c (syms_of_comp): New variable inhibit-native-compilation. (maybe_defer_native_compilation): Use it. --- doc/lispref/compile.texi | 18 ++++++++++++++++++ etc/NEWS | 15 +++++++++++---- lisp/emacs-lisp/comp.el | 36 ++++++++++++++++++++---------------- lisp/progmodes/elisp-mode.el | 2 +- lisp/startup.el | 7 +++++-- lisp/subr.el | 3 +++ src/comp.c | 8 ++++++++ 7 files changed, 66 insertions(+), 23 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 60fc11a22ed..e6e9fd1be84 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -973,6 +973,24 @@ whether native-compilation is available should use this predicate. This section documents the variables that control native-compilation. +@defvar inhibit-native-compilation +If your Emacs has support for native compilation, Emacs will (by +default) compile the Lisp files you're loading in the background, and +then install the native-compiled versions of the functions. If you +wish to disable this, you can set this variable to non-@code{nil}. If +you want to set it permanently, this should probably be done from the +early init file, since setting it in the normal init file is probably +too late. + +While setting this variable disables automatic compilation of Lisp +files, the compiler may still be invoked to install @dfn{trampolines} +if any built-in functions are redefined. However, these trampolines +will not get written to disk. + +You can also use the @samp{EMACS_INHIBIT_NATIVE_COMPILATION} +environment variable to disable native compilation. +@end defvar + @defopt native-comp-speed This variable specifies the optimization level for native compilation. Its value should be a number between @minus{}1 and 3. Values between diff --git a/etc/NEWS b/etc/NEWS index d7bc4b0e0c2..6e7836e3c09 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -170,10 +170,17 @@ time. ** Native Compilation ---- -*** New command 'native-compile-prune-cache'. -This command deletes older ".eln" cache entries (but not the ones for -the current Emacs version). ++++ +*** New variable 'inhibit-native-compilation'. +If set, Emacs will inhibit native compilation (and won't write +anything to the eln cache automatically). The variable is initialised +from the EMACS_INHIBIT_NATIVE_COMPILATION environment variable on +Emacs startup. + + +--- *** New command 'native-compile-prune-cache'. This command +deletes older ".eln" cache entries (but not the ones for the current +Emacs version). --- *** New function 'startup-redirect-eln-cache'. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index abab9107ae1..759cedddefe 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3801,22 +3801,25 @@ Return the trampoline if found or nil otherwise." (lexical-binding t)) (comp--native-compile form nil - (cl-loop - for dir in (if native-compile-target-directory - (list (expand-file-name comp-native-version-dir - native-compile-target-directory)) - (comp-eln-load-path-eff)) - for f = (expand-file-name - (comp-trampoline-filename subr-name) - dir) - unless (file-exists-p dir) - do (ignore-errors - (make-directory dir t) - (cl-return f)) - when (file-writable-p f) - do (cl-return f) - finally (error "Cannot find suitable directory for output in \ -`native-comp-eln-load-path'"))))) + ;; If we've disabled nativecomp, don't write the trampolines to + ;; the eln cache (but create them). + (and (not inhibit-native-compilation) + (cl-loop + for dir in (if native-compile-target-directory + (list (expand-file-name comp-native-version-dir + native-compile-target-directory)) + (comp-eln-load-path-eff)) + for f = (expand-file-name + (comp-trampoline-filename subr-name) + dir) + unless (file-exists-p dir) + do (ignore-errors + (make-directory dir t) + (cl-return f)) + when (file-writable-p f) + do (cl-return f) + finally (error "Cannot find suitable directory for output in \ +`native-comp-eln-load-path'")))))) ;; Some entry point support code. @@ -4107,6 +4110,7 @@ the deferred compilation mechanism." comp-ctxt (comp-ctxt-output comp-ctxt) (file-exists-p (comp-ctxt-output comp-ctxt))) + (message "Deleting %s" (comp-ctxt-output comp-ctxt)) (delete-file (comp-ctxt-output comp-ctxt))))))) (defun native-compile-async-skip-p (file load selector) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 4ada27a1aca..c12453e8837 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -220,7 +220,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." Load the compiled code when finished. Use `emacs-lisp-byte-compile-and-load' in combination with -`native-comp-deferred-compilation' set to t to achieve asynchronous +`inhibit-native-compilation' set to nil to achieve asynchronous native compilation." (interactive nil emacs-lisp-mode) (emacs-lisp--before-compile-buffer) diff --git a/lisp/startup.el b/lisp/startup.el index 50a8f491d8e..03a67cdc0e8 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -541,7 +541,7 @@ DIRS are relative." (setq comp--compilable t)) (defvar native-comp-eln-load-path) -(defvar native-comp-deferred-compilation) +(defvar inhibit-native-compilation) (defvar comp-enable-subr-trampolines) (defvar startup--original-eln-load-path nil @@ -578,6 +578,9 @@ the updated value." It sets `command-line-processed', processes the command-line, reads the initialization files, etc. It is the default value of the variable `top-level'." + ;; Allow disabling automatic .elc->.eln processing. + (setq inhibit-native-compilation (getenv "EMACS_INHIBIT_NATIVE_COMPILATION")) + (if command-line-processed (message internal--top-level-message) (setq command-line-processed t) @@ -596,7 +599,7 @@ It is the default value of the variable `top-level'." ;; in this session. This is necessary if libgccjit is not ;; available on MS-Windows, but Emacs was built with ;; native-compilation support. - (setq native-comp-deferred-compilation nil + (setq inhibit-native-compilation t comp-enable-subr-trampolines nil)) ;; Form `native-comp-eln-load-path'. diff --git a/lisp/subr.el b/lisp/subr.el index 4f8273d56fb..0c9d94db1cc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1876,6 +1876,9 @@ activations. To prevent runaway recursion, use `max-lisp-eval-depth' instead; it will indirectly limit the specpdl stack size as well.") (make-obsolete-variable 'max-specpdl-size nil "29.1") +(make-obsolete-variable 'native-comp-deferred-compilation + 'inhibit-native-compilation "29.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/comp.c b/src/comp.c index 4813ca04a90..ed64a850721 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5107,6 +5107,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, return; if (!native_comp_deferred_compilation + || !NILP (Vinhibit_native_compilation) || noninteractive || !NILP (Vpurify_flag) || !COMPILEDP (definition) @@ -5610,6 +5611,13 @@ For internal use. */); doc: /* Non-nil when comp.el can be native compiled. For internal use. */); /* Compiler control customizes. */ + DEFVAR_LISP ("inhibit-native-compilation", Vinhibit_native_compilation, + doc: /* If non-nil, inhibit automatic native compilation of loaded .elc files. + +After compilation, each function definition is updated to the native +compiled one. */); + Vinhibit_native_compilation = Qnil; + DEFVAR_BOOL ("native-comp-deferred-compilation", native_comp_deferred_compilation, doc: /* If non-nil compile loaded .elc files asynchronously. -- cgit v1.2.3 From f97993ee667f9be7589825f3a4fbc095d6944ec6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 3 Oct 2022 19:49:53 +0200 Subject: Rename to inhibit-automatic-native-compilation * src/comp.c (maybe_defer_native_compilation): (syms_of_comp): * lisp/subr.el (native-comp-deferred-compilation): * lisp/startup.el (inhibit-native-compilation): (normal-top-level): * lisp/progmodes/elisp-mode.el (emacs-lisp-native-compile-and-load): * lisp/emacs-lisp/comp.el (comp-trampoline-compile): * etc/NEWS: * doc/lispref/compile.texi (Native-Compilation Variables): Rename inhibit-native-compilation to inhibit-automatic-native-compilation. --- doc/lispref/compile.texi | 4 ++-- etc/NEWS | 6 +++--- lisp/emacs-lisp/comp.el | 2 +- lisp/progmodes/elisp-mode.el | 4 ++-- lisp/startup.el | 7 ++++--- lisp/subr.el | 2 +- src/comp.c | 7 ++++--- 7 files changed, 17 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index e6e9fd1be84..7ccee08e53a 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -973,7 +973,7 @@ whether native-compilation is available should use this predicate. This section documents the variables that control native-compilation. -@defvar inhibit-native-compilation +@defvar inhibit-automatic-native-compilation If your Emacs has support for native compilation, Emacs will (by default) compile the Lisp files you're loading in the background, and then install the native-compiled versions of the functions. If you @@ -987,7 +987,7 @@ files, the compiler may still be invoked to install @dfn{trampolines} if any built-in functions are redefined. However, these trampolines will not get written to disk. -You can also use the @samp{EMACS_INHIBIT_NATIVE_COMPILATION} +You can also use the @samp{EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION} environment variable to disable native compilation. @end defvar diff --git a/etc/NEWS b/etc/NEWS index 9e9f9b65030..dd048b9df39 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -171,11 +171,11 @@ time. ** Native Compilation +++ -*** New variable 'inhibit-native-compilation'. +*** New variable 'inhibit-automatic-native-compilation'. If set, Emacs will inhibit native compilation (and won't write anything to the eln cache automatically). The variable is initialised -from the EMACS_INHIBIT_NATIVE_COMPILATION environment variable on -Emacs startup. +from the EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION environment +variable on Emacs startup. --- *** New command 'native-compile-prune-cache'. This command diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 759cedddefe..6656b7e57c1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3803,7 +3803,7 @@ Return the trampoline if found or nil otherwise." form nil ;; If we've disabled nativecomp, don't write the trampolines to ;; the eln cache (but create them). - (and (not inhibit-native-compilation) + (and (not inhibit-automatic-native-compilation) (cl-loop for dir in (if native-compile-target-directory (list (expand-file-name comp-native-version-dir diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index c12453e8837..7e7ea6aeb9e 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -220,8 +220,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map." Load the compiled code when finished. Use `emacs-lisp-byte-compile-and-load' in combination with -`inhibit-native-compilation' set to nil to achieve asynchronous -native compilation." +`inhibit-automatic-native-compilation' set to nil to achieve +asynchronous native compilation." (interactive nil emacs-lisp-mode) (emacs-lisp--before-compile-buffer) (load (native-compile buffer-file-name))) diff --git a/lisp/startup.el b/lisp/startup.el index 03a67cdc0e8..04de7e42fea 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -541,7 +541,7 @@ DIRS are relative." (setq comp--compilable t)) (defvar native-comp-eln-load-path) -(defvar inhibit-native-compilation) +(defvar inhibit-automatic-native-compilation) (defvar comp-enable-subr-trampolines) (defvar startup--original-eln-load-path nil @@ -579,7 +579,8 @@ It sets `command-line-processed', processes the command-line, reads the initialization files, etc. It is the default value of the variable `top-level'." ;; Allow disabling automatic .elc->.eln processing. - (setq inhibit-native-compilation (getenv "EMACS_INHIBIT_NATIVE_COMPILATION")) + (setq inhibit-automatic-native-compilation + (getenv "EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION")) (if command-line-processed (message internal--top-level-message) @@ -599,7 +600,7 @@ It is the default value of the variable `top-level'." ;; in this session. This is necessary if libgccjit is not ;; available on MS-Windows, but Emacs was built with ;; native-compilation support. - (setq inhibit-native-compilation t + (setq inhibit-automatic-native-compilation t comp-enable-subr-trampolines nil)) ;; Form `native-comp-eln-load-path'. diff --git a/lisp/subr.el b/lisp/subr.el index 0c9d94db1cc..51172b1cb2d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1877,7 +1877,7 @@ instead; it will indirectly limit the specpdl stack size as well.") (make-obsolete-variable 'max-specpdl-size nil "29.1") (make-obsolete-variable 'native-comp-deferred-compilation - 'inhibit-native-compilation "29.1") + 'inhibit-automatic-native-compilation "29.1") ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/comp.c b/src/comp.c index ed64a850721..1b767ba0dd8 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5107,7 +5107,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, return; if (!native_comp_deferred_compilation - || !NILP (Vinhibit_native_compilation) + || !NILP (Vinhibit_automatic_native_compilation) || noninteractive || !NILP (Vpurify_flag) || !COMPILEDP (definition) @@ -5611,12 +5611,13 @@ For internal use. */); doc: /* Non-nil when comp.el can be native compiled. For internal use. */); /* Compiler control customizes. */ - DEFVAR_LISP ("inhibit-native-compilation", Vinhibit_native_compilation, + DEFVAR_LISP ("inhibit-automatic-native-compilation", + Vinhibit_automatic_native_compilation, doc: /* If non-nil, inhibit automatic native compilation of loaded .elc files. After compilation, each function definition is updated to the native compiled one. */); - Vinhibit_native_compilation = Qnil; + Vinhibit_automatic_native_compilation = Qnil; DEFVAR_BOOL ("native-comp-deferred-compilation", native_comp_deferred_compilation, -- cgit v1.2.3 From 43eaa05ff2265ae33f71b73670a8a150a7a716ae Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 2 Oct 2022 18:19:56 -0700 Subject: ; Fix logic of $HOME adjustment for 'ert-remote-temporary-file-directory' * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): Only adjust $HOME when it doesn't exist (bug#58265). --- lisp/emacs-lisp/ert-x.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index bfd796586da..a891f068a70 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -568,7 +568,7 @@ The same keyword arguments are supported as in `("\\`mock\\'" nil ,(system-name))) ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed ;; in batch mode only, therefore. - (unless (and (null noninteractive) (file-directory-p "~/")) + (when (and noninteractive (not (file-directory-p "~/"))) (setenv "HOME" temporary-file-directory)) (format "/mock::%s" temporary-file-directory)))) "Temporary directory for remote file tests.") -- cgit v1.2.3 From 535eec3bca36b84b104a4041f7bcdd5b1649a94b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 4 Oct 2022 12:49:49 +0200 Subject: Don't bug out in advice--make-docstring when there's not doc string * lisp/emacs-lisp/nadvice.el (advice--make-docstring): Don't bug out on functions with no documentation (bug#58284). --- lisp/emacs-lisp/nadvice.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index b4acd423b8d..429052bfdf3 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -157,7 +157,8 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (when before (insert before) (ensure-empty-lines 1)) - (insert origdoc) + (when origdoc + (insert origdoc)) (when after (ensure-empty-lines 1) (insert after)) -- cgit v1.2.3 From 9fb0aaa1ce4ed0050d2e13552f078a563c8a20ed Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 4 Oct 2022 13:04:16 +0200 Subject: Make loaddefs-generate more resilient * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Don't bug out when there's an existing loaddefs file that's not formatted properly (bug#58280). --- 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 095d6b14e63..964d23c770e 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -632,7 +632,7 @@ instead of just updating them with the new/changed autoloads." ;; It's a new file; put the data at the end. (progn (goto-char (point-max)) - (search-backward "\f\n")) + (search-backward "\f\n" nil t)) ;; Delete the old version of the section. (delete-region (match-beginning 0) (and (search-forward "\n\f\n;;;") -- cgit v1.2.3 From 79d9f3b845fc94726e242239574be21f5f49813c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 4 Oct 2022 14:11:04 +0200 Subject: Make `eq' obsolete as a generalized variable * lisp/emacs-lisp/gv.el (eq): Make obsolete as a generalized variable. --- etc/NEWS | 2 +- lisp/emacs-lisp/gv.el | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 2b876413585..e0e2178d284 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3066,7 +3066,7 @@ The following generalized variables have been made obsolete: 'current-column', 'current-global-map', 'current-input-mode', 'current-local-map', 'current-window-configuration', 'default-file-modes', 'documentation-property', 'frame-height', -'frame-width', 'frame-visible-p', 'global-key-binding', +'frame-width', 'frame-visible-p', 'global-key-binding', `if' 'local-key-binding', 'mark', 'mark-marker', 'marker-position', 'mouse-position', 'point', 'point-marker', 'point-max', 'point-min', 'read-mouse-position', 'screen-height', 'screen-width', diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index ade8064114d..a96fa19a3ff 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -812,6 +812,7 @@ REF must have been previously obtained with `gv-ref'." `(cond (,v ,(funcall setter val)) ((eq ,getter ,val) ,(funcall setter `(not ,val)))))))))) +(make-obsolete-generalized-variable 'eq nil "29.1") (gv-define-expander substring (lambda (do place from &optional to) -- cgit v1.2.3 From 92df7cd923d0e870f08484cec06c2726be30882b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 4 Oct 2022 21:44:52 +0200 Subject: Add 'seq-keep' * doc/lispref/sequences.texi (Sequence Functions): Document it. * lisp/emacs-lisp/seq.el (seq-keep): New function (bug#58278). --- doc/lispref/sequences.texi | 13 +++++++++++++ etc/NEWS | 5 +++++ lisp/emacs-lisp/seq.el | 4 ++++ test/lisp/emacs-lisp/seq-tests.el | 6 ++++++ 4 files changed, 28 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 12c15e6f9a2..bc5a4cf24a6 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -698,6 +698,19 @@ the same type as @var{sequence}. @end example @end defun +@defun seq-keep function sequence + This function returns a list of all non-@code{nil} results from +calling @var{function} on the elements in @var{sequence}. + +@example +@group +(seq-keep #'cl-digit-char-p '(?6 ?a ?7)) +@result{} (6 7) +@end group +@end example + +@end defun + @defun seq-reduce function sequence initial-value @cindex reducing sequences This function returns the result of calling @var{function} with diff --git a/etc/NEWS b/etc/NEWS index eb5d3afbd80..06e91f5d716 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3150,6 +3150,11 @@ These can be used for buttons in buffers and the like. See the This returns a list of the (zero-based) indices of elements matching a given predicate in the specified sequence. ++++ +** New function 'seq-keep'. +This is like 'seq-map', but removes all non-nil results from the +returned list. + +++ ** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. MESSAGE specifies a message to display after activating the transient diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 31dcfa98b40..82ade0ac0c3 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -695,5 +695,9 @@ which may be shorter." result)) (nreverse result))) +(defun seq-keep (function sequence) + "Apply FUNCTION to SEQUENCE and return all non-nil results." + (delq nil (seq-map function sequence))) + (provide 'seq) ;;; seq.el ends here diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index d95b35c45eb..e22f86f0447 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -592,5 +592,11 @@ Evaluate BODY for each created sequence. (should (= (length list) 10000)) (should (= (length (seq-uniq (append list list))) 10000)))) +(ert-deftest test-seq-keep () + (should (equal (seq-keep #'cl-digit-char-p '(?6 ?a ?7)) + '(6 7))) + (should (equal (seq-keep #'cl-digit-char-p [?6 ?a ?7]) + '(6 7)))) + (provide 'seq-tests) ;;; seq-tests.el ends here -- cgit v1.2.3