commit ebac67129e86ce201d88debb1a8c9d6924215e84 (HEAD, refs/remotes/origin/master) Author: Antero Mejr Date: Fri Mar 24 20:41:41 2023 +0000 eshell: Add 'rgrep' builtin * lisp/eshell/em-unix.el (eshell/rgrep): New function. (eshell-unix-initialize): Add "rgrep" to 'eshell-complex-commands'. * etc/NEWS: Add NEWS entry for rgrep. * doc/misc/eshell.texi (Built-ins): Add documentation for rgrep. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 1c33c04f647..4e2bddf42af 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -602,6 +602,8 @@ Built-ins @cmindex egrep @itemx fgrep @cmindex fgrep +@itemx rgrep +@cmindex rgrep @itemx glimpse @cmindex glimpse The @command{grep} commands are compatible with GNU @command{grep}, diff --git a/etc/NEWS b/etc/NEWS index c61a9ec3c5f..5e1fd76e99e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -174,6 +174,11 @@ correctly unloads Eshell and all of its modules. After manually editing 'eshell-aliases-file', you can use this command to load the edited aliases. ++++ +*** 'rgrep' is now a builtin command. +Running "rgrep" in Eshell now uses the Emacs grep facility instead of +calling external rgrep. + ** Shell Mode +++ diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index d550910f4f0..a792493e071 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -145,9 +145,10 @@ eshell-unix-initialize (add-hook 'pcomplete-try-first-hook 'eshell-complete-host-reference nil t)) (setq-local eshell-complex-commands - (append '("grep" "egrep" "fgrep" "agrep" "glimpse" "locate" - "cat" "time" "cp" "mv" "make" "du" "diff") - eshell-complex-commands))) + (append '("grep" "egrep" "fgrep" "agrep" "rgrep" + "glimpse" "locate" "cat" "time" "cp" "mv" + "make" "du" "diff") + eshell-complex-commands))) (defalias 'eshell/date 'current-time-string) (defalias 'eshell/basename 'file-name-nondirectory) @@ -773,6 +774,10 @@ eshell/agrep "Use Emacs grep facility instead of calling external agrep." (eshell-grep "agrep" args)) +(defun eshell/rgrep (&rest args) + "Use Emacs grep facility instead of calling external rgrep." + (eshell-grep "grep" (append '("-rH") args) t)) + (defun eshell/glimpse (&rest args) "Use Emacs grep facility instead of calling external glimpse." (let (null-device) commit 0724e0aeb5be7c60cd76c6afc8e22ed47d9c85bd Author: Andrew G Cohen Date: Mon Apr 10 11:34:43 2023 +0800 * lisp/gnus/nnselect.el (nnselect-push-info): Sort artlist diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 9a2957c9f52..af4dbdc35df 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -909,6 +909,7 @@ nnselect-push-info ;; now work on each originating group one at a time (pcase-dolist (`(,artgroup . ,artlist) (numbers-by-group gnus-newsgroup-articles)) + (setq artlist (sort artlist #'<)) (let* ((group-info (gnus-get-info artgroup)) (old-unread (gnus-list-of-unread-articles artgroup)) newmarked delta-marks) commit 54d40577c4bb64d25db030b7d11ab553364e375d Author: Stefan Monnier Date: Mon Apr 10 21:33:56 2023 -0400 (org-table-make-reference): Fix compiler warning * lisp/org/org-table.el (org-table-make-reference): Don't use `eq` to compare against literal strings. diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 5116b1127f7..a38f2a283d7 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -2861,7 +2861,7 @@ org-table-make-reference (if lispp (if (eq lispp 'literal) elements - (if (and (eq elements "") (not keep-empty)) + (if (and (equal elements "") (not keep-empty)) "" (prin1-to-string (if numbers (string-to-number elements) elements)))) commit 9efa6d2cf28f4e21f23bb0dbfedc59a4286dab12 Author: Spencer Baugh Date: Mon Apr 10 15:11:06 2023 -0400 Add support for prompting for projects by name * lisp/progmodes/project.el (project-prompter): New user option (bug#62759). (project-prompt-project-name): New function. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 877d79353aa..e7c0bd2069b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -202,6 +202,17 @@ project-current-directory-override "Value to use instead of `default-directory' when detecting the project. When it is non-nil, `project-current' will always skip prompting too.") +(defcustom project-prompter #'project-prompt-project-dir + "Function to call to prompt for a project. +Called with no arguments and should return a project root dir." + :type '(choice (const :tag "Prompt for a project directory" + project-prompt-project-dir) + (const :tag "Prompt for a project name" + project-prompt-project-name) + (function :tag "Custom function" nil)) + :group 'project + :version "30.1") + ;;;###autoload (defun project-current (&optional maybe-prompt directory) "Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -226,7 +237,7 @@ project-current (pr) ((unless project-current-directory-override maybe-prompt) - (setq directory (project-prompt-project-dir) + (setq directory (funcall project-prompter) pr (project--find-in-directory directory)))) (when maybe-prompt (if pr @@ -1615,7 +1626,7 @@ project-forget-project "Remove directory PROJECT-ROOT from the project list. PROJECT-ROOT is the root directory of a known project listed in the project list." - (interactive (list (project-prompt-project-dir))) + (interactive (list (funcall project-prompter))) (project--remove-from-project-list project-root "Project `%s' removed from known projects")) @@ -1639,6 +1650,32 @@ project-prompt-project-dir (read-directory-name "Select directory: " default-directory nil t) pr-dir))) +(defun project-prompt-project-name () + "Prompt the user for a project, by name, that is one of the known project roots. +The project is chosen among projects known from the project list, +see `project-list-file'. +It's also possible to enter an arbitrary directory not in the list." + (let* ((dir-choice "... (choose a dir)") + (choices + (let (ret) + (dolist (dir (project-known-project-roots)) + ;; we filter out directories that no longer map to a project, + ;; since they don't have a clean project-name. + (if-let (proj (project--find-in-directory dir)) + (push (cons (project-name proj) proj) ret))) + ret)) + ;; XXX: Just using this for the category (for the substring + ;; completion style). + (table (project--file-completion-table (cons dir-choice choices))) + (pr-name "")) + (while (equal pr-name "") + ;; If the user simply pressed RET, do this again until they don't. + (setq pr-name (completing-read "Select project: " table nil t))) + (if (equal pr-name dir-choice) + (read-directory-name "Select directory: " default-directory nil t) + (let ((proj (assoc pr-name choices))) + (if (stringp proj) proj (project-root (cdr proj))))))) + ;;;###autoload (defun project-known-project-roots () "Return the list of root directories of all known projects." @@ -1826,7 +1863,7 @@ project-switch-project When called in a program, it will use the project corresponding to directory DIR." - (interactive (list (project-prompt-project-dir))) + (interactive (list (funcall project-prompter))) (let ((command (if (symbolp project-switch-commands) project-switch-commands (project--switch-project-command)))) commit 2d3947ba7a7ed5ff1f7da794710e10dacc415881 Author: Dmitry Gutov Date: Tue Apr 11 00:24:19 2023 +0300 html-ts-mode--indent-rules: Use 'column-0' instead of 'point-min' * lisp/textmodes/html-ts-mode.el (html-ts-mode--indent-rules): Use 'column-0' instead of 'point-min' (bug#62752). diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 58dcc7d8cad..4c1f410a7ef 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -42,7 +42,7 @@ html-ts-mode-indent-offset (defvar html-ts-mode--indent-rules `((html - ((parent-is "fragment") point-min 0) + ((parent-is "fragment") column-0 0) ((node-is "/>") parent-bol 0) ((node-is ">") parent-bol 0) ((node-is "end_tag") parent-bol 0) commit 7c034f65fdca0293ba6c54f2574f12372a256183 Author: F. Jason Park Date: Mon Apr 10 00:08:37 2023 -0700 Take better care when setting margins in erc-stamp * lisp/erc/erc-stamp.el (erc-stamp--adjust-right-margin, erc-stamp--display-margin-mode): Prefer setting `fringes-outside-margins' to hiding right margin, and check whether current buffer is showing before adjusting anything. (Bug#60936.) diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 8bca9bdb56b..61f289a8753 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -302,10 +302,9 @@ erc-stamp--adjust-right-margin (current-time) erc-timestamp-format))))) (+ right-margin-width cols)))) - (setq right-margin-width width - right-fringe-width 0) - (set-window-margins nil left-margin-width width) - (set-window-fringes nil left-fringe-width 0))) + (setq right-margin-width width) + (when (eq (current-buffer) (window-buffer)) + (set-window-margins nil left-margin-width width)))) ;;;###autoload (defun erc-stamp-prefix-log-filter (text) @@ -344,6 +343,9 @@ erc-stamp--display-margin-mode :interactive nil (if erc-stamp--display-margin-mode (progn + (setq fringes-outside-margins t) + (when (eq (current-buffer) (window-buffer)) + (set-window-buffer (selected-window) (current-buffer))) (erc-stamp--adjust-right-margin 0) (add-function :filter-return (local 'filter-buffer-substring-function) #'erc--remove-text-properties) @@ -354,9 +356,10 @@ erc-stamp--display-margin-mode (remove-function (local 'erc-insert-timestamp-function) #'erc-stamp--display-margin-force) (kill-local-variable 'right-margin-width) - (kill-local-variable 'right-fringe-width) - (set-window-margins nil left-margin-width nil) - (set-window-fringes nil left-fringe-width nil))) + (kill-local-variable 'fringes-outside-margins) + (when (eq (current-buffer) (window-buffer)) + (set-window-margins nil left-margin-width nil) + (set-window-buffer (selected-window) (current-buffer))))) (defun erc-insert-timestamp-left (string) "Insert timestamps at the beginning of the line." commit cb4f4dd89131e5a8956c788fee7ede65f13b2a69 Author: Mattias Engdegård Date: Mon Apr 10 15:20:27 2023 +0200 Don't use `mapconcat` for effect * lisp/progmodes/make-mode.el (makefile-browser-fill): * lisp/url/url-mailto.el (url-mailto): Use `mapc` instead of `mapconcat`. diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 087974bd1f0..5ea03b9e852 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1326,14 +1326,12 @@ makefile-browser-fill (let ((inhibit-read-only t)) (goto-char (point-min)) (erase-buffer) - (mapconcat + (mapc (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")) - targets - "") - (mapconcat + targets) + (mapc (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")) - macros - "") + macros) (sort-lines nil (point-min) (point-max)) (goto-char (1- (point-max))) (delete-char 1) ; remove unnecessary newline at eob diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index 24e64e99c9f..04d6d9681ff 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -120,11 +120,11 @@ url-mailto (url-mail-goto-field nil) (url-mail-goto-field "subject"))) (if url-request-extra-headers - (mapconcat + (mapc (lambda (x) (url-mail-goto-field (car x)) (insert (cdr x))) - url-request-extra-headers "")) + url-request-extra-headers)) (goto-char (point-max)) (insert url-request-data) ;; It seems Microsoft-ish to send without warning. commit 119a7dd22084fe20da7b2fddd41a63870da89bda Author: Mattias Engdegård Date: Mon Apr 10 15:07:24 2023 +0200 ebnf2ps: eliminate double nreverse * lisp/progmodes/ebnf-otz.el (ebnf-split-suffix): Simplify code that relied on a rather inobvious in-place reversal of a list twice for correctness, silencing a byte-compiler warning. diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index 9ac37b676f9..4155dc0d2cd 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -566,7 +566,7 @@ ebnf-split-suffix ;; determine suffix length (while (and (> isuf 0) (setq tail (cdr tail))) (let* ((cur head) - (tlis (nreverse + (tlis (reverse (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence) (ebnf-node-list (car tail)) (list (car tail))))) @@ -577,7 +577,6 @@ ebnf-split-suffix (setq cur (cdr cur) this (cdr this) i (1+ i))) - (nreverse tlis) (setq isuf (min isuf i)))) (setq head (nreverse head)) (if (or (zerop isuf) (> isuf len)) commit ab8153b3bbafe2a06c0a4dffeab83448dc3e5600 Author: Basil L. Contovounesios Date: Mon Apr 10 10:58:49 2023 +0100 Clarify process-environment in eglot-tests * test/lisp/progmodes/eglot-tests.el (eglot--call-with-fixture): Clarify commentary (bug#61637). Use null-device and briefer syntax. diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index ad0a411189f..efb0f4d8844 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -92,24 +92,24 @@ eglot--call-with-fixture test-body-successful-p) (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test))) (unwind-protect - (let* ((process-environment - (append - `(;; Set XDF_CONFIG_HOME to /dev/null to prevent - ;; user-configuration to have an influence on - ;; language servers. (See github#441) - "XDG_CONFIG_HOME=/dev/null" - ;; ... on the flip-side, a similar technique by - ;; Emacs's test makefiles means that HOME is - ;; spoofed to /nonexistent, or sometimes /tmp. - ;; This breaks some common installations for LSP - ;; servers like pylsp, rust-analyzer making these - ;; tests mostly useless, so we hack around it here - ;; with a great big hack. - ,(format "HOME=%s" - (expand-file-name (format "~%s" (user-login-name))))) - process-environment)) - (eglot-server-initialized-hook - (lambda (server) (push server new-servers)))) + (let ((process-environment + `(;; Set XDG_CONFIG_HOME to /dev/null to prevent + ;; user-configuration influencing language servers + ;; (see github#441). + ,(format "XDG_CONFIG_HOME=%s" null-device) + ;; ... on the flip-side, a similar technique in + ;; Emacs's `test/Makefile' spoofs HOME as + ;; /nonexistent (and as `temporary-file-directory' in + ;; `ert-remote-temporary-file-directory'). + ;; This breaks some common installations for LSP + ;; servers like rust-analyzer, making these tests + ;; mostly useless, so we hack around it here with a + ;; great big hack. + ,(format "HOME=%s" + (expand-file-name (format "~%s" (user-login-name)))) + ,@process-environment)) + (eglot-server-initialized-hook + (lambda (server) (push server new-servers)))) (setq created-files (mapcan #'eglot--make-file-or-dir fixture)) (prog1 (funcall fn) (setq test-body-successful-p t))) commit ba7ef9699ff21667f8b242e294616f0a255ede22 Author: Basil L. Contovounesios Date: Mon Apr 10 10:42:09 2023 +0100 End default-directory with slash in eglot-tests * test/lisp/progmodes/eglot-tests.el (eglot--call-with-fixture): Separate prefix from random part of temporary file name. Ensure default-directory ends with a directory separator (bug#61637). diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 0486c938558..ad0a411189f 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -85,8 +85,8 @@ eglot--make-file-or-dir (defun eglot--call-with-fixture (fixture fn) "Helper for `eglot--with-fixture'. Run FN under FIXTURE." - (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t)) - (default-directory fixture-directory) + (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture-" t)) + (default-directory (file-name-as-directory fixture-directory)) created-files new-servers test-body-successful-p) commit 3faf43137a376631c49b1300e693acc83e20d9c1 Author: Mattias Engdegård Date: Mon Apr 10 11:15:57 2023 +0200 ; Eliminate warning when `dired-map-over-marks` value is unused * lisp/dired.el (dired-map-over-marks): Reformulate. diff --git a/lisp/dired.el b/lisp/dired.el index 8e3244356fe..d1471e993a1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -927,9 +927,9 @@ dired-map-over-marks (lambda () (if ,show-progress (sit-for 0)) (setq results (cons ,body results)))) - (if (< ,arg 0) - (nreverse results) - results)) + (when (< ,arg 0) + (setq results (nreverse results))) + results) ;; non-nil, non-integer, non-marked ARG means use current file: (list ,body)) (let ((regexp (dired-marker-regexp)) next-position) commit c753a9592345e2084d69e9e2cc458c16db2e4141 Author: Mattias Engdegård Date: Mon Apr 10 10:25:11 2023 +0200 Update manual about `sort` * doc/lispref/sequences.texi (Sequence Functions): Remove inaccurate and over-specific claims about how `sort` works for lists: there is no guarantee that it doesn't modify the `car` fields of the input list (which is precisely what it does at this time). diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 7011b5c72af..dd5b723b479 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -376,45 +376,43 @@ Sequence Functions use a comparison function which does not meet these requirements, the result of @code{sort} is unpredictable. -The destructive aspect of @code{sort} for lists is that it rearranges the -cons cells forming @var{sequence} by changing @sc{cdr}s. A nondestructive -sort function would create new cons cells to store the elements in their -sorted order. If you wish to make a sorted copy without destroying the -original, copy it first with @code{copy-sequence} and then sort. - -Sorting does not change the @sc{car}s of the cons cells in @var{sequence}; -the cons cell that originally contained the element @code{a} in -@var{sequence} still has @code{a} in its @sc{car} after sorting, but it now -appears in a different position in the list due to the change of -@sc{cdr}s. For example: +The destructive aspect of @code{sort} for lists is that it reuses the +cons cells forming @var{sequence} by changing their contents, possibly +rearranging them in a different order. This means that the value of +the input list is undefined after sorting; only the list returned by +@code{sort} has a well-defined value. Example: @example @group -(setq nums (list 1 3 2 6 5 4 0)) - @result{} (1 3 2 6 5 4 0) -@end group -@group +(setq nums (list 2 1 4 3 0)) (sort nums #'<) - @result{} (0 1 2 3 4 5 6) -@end group -@group -nums - @result{} (1 2 3 4 5 6) + @result{} (0 1 2 3 4) + ; nums is unpredictable at this point @end group @end example -@noindent -@strong{Warning}: Note that the list in @code{nums} no longer contains -0; this is the same cons cell that it was before, but it is no longer -the first one in the list. Don't assume a variable that formerly held -the argument now holds the entire sorted list! Instead, save the result -of @code{sort} and use that. Most often we store the result back into -the variable that held the original list: +Most often we store the result back into the variable that held the +original list: @example (setq nums (sort nums #'<)) @end example +If you wish to make a sorted copy without destroying the original, +copy it first and then sort: + +@example +@group +(setq nums (list 2 1 4 3 0)) +(sort (copy-sequence nums) #'<) + @result{} (0 1 2 3 4) +@end group +@group +nums + @result{} (2 1 4 3 0) +@end group +@end example + For the better understanding of what stable sort is, consider the following vector example. After sorting, all items whose @code{car} is 8 are grouped at the beginning of @code{vector}, but their relative order is preserved. commit 44cc54e409943275f4a600136bf5136e9c655626 Author: Basil L. Contovounesios Date: Mon Apr 10 10:23:06 2023 +0100 Tweak file/dir creation in eglot-tests * test/lisp/progmodes/eglot-tests.el (eglot--make-file-or-dir): Expand file name only once, under default-directory, avoiding duplicate dir separators. Ensure default-directory ends with a dir separator. Use with-temp-file. (Bug#61637) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 86e7b21def0..0486c938558 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -70,17 +70,16 @@ eglot--with-fixture `(eglot--call-with-fixture ,fixture (lambda () ,@body))) (defun eglot--make-file-or-dir (ass) - (let ((file-or-dir-name (car ass)) + (let ((file-or-dir-name (expand-file-name (car ass))) (content (cdr ass))) (cond ((listp content) (make-directory file-or-dir-name 'parents) - (let ((default-directory (concat default-directory "/" file-or-dir-name))) + (let ((default-directory (file-name-as-directory file-or-dir-name))) (mapcan #'eglot--make-file-or-dir content))) ((stringp content) - (with-temp-buffer - (insert content) - (write-region nil nil file-or-dir-name nil 'nomessage)) - (list (expand-file-name file-or-dir-name))) + (with-temp-file file-or-dir-name + (insert content)) + (list file-or-dir-name)) (t (eglot--error "Expected a string or a directory spec"))))) commit b5c5e923dba5c5a7b064ce3371d13e165b5caa9e Author: Basil L. Contovounesios Date: Mon Apr 10 00:33:13 2023 +0100 Simplify let-bindings in eglot-tests * test/lisp/progmodes/eglot-tests.el (eglot--call-with-fixture): Don't allow fixture elements to be symbol-value pairs (bug#61637). This feature was used in only one test. The same effect can be achieved in a simpler way, and closer to the body, with plain let-bindings. (eglot--with-fixture): Adapt docstring accordingly. (eglot-test-ensure): Adapt c-mode-hook binding accordingly. (eglot--cleanup-after-test): Remove symbol restoring logic. diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index e48d83a97e0..86e7b21def0 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -61,16 +61,13 @@ eglot--test-message (apply #'format format args))) (defmacro eglot--with-fixture (fixture &rest body) - "Setup FIXTURE, call BODY, teardown FIXTURE. + "Set up FIXTURE, call BODY, tear down FIXTURE. FIXTURE is a list. Its elements are of the form (FILE . CONTENT) to create a readable FILE with CONTENT. FILE may be a directory name and CONTENT another (FILE . CONTENT) list to specify a -directory hierarchy. FIXTURE's elements can also be (SYMBOL -VALUE) meaning SYMBOL should be bound to VALUE during BODY and -then restored." +directory hierarchy." (declare (indent 1) (debug t)) - `(eglot--call-with-fixture - ,fixture #'(lambda () ,@body))) + `(eglot--call-with-fixture ,fixture (lambda () ,@body))) (defun eglot--make-file-or-dir (ass) (let ((file-or-dir-name (car ass)) @@ -91,18 +88,9 @@ eglot--call-with-fixture "Helper for `eglot--with-fixture'. Run FN under FIXTURE." (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t)) (default-directory fixture-directory) - file-specs created-files - syms-to-restore + created-files new-servers test-body-successful-p) - (dolist (spec fixture) - (cond ((symbolp spec) - (push (cons spec (symbol-value spec)) syms-to-restore) - (set spec nil)) - ((symbolp (car spec)) - (push (cons (car spec) (symbol-value (car spec))) syms-to-restore) - (set (car spec) (cadr spec))) - ((stringp (car spec)) (push spec file-specs)))) (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test))) (unwind-protect (let* ((process-environment @@ -123,7 +111,7 @@ eglot--call-with-fixture process-environment)) (eglot-server-initialized-hook (lambda (server) (push server new-servers)))) - (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) + (setq created-files (mapcan #'eglot--make-file-or-dir fixture)) (prog1 (funcall fn) (setq test-body-successful-p t))) (eglot--test-message "[%s]: %s" (ert-test-name (ert-running-test)) @@ -155,18 +143,15 @@ eglot--call-with-fixture (t (eglot--test-message "Preserved for inspection: %s" (mapconcat #'buffer-name buffers ", ")))))))) - (eglot--cleanup-after-test fixture-directory created-files syms-to-restore))))) + (eglot--cleanup-after-test fixture-directory created-files))))) -(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore) +(defun eglot--cleanup-after-test (fixture-directory created-files) (let ((buffers-to-delete - (delete nil (mapcar #'find-buffer-visiting created-files)))) - (eglot--test-message "Killing %s, wiping %s, restoring %s" + (delq nil (mapcar #'find-buffer-visiting created-files)))) + (eglot--test-message "Killing %s, wiping %s" buffers-to-delete - fixture-directory - (mapcar #'car syms-to-restore)) - (cl-loop for (sym . val) in syms-to-restore - do (set sym val)) - (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted + fixture-directory) + (dolist (buf buffers-to-delete) ;; Have to save otherwise will get prompted. (with-current-buffer buf (save-buffer) (kill-buffer))) (delete-directory fixture-directory 'recursive) ;; Delete Tramp buffers if needed. @@ -871,9 +856,9 @@ eglot-test-ensure (skip-unless (executable-find "clangd")) (eglot--with-fixture `(("project" . (("foo.c" . "int foo() {return 42;}") - ("bar.c" . "int bar() {return 42;}"))) - (c-mode-hook (eglot-ensure))) - (let (server) + ("bar.c" . "int bar() {return 42;}")))) + (let ((c-mode-hook '(eglot-ensure)) + server) ;; need `ert-simulate-command' because `eglot-ensure' ;; relies on `post-command-hook'. (with-current-buffer commit f09f571b3cadec029855f41a4b9533ac97061485 Author: Basil L. Contovounesios Date: Mon Apr 10 00:18:15 2023 +0100 Minor eglot-tests cosmetics * test/lisp/progmodes/eglot-tests.el: (eglot--eldoc-on-demand, eglot--tests-force-full-eldoc) (eglot-test-multiline-eldoc, eglot-test-rust-on-type-formatting) (eglot-test-path-to-uri-windows): Fix headings, commentary, and indentation (bug#61637). diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 041aafabe8e..e48d83a97e0 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -37,8 +37,8 @@ ;; value (FIXME: like what?) in order to overwrite the default value. ;; ;; IMPORTANT: Since Eglot is a :core ELPA package, these tests are - ;;supposed to run on Emacsen down to 26.3. Do not use bleeding-edge - ;;functionality not compatible with that Emacs version. +;; supposed to run on Emacsen down to 26.3. Do not use bleeding-edge +;; functionality not compatible with that Emacs version. ;;; Code: (require 'eglot) @@ -479,11 +479,11 @@ eglot-test-diagnostic-tags-unnecessary-code (should (eq 'eglot-diagnostic-tag-unnecessary-face (face-at-point)))))))) (defun eglot--eldoc-on-demand () - ;; Trick Eldoc 1.1.0 into accepting on-demand calls. + ;; Trick ElDoc 1.1.0 into accepting on-demand calls. (eldoc t)) (defun eglot--tests-force-full-eldoc () - ;; FIXME: This uses some Eldoc implementation defatils. + ;; FIXME: This uses some ElDoc implementation details. (when (buffer-live-p eldoc--doc-buffer) (with-current-buffer eldoc--doc-buffer (let ((inhibit-read-only t)) @@ -669,7 +669,7 @@ eglot-test-eldoc-after-completions (should (string-match "^fprintf" (eglot--tests-force-full-eldoc)))))) (ert-deftest eglot-test-multiline-eldoc () - "Test Eldoc documentation from multiple osurces." + "Test ElDoc documentation from multiple osurces." (skip-unless (executable-find "clangd")) (eglot--with-fixture `(("project" . (("coiso.c" . @@ -722,7 +722,7 @@ eglot-test-rust-on-type-formatting (eglot--sniffing (:server-notifications s-notifs) (should (eglot--tests-connect)) (eglot--wait-for (s-notifs 20) (&key method &allow-other-keys) - (string= method "textDocument/publishDiagnostics"))) + (string= method "textDocument/publishDiagnostics"))) (goto-char (point-max)) (eglot--simulate-key-event ?.) (should (looking-back "^ \\.")))))) @@ -1287,7 +1287,7 @@ eglot-test-tramp-test-2 (ert-deftest eglot-test-path-to-uri-windows () (skip-unless (eq system-type 'windows-nt)) (should (string-prefix-p "file:///" - (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))) + (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))) (should (string-suffix-p "c%3A/Users/Foo/bar.lisp" (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))) @@ -1317,8 +1317,9 @@ eglot-test-same-server-multi-mode (should (eq (eglot-current-server) server)))))) (provide 'eglot-tests) -;;; eglot-tests.el ends here ;; Local Variables: ;; checkdoc-force-docstrings-flag: nil ;; End: + +;;; eglot-tests.el ends here commit 6674ac17eb42a5b0b7405770771b07253fd75bf3 Author: Basil L. Contovounesios Date: Sun Apr 9 23:32:14 2023 +0100 Avoid Git project in eglot-test-eclipse-connect * test/lisp/progmodes/eglot-tests.el (eglot-test-eclipse-connect): Avoid creating a Git project, which subsequently confuses project-files (bug#62741). diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 62e04539ebf..041aafabe8e 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -325,8 +325,7 @@ eglot-test-eclipse-connect "Connect to eclipse.jdt.ls server." (skip-unless (executable-find "jdtls")) (eglot--with-fixture - '(("project/src/main/java/foo" . (("Main.java" . ""))) - ("project/.git/" . nil)) + '(("project/src/main/java/foo" . (("Main.java" . "")))) (with-current-buffer (eglot--find-file-noselect "project/src/main/java/foo/Main.java") (eglot--sniffing (:server-notifications s-notifs) commit 48f3bfb8b987b19cbecce592e9195b8a8a743c08 Author: Basil L. Contovounesios Date: Sun Apr 9 20:28:32 2023 +0100 Tweak ert-remote-temporary-file-directory in tests * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): Don't add trailing slash to HOME (bug#61637). Reindent docstring. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 98a017c8a8e..e8b0dd92989 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -563,9 +563,9 @@ ert-remote-temporary-file-directory ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed ;; in batch mode only, therefore. (when (and noninteractive (not (file-directory-p "~/"))) - (setenv "HOME" temporary-file-directory)) + (setenv "HOME" (directory-file-name temporary-file-directory))) (format "/mock::%s" temporary-file-directory)))) - "Temporary directory for remote file tests.") + "Temporary directory for remote file tests.") (provide 'ert-x) commit 9037159c47a1ab53f860de91cf4f97ff56acd96f Author: Basil L. Contovounesios Date: Sat Apr 8 17:18:06 2023 +0100 Pacify byte-compiler warnings in nadvice-tests * test/lisp/emacs-lisp/nadvice-tests.el (advice-test-called-interactively-p) (advice-test-called-interactively-p-around) (advice-test-called-interactively-p-filter-args) (advice-test-call-interactively): Heed advertised-calling-convention of called-interactively-p to pacify byte-compiler warnings. diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index 716ab694e2c..f6bd5733ba3 100644 --- a/test/lisp/emacs-lisp/nadvice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el @@ -118,20 +118,20 @@ advice-test-called-interactively-p (declare-function sm-test7 nil) (advice-add 'sm-test7 :around (lambda (f &rest args) - (list (cons 1 (called-interactively-p)) (apply f args)))) + (list (cons 1 (called-interactively-p 'any)) (apply f args)))) (should (equal (sm-test7) '((1 . nil) 11))) (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) (let ((smi 7)) (advice-add 'sm-test7 :before (lambda (&rest _args) - (setq smi (called-interactively-p)))) + (setq smi (called-interactively-p 'any)))) (should (equal (list (sm-test7) smi) '(((1 . nil) 11) nil))) (should (equal (list (call-interactively 'sm-test7) smi) '(((1 . t) 11) t)))) (advice-add 'sm-test7 :around (lambda (f &rest args) - (cons (cons 2 (called-interactively-p)) (apply f args)))) + (cons (cons 2 (called-interactively-p 'any)) (apply f args)))) (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11)))) (ert-deftest advice-test-called-interactively-p-around () @@ -140,18 +140,18 @@ advice-test-called-interactively-p-around This tests the currently broken case of the innermost advice to a function being an around advice." :expected-result :failed - (defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p))) + (defun sm-test7.2 () (interactive) (cons 1 (called-interactively-p 'any))) (declare-function sm-test7.2 nil) (advice-add 'sm-test7.2 :around (lambda (f &rest args) - (list (cons 1 (called-interactively-p)) (apply f args)))) + (list (cons 1 (called-interactively-p 'any)) (apply f args)))) (should (equal (sm-test7.2) '((1 . nil) (1 . nil)))) (should (equal (call-interactively 'sm-test7.2) '((1 . t) (1 . t))))) (ert-deftest advice-test-called-interactively-p-filter-args () "Check interaction between filter-args advice and called-interactively-p." :expected-result :failed - (defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p))) + (defun sm-test7.3 () (interactive) (cons 1 (called-interactively-p 'any))) (declare-function sm-test7.3 nil) (advice-add 'sm-test7.3 :filter-args #'list) (should (equal (sm-test7.3) '(1 . nil))) @@ -159,7 +159,9 @@ advice-test-called-interactively-p-filter-args (ert-deftest advice-test-call-interactively () "Check interaction between advice on call-interactively and called-interactively-p." - (let ((sm-test7.4 (lambda () (interactive) (cons 1 (called-interactively-p)))) + (let ((sm-test7.4 (lambda () + (interactive) + (cons 1 (called-interactively-p 'any)))) (old (symbol-function 'call-interactively))) (unwind-protect (progn commit 2347b102af29a35c95d2f63badd95a15fdeb7cf1 Author: Michael Albinus Date: Sun Apr 9 18:51:21 2023 +0200 Adapt Tramp test * test/lisp/net/tramp-tests.el (tramp-test09-insert-file-contents): Adapt test. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3a9f5e03000..9bca6a03754 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2412,22 +2412,51 @@ tramp-test09-insert-file-contents (with-temp-buffer (write-region "foo" nil tmp-name) (let ((point (point))) - (insert-file-contents tmp-name) + (should + (equal + (insert-file-contents tmp-name) + `(,(expand-file-name tmp-name) 3))) (should (string-equal (buffer-string) "foo")) (should (= point (point)))) (goto-char (1+ (point))) (let ((point (point))) - (insert-file-contents tmp-name) + (should + (equal + (insert-file-contents tmp-name) + `(,(expand-file-name tmp-name) 3))) (should (string-equal (buffer-string) "ffoooo")) (should (= point (point)))) ;; Insert partly. (let ((point (point))) - (insert-file-contents tmp-name nil 1 3) + (should + (equal + (insert-file-contents tmp-name nil 1 3) + `(,(expand-file-name tmp-name) 2))) (should (string-equal (buffer-string) "foofoooo")) (should (= point (point)))) + (let ((point (point))) + (should + (equal + (insert-file-contents tmp-name nil 2 5) + `(,(expand-file-name tmp-name) 1))) + (should (string-equal (buffer-string) "fooofoooo")) + (should (= point (point)))) ;; Replace. (let ((point (point))) - (insert-file-contents tmp-name nil nil nil 'replace) + ;; 0 characters replaced, because "foo" is already there. + (should + (equal + (insert-file-contents tmp-name nil nil nil 'replace) + `(,(expand-file-name tmp-name) 0))) + (should (string-equal (buffer-string) "foo")) + (should (= point (point)))) + (let ((point (point))) + (replace-string-in-region "foo" "bar" (point-min) (point-max)) + (goto-char point) + (should + (equal + (insert-file-contents tmp-name nil nil nil 'replace) + `(,(expand-file-name tmp-name) 3))) (should (string-equal (buffer-string) "foo")) (should (= point (point)))) ;; Error case. commit 6157e3e4bc7e4e097e02c572379d1b1542e1d716 Author: Mattias Engdegård Date: Sun Apr 9 15:57:31 2023 +0200 Extend ignored-return-value warning to more functions (bug#61730) Warn when the return value of certain functions is unused. Previously this was only done for side-effect-free functions, and for `mapcar`. These are functions where the return value is important for correct usage or where ignoring it is likely to indicate a mistake. The exact set of functions is tentative and will be modified as we gain a better understanding of which ones to include. The current set comprises higher order functions such as `mapcar` which are not primarily called for the effects of their function arguments, and list-mutating functions like `nreverse` whose return value is essential. * lisp/emacs-lisp/bytecomp.el (byte-compile-form): Add list of functions to warn about when their value is ignored. * etc/NEWS: Announce. diff --git a/etc/NEWS b/etc/NEWS index d20d9f65ac9..c61a9ec3c5f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -443,6 +443,21 @@ simplified away. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. +--- +*** Warn about more ignored function return values. +The compiler now warns when the return value from certain functions is +ignored. Example: + + (progn (nreverse my-list) my-list) + +will elicit a warning because it is usually pointless to call +'nreverse' on a list without using the returned value. To silence the +warning, make use of the value in some way, such as assigning it to a +variable. You can also wrap the function call in '(ignore ...)'. + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'ignored-return-value'. + +++ ** New function 'file-user-uid'. This function is like 'user-uid', but is aware of file name handlers, diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4a10ae29804..1b28fcd5093 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3502,7 +3502,67 @@ byte-compile-form ;; so maybe we don't need to bother about it here? (setq form (cons 'progn (cdr form))) (setq handler #'byte-compile-progn)) - ((and (or sef (eq (car form) 'mapcar)) + ((and (or sef + (memq (car form) + ;; FIXME: Use a function property (declaration) + ;; instead of this list. + '( + ;; Functions that are side-effect-free + ;; except for the behaviour of + ;; functions passed as argument. + mapcar mapcan mapconcat + cl-mapcar cl-mapcan cl-maplist cl-map cl-mapcon + cl-reduce + assoc assoc-default plist-get plist-member + cl-assoc cl-assoc-if cl-assoc-if-not + cl-rassoc cl-rassoc-if cl-rassoc-if-not + cl-member cl-member-if cl-member-if-not + cl-adjoin + cl-mismatch cl-search + cl-find cl-find-if cl-find-if-not + cl-position cl-position-if cl-position-if-not + cl-count cl-count-if cl-count-if-not + cl-remove cl-remove-if cl-remove-if-not + cl-member cl-member-if cl-member-if-not + cl-remove-duplicates + cl-subst cl-subst-if cl-subst-if-not + cl-substitute cl-substitute-if + cl-substitute-if-not + cl-sublis + cl-union cl-intersection + cl-set-difference cl-set-exclusive-or + cl-subsetp + cl-every cl-some cl-notevery cl-notany + cl-tree-equal + + ;; Functions that mutate and return a list. + cl-delete-if cl-delete-if-not + ;; `delete-dups' and `delete-consecutive-dups' + ;; never delete the first element so it's + ;; safe to ignore their return value, but + ;; this isn't the case with + ;; `cl-delete-duplicates'. + cl-delete-duplicates + cl-nsubst cl-nsubst-if cl-nsubst-if-not + cl-nsubstitute cl-nsubstitute-if + cl-nsubstitute-if-not + cl-nunion cl-nintersection + cl-nset-difference cl-nset-exclusive-or + cl-nreconc cl-nsublis + cl-merge + ;; It's safe to ignore the value of `sort' + ;; and `nreverse' when used on arrays, + ;; but most calls pass lists. + nreverse + sort cl-sort cl-stable-sort + + ;; Adding the following functions yields many + ;; positives; evaluate how many of them are + ;; false first. + + ;;delq delete cl-delete + ;;nconc plist-put + ))) (byte-compile-warning-enabled-p 'ignored-return-value (car form))) (byte-compile-warn-x commit 4f0849a9e6d29e25d23e061bd81bacce9468856d Author: Mattias Engdegård Date: Sun Apr 9 15:27:28 2023 +0200 Remove unused values in effect context * lisp/net/eudcb-mab.el (eudc-mab-query-internal): * lisp/org/ob-core.el (org-babel-insert-result): * lisp/progmodes/prolog.el (prolog-smie-forward-token) (prolog-smie-backward-token): Silence ignored-return-value warnings about calls to side-effect-free functions in the last clause of `cond` statements whose values are unused. diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index 08fc20f438a..805c742d9e0 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -86,7 +86,8 @@ eudc-mab-query-internal ((eq (car term) 'email) (unless (string= (cdr term) mail) (setq matched nil))) - ((eq (car term) 'phone)))) + ;; ((eq (car term) 'phone)) + )) (when matched (setq result diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 3f6696fce77..e69ce4f1d12 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2426,7 +2426,8 @@ org-babel-insert-result (delete-region (point) (org-babel-result-end))) ((member "append" result-params) (goto-char (org-babel-result-end)) (setq beg (point-marker))) - ((member "prepend" result-params))) ; already there + ;; ((member "prepend" result-params)) ; already there + ) (setq results-switches (if results-switches (concat " " results-switches) "")) (let ((wrap diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 1b48fe9c3a8..66dea8803b3 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -828,7 +828,7 @@ prolog-smie-forward-token ((not (zerop (skip-chars-forward prolog-operator-chars)))) ((not (zerop (skip-syntax-forward "w_'")))) ;; In case of non-ASCII punctuation. - ((not (zerop (skip-syntax-forward "."))))) + (t (skip-syntax-forward "."))) (point)))) (defun prolog-smie-backward-token () @@ -842,7 +842,7 @@ prolog-smie-backward-token ((not (zerop (skip-chars-backward prolog-operator-chars)))) ((not (zerop (skip-syntax-backward "w_'")))) ;; In case of non-ASCII punctuation. - ((not (zerop (skip-syntax-backward "."))))) + (t (skip-syntax-backward "."))) (point)))) (defconst prolog-smie-grammar commit 48ff93ba18c8fae6c2904d40906cd0e13158b688 Author: Mattias Engdegård Date: Sun Apr 9 13:54:17 2023 +0200 Adjust side-effect-free declarations * lisp/emacs-lisp/byte-opt.el (side-effect-and-error-free-fns): Add `eql` here. * lisp/emacs-lisp/cl-macs.el (eql, cl-subst, cl-sublis): Don't set the `side-effect-free` property here. `cl-subst` and `cl-sublis` are not side-effect-free. * lisp/emacs-lisp/cl-extra.el (cl-revappend): Declare side-effect-free. * lisp/emacs-lisp/cl-lib.el (cl-copy-list): Declare side-effect-free and error-free. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 70317e2365d..dad3bd694a6 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1706,7 +1706,7 @@ byte-optimize-set charsetp commandp cons consp current-buffer current-global-map current-indentation current-local-map current-minor-mode-maps current-time - eobp eolp eq equal + eobp eolp eq equal eql floatp following-char framep hash-table-p identity indirect-function integerp integer-or-marker-p diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index e1c8ebe2559..a89bbc3a748 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -567,6 +567,7 @@ cl-concatenate ;;;###autoload (defun cl-revappend (x y) "Equivalent to (append (reverse X) Y)." + (declare (side-effect-free t)) (nconc (reverse x) y)) ;;;###autoload diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 95a51a4bdde..7fee780a735 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -459,6 +459,7 @@ cl-ldiff (defun cl-copy-list (list) "Return a copy of LIST, which may be a dotted list. The elements of LIST are not copied, just the list structure itself." + (declare (side-effect-free error-free)) (if (consp list) (let ((res nil)) (while (consp list) (push (pop list) res)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 8dc8b475a7f..41fc3b9f335 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3690,14 +3690,14 @@ cl--compiler-macro-get ;;; Things that are side-effect-free. (mapc (lambda (x) (function-put x 'side-effect-free t)) - '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd + '(cl-oddp cl-evenp cl-signum cl-ldiff cl-pairlis cl-gcd cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq cl-list-length cl-get cl-getf)) ;;; Things that are side-effect-and-error-free. (mapc (lambda (x) (function-put x 'side-effect-free 'error-free)) - '(eql cl-list* cl-subst cl-acons cl-equalp - cl-random-state-p copy-tree cl-sublis)) + '(cl-list* cl-acons cl-equalp + cl-random-state-p copy-tree)) ;;; Types and assertions. commit c9e13048bb9b1b5fb156fb128b32030ae2f1003b Author: Michael Albinus Date: Sun Apr 9 16:18:41 2023 +0200 Fix scoping error in Tramp * lisp/net/tramp-sshfs.el (tramp-sshfs-handle-insert-file-contents): Move result out of unwindform. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 6b788c00ba6..a4f6246ec23 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -244,8 +244,8 @@ tramp-sshfs-handle-insert-file-contents (setq result (insert-file-contents (tramp-fuse-local-file-name filename) visit beg end replace)) - (when visit (setq buffer-file-name filename)) - (cons filename (cdr result))))) + (when visit (setq buffer-file-name filename))) + (cons filename (cdr result)))) (defun tramp-sshfs-handle-process-file (program &optional infile destination display &rest args) commit 39a0b6cb027eb3f0349f4275ceed2ccca2cd14f4 Author: Mattias Engdegård Date: Sun Apr 9 10:57:43 2023 +0200 ; * test/src/fns-tests.el: Strengthen tests of `nreverse`. diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 6f79d3277a8..2859123da80 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -114,22 +114,24 @@ fns-tests-nreverse (should-error (nreverse 1)) (should-error (nreverse (make-char-table 'foo))) (should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx")) - (let ((A (vector))) - (nreverse A) - (should (equal A []))) - (let ((A (vector 0))) - (nreverse A) - (should (equal A [0]))) - (let ((A (vector 1 2 3 4))) - (nreverse A) - (should (equal A [4 3 2 1]))) - (let ((A (vector 1 2 3 4))) - (nreverse A) - (nreverse A) - (should (equal A [1 2 3 4]))) + (let* ((A (vector)) + (B (nreverse A))) + (should (equal A [])) + (should (eq B A))) + (let* ((A (vector 0)) + (B (nreverse A))) + (should (equal A [0])) + (should (eq B A))) (let* ((A (vector 1 2 3 4)) - (B (nreverse (nreverse A)))) - (should (equal A B)))) + (B (nreverse A))) + (should (equal A [4 3 2 1])) + (should (eq B A))) + (let* ((A (vector 1 2 3 4)) + (B (nreverse A)) + (C (nreverse A))) + (should (equal A [1 2 3 4])) + (should (eq B A)) + (should (eq C A)))) (ert-deftest fns-tests-reverse-bool-vector () (let ((A (make-bool-vector 10 nil))) @@ -140,9 +142,10 @@ fns-tests-reverse-bool-vector (ert-deftest fns-tests-nreverse-bool-vector () (let ((A (make-bool-vector 10 nil))) (dotimes (i 5) (aset A i t)) - (nreverse A) - (should (equal [nil nil nil nil nil t t t t t] (vconcat A))) - (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A)))))) + (let ((B (nreverse A))) + (should (eq B A)) + (should (equal [nil nil nil nil nil t t t t t] (vconcat A))) + (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))) (defconst fns-tests--string-lessp-cases `(("abc" < "abd") commit bb567e339a81c8b6d5bd24774c0da8c8402847de Author: Mattias Engdegård Date: Sun Apr 9 10:45:43 2023 +0200 * lisp/emacs-lisp/cl-extra.el (cl-parse-integer): side-effect-free. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index de5eb9c2d92..e1c8ebe2559 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -408,6 +408,7 @@ cl-parse-integer RADIX is an integer between 2 and 36, the default is 10. Signal an error if the substring between START and END cannot be parsed as an integer unless JUNK-ALLOWED is non-nil." + (declare (side-effect-free t)) (cl-check-type string string) (let* ((start (or start 0)) (len (length string))