commit 6de88b6b0261a549637270c0474998ac76eb65a9 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Aug 13 09:58:44 2022 +0300 Fix a recently-added Eshell test on MS-Windows * test/lisp/eshell/esh-var-tests.el (esh-var-test/last-result-var-ext-cmd): Fix the test on MS-Windows by making sure the internal 'format' command is invoked. (Bug#57129) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 66dabd424b..0c094ee5a7 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -561,10 +561,13 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "Test using the \"last result\" ($$) variable with an external command" (skip-unless (executable-find "[")) (with-temp-eshell - (eshell-command-result-p "[ foo = foo ]; format \"%s\" $$" - "t\n") - (eshell-command-result-p "[ foo = bar ]; format \"%s\" $$" - "nil\n"))) + ;; MS-DOS/MS-Windows have an external command 'format', which we + ;; don't want here. + (let ((eshell-prefer-lisp-functions t)) + (eshell-command-result-p "[ foo = foo ]; format \"%s\" $$" + "t\n") + (eshell-command-result-p "[ foo = bar ]; format \"%s\" $$" + "nil\n")))) (ert-deftest esh-var-test/last-result-var-split-indices () "Test using the \"last result\" ($$) variable with split indices" commit f3408af0a3251a744cb0b55b5e153565bfd57ea3 Author: Jim Porter Date: Tue Aug 9 20:09:57 2022 -0700 Make '$?' and '$$' variables more consistent in Eshell Previously, '$?' (last exit code) was only useful for external commands, and '$$' (last result) was only useful for Lisp commands. * lisp/eshell/esh-cmd.el (eshell-lisp-form-nil-is-failure): New option. (eshell-lisp-command): Set last exit code to 1 when the command signals an error, and 2 if it returns nil (for Lisp forms only). * lisp/eshell/esh-proc.el (eshell-sentinel): Set last result to t if the command succeeded. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/while-loop-lisp-form, esh-cmd-test/until-loop-lisp-form) (esh-cmd-test/if-else-statement-lisp-form) (esh-cmd-test/if-else-statement-lisp-form-2) (esh-cmd-test/unless-else-statement-lisp-form): New tests. * test/lisp/eshell/esh-var-tests.el (esh-var-test/last-status-var-lisp-command) (esh-var-test/last-status-var-lisp-form) (esh-var-test/last-status-var-lisp-form-2) (esh-var-test/last-status-var-ext-cmd) (esh-var-test/last-status-var-ext-cmd): New tests. (esh-var-test/last-result-var2): Rename from this... ( esh-var-test/last-result-var-twice): ... to this. * doc/misc/eshell.texi (Variables): Update documentation about '$?' and '$$'. (Control Flow): Mention that '(lisp forms)' can be used as conditionals. * etc/NEWS: Announce this change (bug#57129). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 141c30ae9b..aae779575d 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -890,14 +890,18 @@ command (excluding the command name itself). @vindex $$ @item $$ -This is the result of the last command. In case of an external -command, it is @code{t} or @code{nil}. +This is the result of the last command. For external commands, it is +@code{t} if the exit code was 0 or @code{nil} otherwise. +@vindex eshell-lisp-form-nil-is-failure @vindex $? @item $? This variable contains the exit code of the last command. If the last command was a Lisp function, it is 0 for successful completion or 1 -otherwise. +otherwise. If @code{eshell-lisp-form-nil-is-failure} is +non-@code{nil}, then a command with a Lisp form, like +@samp{(@var{command} @var{args}@dots{})}, that returns @code{nil} will +set this variable to 2. @vindex $COLUMNS @vindex $LINES @@ -1024,8 +1028,8 @@ Most of Eshell's control flow statements accept a @var{conditional}. This can take a few different forms. If @var{conditional} is a dollar expansion, the condition is satisfied if the result is a non-@code{nil} value. If @var{conditional} is a @samp{@{ -@var{subcommand} @}}, the condition is satisfied if the -@var{subcommand}'s exit status is 0. +@var{subcommand} @}} or @samp{(@var{lisp form})}, the condition is +satisfied if the command's exit status is 0. @table @code diff --git a/etc/NEWS b/etc/NEWS index be647f6bbb..f876916bb6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2162,6 +2162,13 @@ Additionally, globs ending with '**/' or '***/' no longer raise an error, and now expand to all directories recursively (following symlinks in the latter case). ++++ +*** Lisp forms in Eshell now treat a 'nil' result as a failed exit status. +When executing a command that looks like '(lisp form)', Eshell will +set the exit status (available in the '$?' variable) to 2. This +allows commands like that to be used as conditionals. To change this +behavior, customize the new 'eshell-lisp-form-nil-is-failure' option. + ** Shell --- diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 454a90e91d..62c95056fd 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -133,6 +133,10 @@ There are several different kinds of commands, however." Such arguments will be passed to `read', and then evaluated." :type 'regexp) +(defcustom eshell-lisp-form-nil-is-failure t + "If non-nil, Lisp forms like (COMMAND ARGS) treat a nil result as failure." + :type 'boolean) + (defcustom eshell-pre-command-hook nil "A hook run before each interactive command is invoked." :type 'hook) @@ -1412,43 +1416,53 @@ via `eshell-errorn'." (defun eshell-lisp-command (object &optional args) "Insert Lisp OBJECT, using ARGS if a function." (catch 'eshell-external ; deferred to an external command + (setq eshell-last-command-status 0 + eshell-last-arguments args) (let* ((eshell-ensure-newline-p (eshell-interactive-output-p)) + (command-form-p (functionp object)) (result - (if (functionp object) - (progn - (setq eshell-last-arguments args - eshell-last-command-name + (if command-form-p + (let ((numeric (not (get object + 'eshell-no-numeric-conversions))) + (fname-args (get object 'eshell-filename-arguments))) + (when (or numeric fname-args) + (while args + (let ((arg (car args))) + (cond + ((and numeric (stringp arg) (> (length arg) 0) + (text-property-any 0 (length arg) + 'number t arg)) + ;; If any of the arguments are flagged as + ;; numbers waiting for conversion, convert + ;; them now. + (setcar args (string-to-number arg))) + ((and fname-args (stringp arg) + (string-equal arg "~")) + ;; If any of the arguments match "~", + ;; prepend "./" to treat it as a regular + ;; file name. + (setcar args (concat "./" arg))))) + (setq args (cdr args)))) + (setq eshell-last-command-name (concat "#")) - (let ((numeric (not (get object - 'eshell-no-numeric-conversions))) - (fname-args (get object 'eshell-filename-arguments))) - (when (or numeric fname-args) - (while args - (let ((arg (car args))) - (cond ((and numeric (stringp arg) (> (length arg) 0) - (text-property-any 0 (length arg) - 'number t arg)) - ;; If any of the arguments are - ;; flagged as numbers waiting for - ;; conversion, convert them now. - (setcar args (string-to-number arg))) - ((and fname-args (stringp arg) - (string-equal arg "~")) - ;; If any of the arguments match "~", - ;; prepend "./" to treat it as a - ;; regular file name. - (setcar args (concat "./" arg))))) - (setq args (cdr args))))) (eshell-apply object eshell-last-arguments)) - (setq eshell-last-arguments args - eshell-last-command-name "#") + (setq eshell-last-command-name "#") (eshell-eval object)))) (if (and eshell-ensure-newline-p (save-excursion (goto-char eshell-last-output-end) (not (bolp)))) (eshell-print "\n")) - (eshell-close-handles 0 (list 'quote result))))) + (eshell-close-handles + ;; If `eshell-lisp-form-nil-is-failure' is non-nil, Lisp forms + ;; that succeeded but have a nil result should have an exit + ;; status of 2. + (when (and eshell-lisp-form-nil-is-failure + (not command-form-p) + (= eshell-last-command-status 0) + (not result)) + 2) + (list 'quote result))))) (defalias 'eshell-lisp-command* #'eshell-lisp-command) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 99b43661f2..c367b5cd64 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -346,7 +346,9 @@ Used only on systems which do not support async subprocesses.") (defvar eshell-last-output-end) ;Defined in esh-mode.el. (eshell-update-markers eshell-last-output-end) ;; Simulate the effect of eshell-sentinel. - (eshell-close-handles (if (numberp exit-status) exit-status -1)) + (eshell-close-handles + (if (numberp exit-status) exit-status -1) + (list 'quote (and (numberp exit-status) (= exit-status 0)))) (eshell-kill-process-function command exit-status) (or (bound-and-true-p eshell-in-pipeline-p) (setq eshell-last-sync-output-start nil)) @@ -398,40 +400,36 @@ PROC is the process that's exiting. STRING is the exit message." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (unwind-protect - (let ((entry (assq proc eshell-process-list))) -; (if (not entry) -; (error "Sentinel called for unowned process `%s'" -; (process-name proc)) - (when entry - (unwind-protect - (progn - (unless (string= string "run") - ;; Write the exit message if the status is - ;; abnormal and the process is already writing - ;; to the terminal. - (when (and (eq proc (eshell-tail-process)) - (not (string-match "^\\(finished\\|exited\\)" - string))) - (funcall (process-filter proc) proc string)) - (let ((handles (nth 1 entry)) - (str (prog1 (nth 3 entry) - (setf (nth 3 entry) nil))) - (status (process-exit-status proc))) - ;; If we're in the middle of handling output - ;; from this process then schedule the EOF for - ;; later. - (letrec ((finish-io - (lambda () - (if (nth 4 entry) - (run-at-time 0 nil finish-io) - (when str - (ignore-error 'eshell-pipe-broken - (eshell-output-object - str nil handles))) - (eshell-close-handles - status 'nil handles))))) - (funcall finish-io))))) - (eshell-remove-process-entry entry)))) + (when-let ((entry (assq proc eshell-process-list))) + (unwind-protect + (unless (string= string "run") + ;; Write the exit message if the status is + ;; abnormal and the process is already writing + ;; to the terminal. + (when (and (eq proc (eshell-tail-process)) + (not (string-match "^\\(finished\\|exited\\)" + string))) + (funcall (process-filter proc) proc string)) + (let ((handles (nth 1 entry)) + (str (prog1 (nth 3 entry) + (setf (nth 3 entry) nil))) + (status (process-exit-status proc))) + ;; If we're in the middle of handling output + ;; from this process then schedule the EOF for + ;; later. + (letrec ((finish-io + (lambda () + (if (nth 4 entry) + (run-at-time 0 nil finish-io) + (when str + (ignore-error 'eshell-pipe-broken + (eshell-output-object + str nil handles))) + (eshell-close-handles + status (list 'quote (= status 0)) + handles))))) + (funcall finish-io)))) + (eshell-remove-process-entry entry))) (eshell-kill-process-function proc string))))) (defun eshell-process-interact (func &optional all query) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index b31159a1a8..e86985ec71 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -139,6 +139,15 @@ e.g. \"{(+ 1 2)} 3\" => 3" "{ setq eshell-test-value (cdr eshell-test-value) }") "(1 2)\n(2)\n")))) +(ert-deftest esh-cmd-test/while-loop-lisp-form () + "Test invocation of a while loop using a Lisp form." + (with-temp-eshell + (let ((eshell-test-value 0)) + (eshell-command-result-p + (concat "while (/= eshell-test-value 3) " + "{ setq eshell-test-value (1+ eshell-test-value) }") + "1\n2\n3\n")))) + (ert-deftest esh-cmd-test/while-loop-ext-cmd () "Test invocation of a while loop using an external command." (skip-unless (executable-find "[")) @@ -158,6 +167,16 @@ e.g. \"{(+ 1 2)} 3\" => 3" "{ setq eshell-test-value t }") "t\n")))) +(ert-deftest esh-cmd-test/until-loop-lisp-form () + "Test invocation of an until loop using a Lisp form." + (skip-unless (executable-find "[")) + (with-temp-eshell + (let ((eshell-test-value 0)) + (eshell-command-result-p + (concat "until (= eshell-test-value 3) " + "{ setq eshell-test-value (1+ eshell-test-value) }") + "1\n2\n3\n")))) + (ert-deftest esh-cmd-test/until-loop-ext-cmd () "Test invocation of an until loop using an external command." (skip-unless (executable-find "[")) @@ -188,6 +207,30 @@ e.g. \"{(+ 1 2)} 3\" => 3" (eshell-command-result-p "if $eshell-test-value {echo yes} {echo no}" "no\n")))) +(ert-deftest esh-cmd-test/if-else-statement-lisp-form () + "Test invocation of an if/else statement using a Lisp form." + (with-temp-eshell + (eshell-command-result-p "if (zerop 0) {echo yes} {echo no}" + "yes\n") + (eshell-command-result-p "if (zerop 1) {echo yes} {echo no}" + "no\n") + (let ((debug-on-error nil)) + (eshell-command-result-p "if (zerop \"foo\") {echo yes} {echo no}" + "no\n")))) + +(ert-deftest esh-cmd-test/if-else-statement-lisp-form-2 () + "Test invocation of an if/else statement using a Lisp form. +This tests when `eshell-lisp-form-nil-is-failure' is nil." + (let ((eshell-lisp-form-nil-is-failure nil)) + (with-temp-eshell + (eshell-command-result-p "if (zerop 0) {echo yes} {echo no}" + "yes\n") + (eshell-command-result-p "if (zerop 1) {echo yes} {echo no}" + "yes\n") + (let ((debug-on-error nil)) + (eshell-command-result-p "if (zerop \"foo\") {echo yes} {echo no}" + "no\n"))))) + (ert-deftest esh-cmd-test/if-else-statement-ext-cmd () "Test invocation of an if/else statement using an external command." (skip-unless (executable-find "[")) @@ -217,6 +260,17 @@ e.g. \"{(+ 1 2)} 3\" => 3" (eshell-command-result-p "unless $eshell-test-value {echo no} {echo yes}" "no\n")))) +(ert-deftest esh-cmd-test/unless-else-statement-lisp-form () + "Test invocation of an unless/else statement using a Lisp form." + (with-temp-eshell + (eshell-command-result-p "unless (zerop 0) {echo no} {echo yes}" + "yes\n") + (eshell-command-result-p "unless (zerop 1) {echo no} {echo yes}" + "no\n") + (let ((debug-on-error nil)) + (eshell-command-result-p "unless (zerop \"foo\") {echo no} {echo yes}" + "no\n")))) + (ert-deftest esh-cmd-test/unless-else-statement-ext-cmd () "Test invocation of an unless/else statement using an external command." (skip-unless (executable-find "[")) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 54e701a6aa..66dabd424b 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -500,18 +500,72 @@ inside double-quotes" (eshell-command-result-p "echo $INSIDE_EMACS[, 1]" "eshell"))) +(ert-deftest esh-var-test/last-status-var-lisp-command () + "Test using the \"last exit status\" ($?) variable with a Lisp command" + (with-temp-eshell + (eshell-command-result-p "zerop 0; echo $?" + "t\n0\n") + (eshell-command-result-p "zerop 1; echo $?" + "0\n") + (let ((debug-on-error nil)) + (eshell-command-result-p "zerop foo; echo $?" + "1\n")))) + +(ert-deftest esh-var-test/last-status-var-lisp-form () + "Test using the \"last exit status\" ($?) variable with a Lisp form" + (let ((eshell-lisp-form-nil-is-failure t)) + (with-temp-eshell + (eshell-command-result-p "(zerop 0); echo $?" + "t\n0\n") + (eshell-command-result-p "(zerop 1); echo $?" + "2\n") + (let ((debug-on-error nil)) + (eshell-command-result-p "(zerop \"foo\"); echo $?" + "1\n"))))) + +(ert-deftest esh-var-test/last-status-var-lisp-form-2 () + "Test using the \"last exit status\" ($?) variable with a Lisp form. +This tests when `eshell-lisp-form-nil-is-failure' is nil." + (let ((eshell-lisp-form-nil-is-failure nil)) + (with-temp-eshell + (eshell-command-result-p "(zerop 0); echo $?" + "0\n") + (eshell-command-result-p "(zerop 0); echo $?" + "0\n") + (let ((debug-on-error nil)) + (eshell-command-result-p "(zerop \"foo\"); echo $?" + "1\n"))))) + +(ert-deftest esh-var-test/last-status-var-ext-cmd () + "Test using the \"last exit status\" ($?) variable with an external command" + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "[ foo = foo ]; echo $?" + "0\n") + (eshell-command-result-p "[ foo = bar ]; echo $?" + "1\n"))) + (ert-deftest esh-var-test/last-result-var () "Test using the \"last result\" ($$) variable" (with-temp-eshell (eshell-command-result-p "+ 1 2; + $$ 2" "3\n5\n"))) -(ert-deftest esh-var-test/last-result-var2 () +(ert-deftest esh-var-test/last-result-var-twice () "Test using the \"last result\" ($$) variable twice" (with-temp-eshell (eshell-command-result-p "+ 1 2; + $$ $$" "3\n6\n"))) +(ert-deftest esh-var-test/last-result-var-ext-cmd () + "Test using the \"last result\" ($$) variable with an external command" + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "[ foo = foo ]; format \"%s\" $$" + "t\n") + (eshell-command-result-p "[ foo = bar ]; format \"%s\" $$" + "nil\n"))) + (ert-deftest esh-var-test/last-result-var-split-indices () "Test using the \"last result\" ($$) variable with split indices" (with-temp-eshell commit 9d4fa4ed4b1f2b081e8ed14cbe16d9ec4b993988 Author: Jim Porter Date: Mon Aug 8 21:24:27 2022 -0700 Allow using dollar expansions in Eshell conditionals * lisp/eshell/esh-cmd.el (eshell-structure-basic-command): Forms beginning with 'eshell-escape-arg' are "data-wise". * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/while-loop) (esh-cmd-test/until-loop, esh-cmd-test/if-statement) (esh-cmd-test/if-else-statement, esh-cmd-test/unless-statement) (esh-cmd-test/unless-else-statement): Use variable interpolation. (esh-cmd-test/while-loop-ext-cmd, esh-cmd-test/until-loop-ext-cmd) (esh-cmd-test/if-else-statement-ext-cmd) (esh-cmd-test/unless-else-statement-ext-cmd): New tests, adapted from the existing ones. * doc/misc/eshell.texi (Control Flow): Update documentation for conditionals (bug#57129). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index d643cb5096..141c30ae9b 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1020,27 +1020,32 @@ Because Eshell commands can not (easily) be combined with lisp forms, Eshell provides command-oriented control flow statements for convenience. +Most of Eshell's control flow statements accept a @var{conditional}. +This can take a few different forms. If @var{conditional} is a dollar +expansion, the condition is satisfied if the result is a +non-@code{nil} value. If @var{conditional} is a @samp{@{ +@var{subcommand} @}}, the condition is satisfied if the +@var{subcommand}'s exit status is 0. + @table @code -@item if @{ @var{conditional} @} @{ @var{true-commands} @} -@itemx if @{ @var{conditional} @} @{ @var{true-commands} @} @{ @var{false-commands} @} -Evaluate @var{true-commands} if @var{conditional} returns success -(i.e.@: its exit code is zero); otherwise, evaluate -@var{false-commands}. - -@item unless @{ @var{conditional} @} @{ @var{false-commands} @} -@itemx unless @{ @var{conditional} @} @{ @var{false-commands} @} @{ @var{true-commands} @} -Evaluate @var{false-commands} if @var{conditional} returns failure -(i.e.@: its exit code is non-zero); otherwise, evaluate -@var{true-commands}. - -@item while @{ @var{conditional} @} @{ @var{commands} @} -Repeatedly evaluate @var{commands} so long as @var{conditional} -returns success. - -@item until @{ @var{conditional} @} @{ @var{commands} @} -Repeatedly evaluate @var{commands} so long as @var{conditional} -returns failure. +@item if @var{conditional} @{ @var{true-commands} @} +@itemx if @var{conditional} @{ @var{true-commands} @} @{ @var{false-commands} @} +Evaluate @var{true-commands} if @var{conditional} is satisfied; +otherwise, evaluate @var{false-commands}. + +@item unless @var{conditional} @{ @var{false-commands} @} +@itemx unless @var{conditional} @{ @var{false-commands} @} @{ @var{true-commands} @} +Evaluate @var{false-commands} if @var{conditional} is not satisfied; +otherwise, evaluate @var{true-commands}. + +@item while @var{conditional} @{ @var{commands} @} +Repeatedly evaluate @var{commands} so long as @var{conditional} is +satisfied. + +@item until @var{conditional} @{ @var{commands} @} +Repeatedly evaluate @var{commands} until @var{conditional} is +satisfied. @item for @var{var} in @var{list}@dots{} @{ @var{commands} @} Iterate over each element of of @var{list}, storing the element in diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 96272ca1a3..454a90e91d 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -549,10 +549,11 @@ implemented via rewriting, rather than as a function." The first of NAMES should be the positive form, and the second the negative. It's not likely that users should ever need to call this function." - ;; If the test form begins with `eshell-convert', it means - ;; something data-wise will be returned, and we should let - ;; that determine the truth of the statement. - (unless (eq (car test) 'eshell-convert) + ;; If the test form begins with `eshell-convert' or + ;; `eshell-escape-arg', it means something data-wise will be + ;; returned, and we should let that determine the truth of the + ;; statement. + (unless (memq (car test) '(eshell-convert eshell-escape-arg)) (setq test `(progn ,test (eshell-exit-success-p)))) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 1d5cd29d7c..b31159a1a8 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -132,6 +132,15 @@ e.g. \"{(+ 1 2)} 3\" => 3" (ert-deftest esh-cmd-test/while-loop () "Test invocation of a while loop." + (with-temp-eshell + (let ((eshell-test-value '(0 1 2))) + (eshell-command-result-p + (concat "while $eshell-test-value " + "{ setq eshell-test-value (cdr eshell-test-value) }") + "(1 2)\n(2)\n")))) + +(ert-deftest esh-cmd-test/while-loop-ext-cmd () + "Test invocation of a while loop using an external command." (skip-unless (executable-find "[")) (with-temp-eshell (let ((eshell-test-value 0)) @@ -142,6 +151,15 @@ e.g. \"{(+ 1 2)} 3\" => 3" (ert-deftest esh-cmd-test/until-loop () "Test invocation of an until loop." + (with-temp-eshell + (let ((eshell-test-value nil)) + (eshell-command-result-p + (concat "until $eshell-test-value " + "{ setq eshell-test-value t }") + "t\n")))) + +(ert-deftest esh-cmd-test/until-loop-ext-cmd () + "Test invocation of an until loop using an external command." (skip-unless (executable-find "[")) (with-temp-eshell (let ((eshell-test-value 0)) @@ -152,15 +170,26 @@ e.g. \"{(+ 1 2)} 3\" => 3" (ert-deftest esh-cmd-test/if-statement () "Test invocation of an if statement." - (skip-unless (executable-find "[")) (with-temp-eshell - (eshell-command-result-p "if {[ foo = foo ]} {echo yes}" - "yes\n") - (eshell-command-result-p "if {[ foo = bar ]} {echo yes}" - "\\`\\'"))) + (let ((eshell-test-value t)) + (eshell-command-result-p "if $eshell-test-value {echo yes}" + "yes\n")) + (let ((eshell-test-value nil)) + (eshell-command-result-p "if $eshell-test-value {echo yes}" + "\\`\\'")))) (ert-deftest esh-cmd-test/if-else-statement () "Test invocation of an if/else statement." + (with-temp-eshell + (let ((eshell-test-value t)) + (eshell-command-result-p "if $eshell-test-value {echo yes} {echo no}" + "yes\n")) + (let ((eshell-test-value nil)) + (eshell-command-result-p "if $eshell-test-value {echo yes} {echo no}" + "no\n")))) + +(ert-deftest esh-cmd-test/if-else-statement-ext-cmd () + "Test invocation of an if/else statement using an external command." (skip-unless (executable-find "[")) (with-temp-eshell (eshell-command-result-p "if {[ foo = foo ]} {echo yes} {echo no}" @@ -170,15 +199,26 @@ e.g. \"{(+ 1 2)} 3\" => 3" (ert-deftest esh-cmd-test/unless-statement () "Test invocation of an unless statement." - (skip-unless (executable-find "[")) (with-temp-eshell - (eshell-command-result-p "unless {[ foo = foo ]} {echo no}" - "\\`\\'") - (eshell-command-result-p "unless {[ foo = bar ]} {echo no}" - "no\n"))) + (let ((eshell-test-value t)) + (eshell-command-result-p "unless $eshell-test-value {echo no}" + "\\`\\'")) + (let ((eshell-test-value nil)) + (eshell-command-result-p "unless $eshell-test-value {echo no}" + "no\n")))) (ert-deftest esh-cmd-test/unless-else-statement () "Test invocation of an unless/else statement." + (with-temp-eshell + (let ((eshell-test-value t)) + (eshell-command-result-p "unless $eshell-test-value {echo no} {echo yes}" + "yes\n")) + (let ((eshell-test-value nil)) + (eshell-command-result-p "unless $eshell-test-value {echo no} {echo yes}" + "no\n")))) + +(ert-deftest esh-cmd-test/unless-else-statement-ext-cmd () + "Test invocation of an unless/else statement using an external command." (skip-unless (executable-find "[")) (with-temp-eshell (eshell-command-result-p "unless {[ foo = foo ]} {echo no} {echo yes}" commit 30320d9420b2850341e94fa1b10476344bfa9589 Author: Jim Porter Date: Sat Aug 6 13:37:28 2022 -0700 Only set Eshell execution result metavariables when non-nil This simplifies usage of 'eshell-close-handles' in several places and makes it work more like the docstring indicated it would. * lisp/eshell/esh-io.el (eshell-close-handles): Only store EXIT-CODE and RESULT if they're non-nil. Also, use 'dotimes' and 'dolist' to simplify the implementation. * lisp/eshell/em-alias.el (eshell-write-aliases-list): * lisp/eshell/esh-cmd.el (eshell-rewrite-for-command) (eshell-structure-basic-command): Adapt calls to 'eshell-close-handles'. * test/lisp/eshell/eshell-tests.el (eshell-test/simple-command-result) (eshell-test/lisp-command, eshell-test/lisp-command-with-quote) (eshell-test/for-loop, eshell-test/for-name-loop) (eshell-test/for-name-shadow-loop, eshell-test/lisp-command-args) (eshell-test/subcommand, eshell-test/subcommand-args) (eshell-test/subcommand-lisp): Move from here... * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/simple-command-result, esh-cmd-test/lisp-command) (esh-cmd-test/lisp-command-with-quote, esh-cmd-test/for-loop) (esh-cmd-test/for-name-loop, esh-cmd-test/for-name-shadow-loop) (esh-cmd-test/lisp-command-args, esh-cmd-test/subcommand) (esh-cmd-test/subcommand-args, esh-cmd-test/subcommand-lisp): ... to here. (esh-cmd-test/and-operator, esh-cmd-test/or-operator) (esh-cmd-test/for-loop-list, esh-cmd-test/for-loop-multiple-args) (esh-cmd-test/while-loop, esh-cmd-test/until-loop) (esh-cmd-test/if-statement, esh-cmd-test/if-else-statement) (esh-cmd-test/unless-statement, esh-cmd-test/unless-else-statement): New tests. * doc/misc/eshell.texi (Invocation): Explain '&&' and '||'. (for loop): Move from here... (Control Flow): ... to here, and add documentation for other control flow forms. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 9f9c88582f..d643cb5096 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -201,7 +201,7 @@ history and invoking commands in a script file. * Aliases:: * History:: * Completion:: -* for loop:: +* Control Flow:: * Scripts:: @end menu @@ -219,12 +219,18 @@ same name; if there is no match, it then tries to execute it as an external command. The semicolon (@code{;}) can be used to separate multiple command -invocations on a single line. A command invocation followed by an -ampersand (@code{&}) will be run in the background. Eshell has no job -control, so you can not suspend or background the current process, or -bring a background process into the foreground. That said, background -processes invoked from Eshell can be controlled the same way as any -other background process in Emacs. +invocations on a single line. You can also separate commands with +@code{&&} or @code{||}. When using @code{&&}, Eshell will execute the +second command only if the first succeeds (i.e.@: has an exit +status of 0); with @code{||}, Eshell will execute the second command +only if the first fails. + +A command invocation followed by an ampersand (@code{&}) will be run +in the background. Eshell has no job control, so you can not suspend +or background the current process, or bring a background process into +the foreground. That said, background processes invoked from Eshell +can be controlled the same way as any other background process in +Emacs. @node Arguments @section Arguments @@ -1008,19 +1014,41 @@ command for which this function provides completions; you can also name the function @code{pcomplete/MAJOR-MODE/COMMAND} to define completions for a specific major mode. -@node for loop -@section @code{for} loop +@node Control Flow +@section Control Flow Because Eshell commands can not (easily) be combined with lisp forms, -Eshell provides a command-oriented @command{for}-loop for convenience. -The syntax is as follows: +Eshell provides command-oriented control flow statements for +convenience. -@example -@code{for VAR in TOKENS @{ command invocation(s) @}} -@end example +@table @code + +@item if @{ @var{conditional} @} @{ @var{true-commands} @} +@itemx if @{ @var{conditional} @} @{ @var{true-commands} @} @{ @var{false-commands} @} +Evaluate @var{true-commands} if @var{conditional} returns success +(i.e.@: its exit code is zero); otherwise, evaluate +@var{false-commands}. + +@item unless @{ @var{conditional} @} @{ @var{false-commands} @} +@itemx unless @{ @var{conditional} @} @{ @var{false-commands} @} @{ @var{true-commands} @} +Evaluate @var{false-commands} if @var{conditional} returns failure +(i.e.@: its exit code is non-zero); otherwise, evaluate +@var{true-commands}. -where @samp{TOKENS} is a space-separated sequence of values of -@var{VAR} for each iteration. This can even be the output of a -command if @samp{TOKENS} is replaced with @samp{@{ command invocation @}}. +@item while @{ @var{conditional} @} @{ @var{commands} @} +Repeatedly evaluate @var{commands} so long as @var{conditional} +returns success. + +@item until @{ @var{conditional} @} @{ @var{commands} @} +Repeatedly evaluate @var{commands} so long as @var{conditional} +returns failure. + +@item for @var{var} in @var{list}@dots{} @{ @var{commands} @} +Iterate over each element of of @var{list}, storing the element in +@var{var} and evaluating @var{commands}. If @var{list} is not a list, +treat it as a list of one element. If you specify multiple +@var{lists}, this will iterate over each of them in turn. + +@end table @node Scripts @section Scripts diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index 5d3aaf7c81..9ad218d598 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -206,7 +206,7 @@ file named by `eshell-aliases-file'.") (let ((eshell-current-handles (eshell-create-handles eshell-aliases-file 'overwrite))) (eshell/alias) - (eshell-close-handles 0)))) + (eshell-close-handles 0 'nil)))) (defsubst eshell-lookup-alias (name) "Check whether NAME is aliased. Return the alias if there is one." diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 775e4c1057..96272ca1a3 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -541,9 +541,7 @@ implemented via rewriting, rather than as a function." ,(eshell-invokify-arg body t))) (setcar for-items (cadr for-items)) (setcdr for-items (cddr for-items))) - (eshell-close-handles - eshell-last-command-status - (list 'quote eshell-last-command-result)))))) + (eshell-close-handles))))) (defun eshell-structure-basic-command (func names keyword test body &optional else) @@ -574,9 +572,7 @@ function." `(let ((eshell-command-body '(nil)) (eshell-test-body '(nil))) (,func ,test ,body ,else) - (eshell-close-handles - eshell-last-command-status - (list 'quote eshell-last-command-result)))) + (eshell-close-handles))) (defun eshell-rewrite-while-command (terms) "Rewrite a `while' command into its equivalent Eshell command form. diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 68e52a2c9c..27703976f6 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -254,6 +254,30 @@ a nil value of mode defaults to `insert'." (setq idx (1+ idx)))) handles) +(defun eshell-close-handles (&optional exit-code result handles) + "Close all of the current HANDLES, taking refcounts into account. +If HANDLES is nil, use `eshell-current-handles'. + +EXIT-CODE is the process exit code (zero, if the command +completed successfully). If nil, then use the exit code already +set in `eshell-last-command-status'. + +RESULT is the quoted value of the last command. If nil, then use +the value already set in `eshell-last-command-result'." + (when exit-code + (setq eshell-last-command-status exit-code)) + (when result + (cl-assert (eq (car result) 'quote)) + (setq eshell-last-command-result (cadr result))) + (let ((handles (or handles eshell-current-handles))) + (dotimes (idx eshell-number-of-handles) + (when-let ((handle (aref handles idx))) + (setcdr handle (1- (cdr handle))) + (when (= (cdr handle) 0) + (dolist (target (ensure-list (car (aref handles idx)))) + (eshell-close-target target (= eshell-last-command-status 0))) + (setcar handle nil)))))) + (defun eshell-close-target (target status) "Close an output TARGET, passing STATUS as the result. STATUS should be non-nil on successful termination of the output." @@ -305,32 +329,6 @@ STATUS should be non-nil on successful termination of the output." ((consp target) (apply (car target) status (cdr target))))) -(defun eshell-close-handles (exit-code &optional result handles) - "Close all of the current handles, taking refcounts into account. -EXIT-CODE is the process exit code; mainly, it is zero, if the command -completed successfully. RESULT is the quoted value of the last -command. If nil, then the meta variables for keeping track of the -last execution result should not be changed." - (let ((idx 0)) - (cl-assert (or (not result) (eq (car result) 'quote))) - (setq eshell-last-command-status exit-code - eshell-last-command-result (cadr result)) - (while (< idx eshell-number-of-handles) - (let ((handles (or handles eshell-current-handles))) - (when (aref handles idx) - (setcdr (aref handles idx) - (1- (cdr (aref handles idx)))) - (when (= (cdr (aref handles idx)) 0) - (let ((target (car (aref handles idx)))) - (if (not (listp target)) - (eshell-close-target target (= exit-code 0)) - (while target - (eshell-close-target (car target) (= exit-code 0)) - (setq target (cdr target))))) - (setcar (aref handles idx) nil)))) - (setq idx (1+ idx))) - nil)) - (defun eshell-kill-append (string) "Call `kill-append' with STRING, if it is indeed a string." (if (stringp string) diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el new file mode 100644 index 0000000000..1d5cd29d7c --- /dev/null +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -0,0 +1,189 @@ +;;; esh-cmd-tests.el --- esh-cmd test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's command invocation. + +;;; Code: + +(require 'ert) +(require 'esh-mode) +(require 'eshell) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +(defvar eshell-test-value nil) + +;;; Tests: + + +;; Command invocation + +(ert-deftest esh-cmd-test/simple-command-result () + "Test invocation with a simple command." + (should (equal (eshell-test-command-result "+ 1 2") 3))) + +(ert-deftest esh-cmd-test/lisp-command () + "Test invocation with an elisp command." + (should (equal (eshell-test-command-result "(+ 1 2)") 3))) + +(ert-deftest esh-cmd-test/lisp-command-with-quote () + "Test invocation with an elisp command containing a quote." + (should (equal (eshell-test-command-result "(eq 'foo nil)") nil))) + +(ert-deftest esh-cmd-test/lisp-command-args () + "Test invocation with elisp and trailing args. +Test that trailing arguments outside the S-expression are +ignored. e.g. \"(+ 1 2) 3\" => 3" + (should (equal (eshell-test-command-result "(+ 1 2) 3") 3))) + +(ert-deftest esh-cmd-test/subcommand () + "Test invocation with a simple subcommand." + (should (equal (eshell-test-command-result "{+ 1 2}") 3))) + +(ert-deftest esh-cmd-test/subcommand-args () + "Test invocation with a subcommand and trailing args. +Test that trailing arguments outside the subcommand are ignored. +e.g. \"{+ 1 2} 3\" => 3" + (should (equal (eshell-test-command-result "{+ 1 2} 3") 3))) + +(ert-deftest esh-cmd-test/subcommand-lisp () + "Test invocation with an elisp subcommand and trailing args. +Test that trailing arguments outside the subcommand are ignored. +e.g. \"{(+ 1 2)} 3\" => 3" + (should (equal (eshell-test-command-result "{(+ 1 2)} 3") 3))) + + +;; Logical operators + +(ert-deftest esh-cmd-test/and-operator () + "Test logical && operator." + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "[ foo = foo ] && echo hi" + "hi\n") + (eshell-command-result-p "[ foo = bar ] && echo hi" + "\\`\\'"))) + +(ert-deftest esh-cmd-test/or-operator () + "Test logical || operator." + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "[ foo = foo ] || echo hi" + "\\`\\'") + (eshell-command-result-p "[ foo = bar ] || echo hi" + "hi\n"))) + + +;; Control flow statements + +(ert-deftest esh-cmd-test/for-loop () + "Test invocation of a for loop." + (with-temp-eshell + (eshell-command-result-p "for i in 5 { echo $i }" + "5\n"))) + +(ert-deftest esh-cmd-test/for-loop-list () + "Test invocation of a for loop iterating over a list." + (with-temp-eshell + (eshell-command-result-p "for i in (list 1 2 (list 3 4)) { echo $i }" + "1\n2\n(3 4)\n"))) + +(ert-deftest esh-cmd-test/for-loop-multiple-args () + "Test invocation of a for loop iterating over multiple arguments." + (with-temp-eshell + (eshell-command-result-p "for i in 1 2 (list 3 4) { echo $i }" + "1\n2\n3\n4\n"))) + +(ert-deftest esh-cmd-test/for-name-loop () ; bug#15231 + "Test invocation of a for loop using `name'." + (let ((process-environment (cons "name" process-environment))) + (should (equal (eshell-test-command-result + "for name in 3 { echo $name }") + 3)))) + +(ert-deftest esh-cmd-test/for-name-shadow-loop () ; bug#15372 + "Test invocation of a for loop using an env-var." + (let ((process-environment (cons "name=env-value" process-environment))) + (with-temp-eshell + (eshell-command-result-p + "echo $name; for name in 3 { echo $name }; echo $name" + "env-value\n3\nenv-value\n")))) + +(ert-deftest esh-cmd-test/while-loop () + "Test invocation of a while loop." + (skip-unless (executable-find "[")) + (with-temp-eshell + (let ((eshell-test-value 0)) + (eshell-command-result-p + (concat "while {[ $eshell-test-value -ne 3 ]} " + "{ setq eshell-test-value (1+ eshell-test-value) }") + "1\n2\n3\n")))) + +(ert-deftest esh-cmd-test/until-loop () + "Test invocation of an until loop." + (skip-unless (executable-find "[")) + (with-temp-eshell + (let ((eshell-test-value 0)) + (eshell-command-result-p + (concat "until {[ $eshell-test-value -eq 3 ]} " + "{ setq eshell-test-value (1+ eshell-test-value) }") + "1\n2\n3\n")))) + +(ert-deftest esh-cmd-test/if-statement () + "Test invocation of an if statement." + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "if {[ foo = foo ]} {echo yes}" + "yes\n") + (eshell-command-result-p "if {[ foo = bar ]} {echo yes}" + "\\`\\'"))) + +(ert-deftest esh-cmd-test/if-else-statement () + "Test invocation of an if/else statement." + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "if {[ foo = foo ]} {echo yes} {echo no}" + "yes\n") + (eshell-command-result-p "if {[ foo = bar ]} {echo yes} {echo no}" + "no\n"))) + +(ert-deftest esh-cmd-test/unless-statement () + "Test invocation of an unless statement." + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "unless {[ foo = foo ]} {echo no}" + "\\`\\'") + (eshell-command-result-p "unless {[ foo = bar ]} {echo no}" + "no\n"))) + +(ert-deftest esh-cmd-test/unless-else-statement () + "Test invocation of an unless/else statement." + (skip-unless (executable-find "[")) + (with-temp-eshell + (eshell-command-result-p "unless {[ foo = foo ]} {echo no} {echo yes}" + "yes\n") + (eshell-command-result-p "unless {[ foo = bar ]} {echo no} {echo yes}" + "no\n"))) + +;; esh-cmd-tests.el ends here diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 5dc1877548..8423500ea7 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -36,59 +36,6 @@ ;;; Tests: -(ert-deftest eshell-test/simple-command-result () - "Test `eshell-command-result' with a simple command." - (should (equal (eshell-test-command-result "+ 1 2") 3))) - -(ert-deftest eshell-test/lisp-command () - "Test `eshell-command-result' with an elisp command." - (should (equal (eshell-test-command-result "(+ 1 2)") 3))) - -(ert-deftest eshell-test/lisp-command-with-quote () - "Test `eshell-command-result' with an elisp command containing a quote." - (should (equal (eshell-test-command-result "(eq 'foo nil)") nil))) - -(ert-deftest eshell-test/for-loop () - "Test `eshell-command-result' with a for loop.." - (let ((process-environment (cons "foo" process-environment))) - (should (equal (eshell-test-command-result - "for foo in 5 { echo $foo }") 5)))) - -(ert-deftest eshell-test/for-name-loop () ;Bug#15231 - "Test `eshell-command-result' with a for loop using `name'." - (let ((process-environment (cons "name" process-environment))) - (should (equal (eshell-test-command-result - "for name in 3 { echo $name }") 3)))) - -(ert-deftest eshell-test/for-name-shadow-loop () ; bug#15372 - "Test `eshell-command-result' with a for loop using an env-var." - (let ((process-environment (cons "name=env-value" process-environment))) - (with-temp-eshell - (eshell-command-result-p "echo $name; for name in 3 { echo $name }; echo $name" - "env-value\n3\nenv-value\n")))) - -(ert-deftest eshell-test/lisp-command-args () - "Test `eshell-command-result' with elisp and trailing args. -Test that trailing arguments outside the S-expression are -ignored. e.g. \"(+ 1 2) 3\" => 3" - (should (equal (eshell-test-command-result "(+ 1 2) 3") 3))) - -(ert-deftest eshell-test/subcommand () - "Test `eshell-command-result' with a simple subcommand." - (should (equal (eshell-test-command-result "{+ 1 2}") 3))) - -(ert-deftest eshell-test/subcommand-args () - "Test `eshell-command-result' with a subcommand and trailing args. -Test that trailing arguments outside the subcommand are ignored. -e.g. \"{+ 1 2} 3\" => 3" - (should (equal (eshell-test-command-result "{+ 1 2} 3") 3))) - -(ert-deftest eshell-test/subcommand-lisp () - "Test `eshell-command-result' with an elisp subcommand and trailing args. -Test that trailing arguments outside the subcommand are ignored. -e.g. \"{(+ 1 2)} 3\" => 3" - (should (equal (eshell-test-command-result "{(+ 1 2)} 3") 3))) - (ert-deftest eshell-test/pipe-headproc () "Check that piping a non-process to a process command waits for the process" (skip-unless (executable-find "cat")) commit 2d4058b3ff8ecd52306e72e5d47f59d915c18850 Merge: 4e23ecb882 72fc7258bf Author: Stefan Kangas Date: Sat Aug 13 06:30:27 2022 +0200 Merge from origin/emacs-28 72fc7258bf Delete references to deleted library hilit19.el e746fc2e7b Delete stale comments from Lisp Intro manual 77613b9217 ; Delete redundant installation instructions from ebnf2ps.el commit 4e23ecb882698fef45f09128300435edcb54e3d7 Author: Po Lu Date: Sat Aug 13 10:36:54 2022 +0800 ; * src/xfns.c (Fx_set_mouse_absolute_pixel_position): Fix typo. diff --git a/src/xfns.c b/src/xfns.c index 144f64f6f6..6ed93ee42c 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6856,11 +6856,11 @@ The coordinates X and Y are interpreted in pixels relative to a position if (FRAME_DISPLAY_INFO (f)->supports_xi2 && deviceid != -1) { - x_catch_errors_for_lisp (FRAME_X_DISPLAY (f)); + x_catch_errors_for_lisp (FRAME_DISPLAY_INFO (f)); XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, FRAME_DISPLAY_INFO (f)->root_window, 0, 0, 0, 0, xval, yval); - x_uncatch_errors_for_lisp (FRAME_X_DISPLAY (f)); + x_uncatch_errors_for_lisp (FRAME_DISPLAY_INFO (f)); } else #endif commit e311d05ab100b5518b974ccaee148a35ae2dada0 Author: Po Lu Date: Sat Aug 13 10:35:08 2022 +0800 Improve MPX interaction with drag-and-drop * src/xfns.c (Fx_set_mouse_absolute_pixel_position): Use internal client pointer record. * src/xterm.c (x_dnd_cancel_dnd_early): New function. Only used on XI2 builds so far. (x_dnd_begin_drag_and_drop): Set the pointer device used for DND events. (xi_disable_devices): Cancel the drag-and-drop operation if that device is disabled. (x_send_scroll_bar_event): Update outdated comment. (handle_one_xevent): Only accept DND events from that device. (frame_set_mouse_pixel_position): Use internal client pointer record. diff --git a/src/xfns.c b/src/xfns.c index 2845ecca6a..144f64f6f6 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6851,17 +6851,16 @@ The coordinates X and Y are interpreted in pixels relative to a position #ifdef HAVE_XINPUT2 int deviceid; - if (FRAME_DISPLAY_INFO (f)->supports_xi2) + deviceid = FRAME_DISPLAY_INFO (f)->client_pointer_device; + + if (FRAME_DISPLAY_INFO (f)->supports_xi2 + && deviceid != -1) { - XGrabServer (FRAME_X_DISPLAY (f)); - if (XIGetClientPointer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - &deviceid)) - { - XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, - FRAME_DISPLAY_INFO (f)->root_window, - 0, 0, 0, 0, xval, yval); - } - XUngrabServer (FRAME_X_DISPLAY (f)); + x_catch_errors_for_lisp (FRAME_X_DISPLAY (f)); + XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, + FRAME_DISPLAY_INFO (f)->root_window, + 0, 0, 0, 0, xval, yval); + x_uncatch_errors_for_lisp (FRAME_X_DISPLAY (f)); } else #endif diff --git a/src/xterm.c b/src/xterm.c index 48f10269df..e48d6fd251 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1398,6 +1398,12 @@ static int x_dnd_last_tooltip_x, x_dnd_last_tooltip_y; /* Whether or not those values are actually known yet. */ static bool x_dnd_last_tooltip_valid; +#ifdef HAVE_XINPUT2 +/* The master pointer device being used for the drag-and-drop + operation. */ +static int x_dnd_pointer_device; +#endif + /* Structure describing a single window that can be the target of drag-and-drop operations. */ struct x_client_list_window @@ -4705,6 +4711,67 @@ x_restore_events_after_dnd (struct frame *f, XWindowAttributes *wa) dpyinfo->Xatom_XdndTypeList); } +#ifdef HAVE_XINPUT2 + +/* Cancel the current drag-and-drop operation, sending leave messages + to any relevant toplevels. This is called from the event loop when + an event is received telling Emacs to gracefully cancel the + drag-and-drop operation. */ + +static void +x_dnd_cancel_dnd_early (void) +{ + struct frame *f; + xm_drop_start_message dmsg; + + eassert (x_dnd_frame && x_dnd_in_progress); + + f = x_dnd_frame; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (x_dnd_frame, + x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = FRAME_DISPLAY_INFO (f)->last_user_time; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, x_dnd_motif_operations, + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = x_dnd_motif_atom; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, + FRAME_DISPLAY_INFO (f)->last_user_time); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_dnd_waiting_for_finish = false; + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + x_dnd_wheel_frame = NULL; + x_dnd_frame = NULL; + x_dnd_action = None; + x_dnd_action_symbol = Qnil; +} + +#endif + static void x_dnd_cleanup_drag_and_drop (void *frame) { @@ -12089,6 +12156,25 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_wheel_frame = NULL; x_dnd_init_type_lists = false; x_dnd_need_send_drop = false; + +#ifdef HAVE_XINPUT2 + + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + /* Only accept input from the last master pointer to have interacted + with Emacs. This prevents another pointer device getting our + idea of the button state messed up. */ + if (FRAME_DISPLAY_INFO (f)->client_pointer_device != -1) + x_dnd_pointer_device + = FRAME_DISPLAY_INFO (f)->client_pointer_device; + else + /* This returns Bool but cannot actually fail. */ + XIGetClientPointer (FRAME_X_DISPLAY (f), None, + &x_dnd_pointer_device); + } + +#endif + #ifdef HAVE_XKB x_dnd_keyboard_state = 0; @@ -12882,6 +12968,13 @@ xi_disable_devices (struct x_display_info *dpyinfo, { if (to_disable[j] == dpyinfo->devices[i].device_id) { + if (x_dnd_in_progress + /* If the drag-and-drop pointer device is being + disabled, then cancel the drag and drop + operation. */ + && to_disable[j] == x_dnd_pointer_device) + x_dnd_cancel_dnd_early (); + /* Free any scroll valuators that might be on this device. */ #ifdef HAVE_XINPUT2_1 @@ -14164,11 +14257,13 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, ev->window = FRAME_X_WINDOW (f); ev->format = 32; - /* A 32-bit X client on a 64-bit X server can pass a window pointer - as-is. A 64-bit client on a 32-bit X server is in trouble - because a pointer does not fit and would be truncated while - passing through the server. So use two slots and hope that X12 - will resolve such issues someday. */ + /* A 32-bit X client can pass a window pointer through the X server + as-is. + + A 64-bit client is in trouble because a pointer does not fit in + the 32 bits given for ClientMessage data and will be truncated by + Xlib. So use two slots and hope that X12 will resolve such + issues someday. */ ev->data.l[0] = iw >> 31 >> 1; ev->data.l[1] = sign_shift <= 0 ? iw : iw << sign_shift >> sign_shift; ev->data.l[2] = part; @@ -18465,6 +18560,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif if (x_dnd_in_progress + /* When _NET_WM_CLIENT_LIST stacking is being used, changes + in that property are watched for, and it's not necessary + to update the state in response to ordinary window + substructure events. */ + && !x_dnd_use_toplevels && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); @@ -20299,6 +20399,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, case CirculateNotify: if (x_dnd_in_progress + /* When _NET_WM_CLIENT_LIST stacking is being used, changes + in that property are watched for, and it's not necessary + to update the state in response to ordinary window + substructure events. */ + && !x_dnd_use_toplevels && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) x_dnd_update_state (dpyinfo, dpyinfo->last_user_time); goto OTHER; @@ -20987,6 +21092,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, `x-dnd-movement-function`. */ && (command_loop_level + minibuf_level <= x_dnd_recursion_depth) + && xev->deviceid == x_dnd_pointer_device && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { Window target, toplevel; @@ -21321,6 +21427,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (x_dnd_in_progress && (command_loop_level + minibuf_level <= x_dnd_recursion_depth) + && xev->deviceid == x_dnd_pointer_device && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { f = mouse_or_wdesc_frame (dpyinfo, xev->event); @@ -26005,27 +26112,25 @@ x_set_window_size (struct frame *f, bool change_gravity, void frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) { - block_input (); #ifdef HAVE_XINPUT2 int deviceid; - if (FRAME_DISPLAY_INFO (f)->supports_xi2) + deviceid = FRAME_DISPLAY_INFO (f)->client_pointer_device; + + if (FRAME_DISPLAY_INFO (f)->supports_xi2 + && deviceid != -1) { - if (XIGetClientPointer (FRAME_X_DISPLAY (f), - FRAME_X_WINDOW (f), - &deviceid)) - { - x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); - XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, - FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); - x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); - } + block_input (); + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); + XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, + FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); + x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); + unblock_input (); } else #endif XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); - unblock_input (); } /* Raise frame F. */ commit 37073492fdf382af2e642a4c80a9153891260374 Author: Stefan Kangas Date: Fri Aug 12 22:32:39 2022 +0200 ; * lisp/cedet/ede.el: Bump version header to match variable. diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index bcd572e21a..e6bfd0b1e8 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -4,7 +4,7 @@ ;; Author: Eric M. Ludlam ;; Keywords: project, make -;; Version: 1.2 +;; Version: 2.0 ;; This file is part of GNU Emacs. commit c4505fed538455a3637a293f10655d31c57ecff7 Author: Stefan Kangas Date: Fri Aug 12 22:22:17 2022 +0200 Hide local variable section in emacs-news-modes * lisp/textmodes/emacs-authors-mode.el (emacs-authors-mode--hide-local-variables): Move from here... * lisp/emacs-lisp/subr-x.el (emacs-etc--hide-local-variables): ...to here. * lisp/textmodes/emacs-authors-mode.el (subr-x): Require. (emacs-authors-mode): Use above renamed function. * lisp/textmodes/emacs-news-mode.el (subr-x): Require. (emacs-news--mode-common): Call 'emacs-etc--hide-local-variables' to hide local variables section. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 1cce97cdb1..bd7c3c82f9 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -467,6 +467,18 @@ be marked unmodified, effectively ignoring those changes." (equal ,hash (buffer-hash))) (restore-buffer-modified-p nil)))))))) +(defun emacs-etc--hide-local-variables () + "Hide local variables. +Used by `emacs-authors-mode' and `emacs-news-mode'." + (narrow-to-region (point-min) + (save-excursion + (goto-char (point-max)) + ;; Obfuscate to avoid this being interpreted + ;; as a local variable section itself. + (if (re-search-backward "^Local\sVariables:$" nil t) + (progn (forward-line -1) (point)) + (point-max))))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/textmodes/emacs-authors-mode.el b/lisp/textmodes/emacs-authors-mode.el index ffb713fd68..af78ab605e 100644 --- a/lisp/textmodes/emacs-authors-mode.el +++ b/lisp/textmodes/emacs-authors-mode.el @@ -27,6 +27,8 @@ ;;; Code: +(require 'subr-x) ; `emacs-etc--hide-local-variables' + (defgroup emacs-authors-mode nil "Display the \"etc/AUTHORS\" file from the Emacs distribution." :version "29.1" @@ -88,17 +90,6 @@ See also `emacs-authors-mode'." (,(rx bol (not space) (+ not-newline) eol) 0 'emacs-authors-default))) -(defun emacs-authors-mode--hide-local-variables () - "Hide local variables in \"etc/AUTHORS\". Used by `emacs-authors-mode'." - (narrow-to-region (point-min) - (save-excursion - (goto-char (point-min)) - ;; Obfuscate to avoid this being interpreted - ;; as a local variable section itself. - (if (re-search-forward "^Local\sVariables:$" nil t) - (progn (forward-line -1) (point)) - (point-max))))) - (defun emacs-authors-next-author (&optional arg) "Move point to the next author in \"etc/AUTHORS\". With a prefix arg ARG, move point that many authors forward." @@ -109,7 +100,7 @@ With a prefix arg ARG, move point that many authors forward." (forward-line 1)) (re-search-forward emacs-authors--author-re nil t arg)) (when (looking-at emacs-authors--author-re) - (forward-line -1)) + (forward-line -1)) (re-search-backward emacs-authors--author-re nil t (abs arg))) (goto-char (line-beginning-position))) @@ -139,7 +130,7 @@ Provides some basic font locking and not much else." '(emacs-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) (setq font-lock-multiline nil) (setq imenu-generic-expression emacs-authors-imenu-generic-expression) - (emacs-authors-mode--hide-local-variables)) + (emacs-etc--hide-local-variables)) (define-obsolete-face-alias 'etc-authors-default 'emacs-authors-default "29.1") (define-obsolete-face-alias 'etc-authors-author 'emacs-authors-author "29.1") diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 9afa7ead98..022e17c934 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -25,6 +25,7 @@ (eval-when-compile (require 'cl-lib)) (require 'outline) +(require 'subr-x) ; `emacs-etc--hide-local-variables' (defgroup emacs-news-mode nil "Major mode for editing and viewing the Emacs NEWS file." @@ -76,7 +77,8 @@ outline-minor-mode-cycle t outline-level (lambda () (length (match-string 2))) outline-minor-mode-highlight 'append) - (outline-minor-mode)) + (outline-minor-mode) + (emacs-etc--hide-local-variables)) ;;;###autoload (define-derived-mode emacs-news-mode text-mode "NEWS" commit 316d3111a3666237caf86808d53765c8c77a3f53 Author: Lars Ingebrigtsen Date: Fri Aug 12 20:22:26 2022 +0200 Don't update loaddefs.el timestamps uselessly in loaddefs-generate * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate): Don't re-write the loaddefs.el file when there's no reason to. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 0c9bc4832b..6cb5d00782 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -589,7 +589,8 @@ instead of just updating them with the new/changed autoloads." ;; We have some data, so generate the loaddef files. First ;; group per output file. (dolist (fdefs (seq-group-by #'car defs)) - (let ((loaddefs-file (car fdefs))) + (let ((loaddefs-file (car fdefs)) + hash) (with-temp-buffer (if (and updating (file-exists-p loaddefs-file)) (insert-file-contents loaddefs-file) @@ -599,6 +600,7 @@ instead of just updating them with the new/changed autoloads." (when extra-data (insert extra-data) (ensure-empty-lines 1))) + (setq hash (buffer-hash)) ;; Then group by source file (and sort alphabetically). (dolist (section (sort (seq-group-by #'cadr (cdr fdefs)) (lambda (e1 e2) @@ -635,9 +637,11 @@ instead of just updating them with the new/changed autoloads." (loaddefs-generate--print-form def)) (unless (bolp) (insert "\n"))))) - (write-region (point-min) (point-max) loaddefs-file nil 'silent) - (byte-compile-info (file-relative-name loaddefs-file lisp-directory) - t "GEN"))))))) + ;; Only write the file if we actually made a change. + (unless (equal (buffer-hash) hash) + (write-region (point-min) (point-max) loaddefs-file nil 'silent) + (byte-compile-info + (file-relative-name loaddefs-file lisp-directory) t "GEN")))))))) (defun loaddefs-generate--print-form (def) "Print DEF in a format that makes sense for version control." commit a2cf5646d4cb3a2444ba53eb5452509f3ad9c6f7 Author: Stefan Kangas Date: Fri Aug 12 18:33:34 2022 +0200 Support imenu in emacs-authors-mode * lisp/textmodes/emacs-authors-mode.el (emacs-authors-imenu-generic-expression): New variable. (emacs-authors-mode): Add imenu support. diff --git a/lisp/textmodes/emacs-authors-mode.el b/lisp/textmodes/emacs-authors-mode.el index c9ec0e8cf8..ffb713fd68 100644 --- a/lisp/textmodes/emacs-authors-mode.el +++ b/lisp/textmodes/emacs-authors-mode.el @@ -119,6 +119,12 @@ With a prefix arg ARG, move point that many authors backward." (interactive "p" emacs-authors-mode) (emacs-authors-next-author (- arg))) +(defvar emacs-authors-imenu-generic-expression + `((nil ,(rx bol (group (+ (not ":"))) ": " + (or "wrote" "co-wrote" "changed") + " ") + 1))) + (define-obsolete-variable-alias 'etc-authors-mode-map 'emacs-authors-mode-map "29.1") (defvar-keymap emacs-authors-mode-map :doc "Keymap for `emacs-authors-mode'." @@ -132,6 +138,7 @@ Provides some basic font locking and not much else." (setq-local font-lock-defaults '(emacs-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) (setq font-lock-multiline nil) + (setq imenu-generic-expression emacs-authors-imenu-generic-expression) (emacs-authors-mode--hide-local-variables)) (define-obsolete-face-alias 'etc-authors-default 'emacs-authors-default "29.1") commit 779d920c9a09f1c75067d092571f4172a8b5c570 Author: Stefan Kangas Date: Thu Aug 11 13:49:15 2022 +0200 Rename etc-authors-mode to emacs-authors-mode * emacs-authors-mode.el: Rename all symbols from 'etc-authors-*' to 'emacs-authors-*'. Make most old names into obsolete compat aliases. * admin/authors.el: (Bug#57105) * etc/AUTHORS: Use 'emacs-authors' instead of 'etc-authors'. diff --git a/admin/authors.el b/admin/authors.el index de43d91454..12fe25fa4e 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -1883,7 +1883,7 @@ list of their contributions.\n") (insert "\n ")) (insert " " file)) (insert "\n"))))) - (insert "\nLocal" " Variables:\nmode: etc-authors\ncoding: " + (insert "\nLocal" " Variables:\nmode: emacs-authors\ncoding: " (symbol-name authors-coding-system) "\nEnd:\n") (message "Generating buffer %s... done" buffer-name) (unless noninteractive diff --git a/etc/AUTHORS b/etc/AUTHORS index 4ad8a54130..f6349df5bc 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -6062,6 +6062,6 @@ Zoran Milojevic: changed avoid.el উৎসব রায়: changed quail/indian.el Local Variables: -mode: etc-authors +mode: emacs-authors coding: utf-8 End: diff --git a/lisp/textmodes/emacs-authors-mode.el b/lisp/textmodes/emacs-authors-mode.el index 7eabdd4c2b..c9ec0e8cf8 100644 --- a/lisp/textmodes/emacs-authors-mode.el +++ b/lisp/textmodes/emacs-authors-mode.el @@ -1,4 +1,4 @@ -;;; etc-authors-mode.el --- font-locking for etc/AUTHORS -*- lexical-binding: t -*- +;;; emacs-authors-mode.el --- font-locking for etc/AUTHORS -*- lexical-binding: t -*- ;; Copyright (C) 2021-2022 Free Software Foundation, Inc. @@ -27,65 +27,69 @@ ;;; Code: -(defgroup etc-authors-mode nil +(defgroup emacs-authors-mode nil "Display the \"etc/AUTHORS\" file from the Emacs distribution." - :version "28.1" + :version "29.1" :group 'internal) -(defface etc-authors-default '((t :inherit variable-pitch)) +(defface emacs-authors-default + '((t :inherit variable-pitch)) "Default face used to display the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") - -(defface etc-authors-author '((((class color) (min-colors 88) (background light)) - :foreground "midnight blue" - :weight bold :height 1.05 - :inherit variable-pitch) - (((class color) (min-colors 88) (background dark)) - :foreground "cyan" - :weight bold :height 1.05 - :inherit variable-pitch) - (((supports :weight bold) (supports :height 1.05)) - :weight bold :height 1.05 - :inherit variable-pitch) - (((supports :weight bold)) - :weight bold :inherit variable-pitch) - (t :inherit variable-pitch)) +See also `emacs-authors-mode'." + :version "29.1") + +(defface emacs-authors-author + '((((class color) (min-colors 88) (background light)) + :foreground "midnight blue" + :weight bold :height 1.05 + :inherit variable-pitch) + (((class color) (min-colors 88) (background dark)) + :foreground "cyan" + :weight bold :height 1.05 + :inherit variable-pitch) + (((supports :weight bold) (supports :height 1.05)) + :weight bold :height 1.05 + :inherit variable-pitch) + (((supports :weight bold)) + :weight bold :inherit variable-pitch) + (t :inherit variable-pitch)) "Face used for the author in the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") - -(defface etc-authors-descriptor '((((class color) (min-colors 88) (background light)) - :foreground "sienna" :inherit variable-pitch) - (((class color) (min-colors 88) (background dark)) - :foreground "peru" :inherit variable-pitch) - (t :inherit variable-pitch)) +See also `emacs-authors-mode'." + :version "29.1") + +(defface emacs-authors-descriptor + '((((class color) (min-colors 88) (background light)) + :foreground "sienna" :inherit variable-pitch) + (((class color) (min-colors 88) (background dark)) + :foreground "peru" :inherit variable-pitch) + (t :inherit variable-pitch)) "Face used for the description text in the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") +See also `emacs-authors-mode'." + :version "29.1") -(defface etc-authors-other-files '((t :inherit etc-authors-descriptor)) +(defface emacs-authors-other-files + '((t :inherit emacs-authors-descriptor)) "Face used for the \"other files\" text in the \"etc/AUTHORS\" file. -See also `etc-authors-mode'." - :version "28.1") +See also `emacs-authors-mode'." + :version "29.1") -(defconst etc-authors--author-re +(defconst emacs-authors--author-re (rx bol (group (not (any blank "\n")) (+? (not (any ":" "\n")))) ":") "Regexp matching an author in \"etc/AUTHORS\".") -(defvar etc-authors-mode-font-lock-keywords - `((,etc-authors--author-re - 1 'etc-authors-author) +(defvar emacs-authors-mode-font-lock-keywords + `((,emacs-authors--author-re + 1 'emacs-authors-author) (,(rx (or "wrote" (seq (? "and ") (or "co-wrote" "changed")))) - 0 'etc-authors-descriptor) + 0 'emacs-authors-descriptor) (,(rx "and " (+ digit) " other files") - 0 'etc-authors-other-files) + 0 'emacs-authors-other-files) (,(rx bol (not space) (+ not-newline) eol) - 0 'etc-authors-default))) + 0 'emacs-authors-default))) -(defun etc-authors-mode--hide-local-variables () - "Hide local variables in \"etc/AUTHORS\". Used by `etc-authors-mode'." +(defun emacs-authors-mode--hide-local-variables () + "Hide local variables in \"etc/AUTHORS\". Used by `emacs-authors-mode'." (narrow-to-region (point-min) (save-excursion (goto-char (point-min)) @@ -95,39 +99,49 @@ See also `etc-authors-mode'." (progn (forward-line -1) (point)) (point-max))))) -(defun etc-authors-next-author (&optional arg) +(defun emacs-authors-next-author (&optional arg) "Move point to the next author in \"etc/AUTHORS\". With a prefix arg ARG, move point that many authors forward." - (interactive "p" etc-authors-mode) + (interactive "p" emacs-authors-mode) (if (< 0 arg) (progn - (when (looking-at etc-authors--author-re) + (when (looking-at emacs-authors--author-re) (forward-line 1)) - (re-search-forward etc-authors--author-re nil t arg)) - (when (looking-at etc-authors--author-re) + (re-search-forward emacs-authors--author-re nil t arg)) + (when (looking-at emacs-authors--author-re) (forward-line -1)) - (re-search-backward etc-authors--author-re nil t (abs arg))) + (re-search-backward emacs-authors--author-re nil t (abs arg))) (goto-char (line-beginning-position))) -(defun etc-authors-prev-author (&optional arg) +(defun emacs-authors-prev-author (&optional arg) "Move point to the previous author in \"etc/AUTHORS\". With a prefix arg ARG, move point that many authors backward." - (interactive "p" etc-authors-mode) - (etc-authors-next-author (- arg))) + (interactive "p" emacs-authors-mode) + (emacs-authors-next-author (- arg))) -(defvar-keymap etc-authors-mode-map - :doc "Keymap for `etc-authors-mode'." - "n" #'etc-authors-next-author - "p" #'etc-authors-prev-author) +(define-obsolete-variable-alias 'etc-authors-mode-map 'emacs-authors-mode-map "29.1") +(defvar-keymap emacs-authors-mode-map + :doc "Keymap for `emacs-authors-mode'." + "n" #'emacs-authors-next-author + "p" #'emacs-authors-prev-author) ;;;###autoload -(define-derived-mode etc-authors-mode special-mode "Authors View" +(define-derived-mode emacs-authors-mode special-mode "Authors View" "Major mode for viewing \"etc/AUTHORS\" from the Emacs distribution. Provides some basic font locking and not much else." (setq-local font-lock-defaults - '(etc-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) + '(emacs-authors-mode-font-lock-keywords nil nil ((?_ . "w")))) (setq font-lock-multiline nil) - (etc-authors-mode--hide-local-variables)) + (emacs-authors-mode--hide-local-variables)) + +(define-obsolete-face-alias 'etc-authors-default 'emacs-authors-default "29.1") +(define-obsolete-face-alias 'etc-authors-author 'emacs-authors-author "29.1") +(define-obsolete-face-alias 'etc-authors-descriptor 'emacs-authors-descriptor "29.1") +(define-obsolete-face-alias 'etc-authors-other-files 'emacs-authors-other-files "29.1") +(define-obsolete-function-alias 'etc-authors-next-author #'emacs-authors-next-author "29.1") +(define-obsolete-function-alias 'etc-authors-prev-author #'emacs-authors-prev-author "29.1") +;;;###autoload +(define-obsolete-function-alias 'etc-authors-mode #'emacs-authors-mode "29.1") -(provide 'etc-authors-mode) -;;; etc-authors-mode.el ends here +(provide 'emacs-authors-mode) +;;; emacs-authors-mode.el ends here commit 4ab16226e0a1d9049a79109b26d4e4af2fb56da7 Author: Stefan Kangas Date: Thu Aug 11 13:36:33 2022 +0200 Rename etc-authors-mode.el to emacs-authors-mode.el * lisp/textmodes/etc-authors-mode.el: Move from here... * lisp/textmodes/emacs-authors-mode.el: ...to here. (Bug#57105) diff --git a/lisp/textmodes/etc-authors-mode.el b/lisp/textmodes/emacs-authors-mode.el similarity index 100% rename from lisp/textmodes/etc-authors-mode.el rename to lisp/textmodes/emacs-authors-mode.el commit 28cb8bccce42355d3958bfcb69caed73d4b86d86 Author: Stefan Kangas Date: Fri Aug 12 18:09:22 2022 +0200 ; etc/PROBLEMS: Move Ubuntu 8.04 entry to legacy systems. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 98c8d0c302..6624f747c8 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -3435,14 +3435,6 @@ The fix is to install a newer version of ncurses, such as version 4.2. Bootstrapping (compiling the .el files) is normally only necessary with development builds, since the .elc files are pre-compiled in releases. -*** "No rule to make target" with Ubuntu 8.04 make 3.81-3build1 - -Compiling the lisp files fails at random places, complaining: -"No rule to make target '/path/to/some/lisp.elc'". -The causes of this problem are not understood. Using GNU make 3.81 compiled -from source, rather than the Ubuntu version, worked. -See , . - ** Dumping *** Segfault during 'make' @@ -3567,6 +3559,15 @@ This section covers bugs reported on very old hardware or software. If you are using hardware and an operating system shipped after 2000, it is unlikely you will see any of these. +** GNU/Linux + +*** Ubuntu 8.04 make 3.81-3build1: "No rule to make target" +Compiling the lisp files fails at random places, complaining: +"No rule to make target '/path/to/some/lisp.elc'". +The causes of this problem are not understood. Using GNU make 3.81 compiled +from source, rather than the Ubuntu version, worked. +See , . + ** Solaris *** Problem with remote X server on Suns. commit 72fc7258bf328b48bb032f607778ce81316276d4 (refs/remotes/origin/emacs-28) Author: Stefan Kangas Date: Fri Aug 12 17:48:30 2022 +0200 Delete references to deleted library hilit19.el * doc/misc/gnus.texi (Compatibility): * lisp/progmodes/f90.el: * lisp/ps-print.el: * lisp/vc/ediff.el: Delete references to hilit19.el. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index d608f3113f..9f7403ae8f 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -27021,16 +27021,6 @@ maintains a hash table that points to the entries in this alist (which speeds up many functions), and changing the alist directly will lead to peculiar results. -@cindex hilit19 -@cindex highlighting -Old hilit19 code does not work at all. In fact, you should probably -remove all hilit code from all Gnus hooks -(@code{gnus-group-prepare-hook} and @code{gnus-summary-prepare-hook}). -Gnus provides various integrated functions for highlighting. These are -faster and more accurate. To make life easier for everybody, Gnus will -by default remove all hilit calls from all hilit hooks. Uncleanliness! -Away! - Packages like @code{expire-kill} will no longer work. As a matter of fact, you should probably remove all old @sc{gnus} packages (and other code) when you start using Gnus. More likely than not, Gnus already diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 526865e6f6..197ec7f2e2 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -116,12 +116,11 @@ ;; non-nil, the line numbers are never touched. ;; 2) Multi-; statements like "do i=1,20 ; j=j+i ; end do" are not handled ;; correctly, but I imagine them to be rare. -;; 3) Regexps for hilit19 are no longer supported. -;; 4) For FIXED FORMAT code, use fortran mode. -;; 5) Preprocessor directives, i.e., lines starting with # are left-justified +;; 3) For FIXED FORMAT code, use fortran mode. +;; 4) Preprocessor directives, i.e., lines starting with # are left-justified ;; and are untouched by all case-changing commands. There is, at present, no ;; mechanism for treating multi-line directives (continued by \ ). -;; 6) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. +;; 5) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. ;; You are urged to use f90-do loops (with labels if you wish). ;; List of user commands diff --git a/lisp/ps-print.el b/lisp/ps-print.el index af366066f7..58b701e22c 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1320,11 +1320,11 @@ Please send all bug fixes and enhancements to ;; Known bugs and limitations of ps-print ;; -------------------------------------- ;; -;; Automatic font-attribute detection doesn't work well, especially with -;; hilit19 and older versions of get-create-face. Users having problems with -;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces' -;; and `ps-underlined-faces' and/or turn off automatic detection by setting -;; `ps-auto-font-detect' to nil. +;; Automatic font-attribute detection doesn't work well. Users having +;; problems with auto-font detection should use the lists +;; `ps-italic-faces', `ps-bold-faces' and `ps-underlined-faces' and/or +;; turn off automatic detection by setting `ps-auto-font-detect' to +;; nil. ;; ;; Still too slow; could use some hand-optimization. ;; diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 7841c25603..63369462e8 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -89,12 +89,11 @@ ;; underlining. However, if the region is already underlined by some other ;; overlays, there is no simple way to temporarily remove that residual ;; underlining. This problem occurs when a buffer is highlighted with -;; hilit19.el or font-lock.el packages. If this residual highlighting gets -;; in the way, you can do the following. Both font-lock.el and hilit19.el -;; provide commands for unhighlighting buffers. You can either place these -;; commands in `ediff-prepare-buffer-hook' (which will unhighlight every -;; buffer used by Ediff) or you can execute them interactively, at any time -;; and on any buffer. +;; font-lock.el packages. If this residual highlighting gets in the way, you +;; can do the following. font-lock.el provides commands for unhighlighting +;; buffers. You can either place these commands in `ediff-prepare-buffer-hook' +;; (which will unhighlight every buffer used by Ediff) or you can execute +;; them interactively, at any time and in any buffer. ;;; Acknowledgments: commit f99219a533203a46b2395d6b6021763b1542afd6 Author: Lars Ingebrigtsen Date: Fri Aug 12 17:44:51 2022 +0200 Fix emacs-news-view-mode-map inheritance * lisp/textmodes/emacs-news-mode.el (emacs-news-view-mode-map): Fix inheritance from `special-mode-map' (bug#57100). diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index e6e1f03728..9afa7ead98 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -59,9 +59,12 @@ "C-x C-q" #'emacs-news-view-mode " " #'emacs-news-open-line) -(defvar-keymap emacs-news-view-mode-map - :parent emacs-news-common-map - "C-x C-q" #'emacs-news-mode) +(defvar emacs-news-view-mode-map + ;; This is defined this way instead of inheriting because we're + ;; deriving the mode from `special-mode' and want the keys from there. + (let ((map (copy-keymap emacs-news-common-map))) + (keymap-set map "C-x C-q" #'emacs-news-mode) + map)) (defvar emacs-news-mode-font-lock-keywords `(("^---$" 0 'emacs-news-does-not-need-documentation) commit 59af89c2a233668b993eaa5186f3a04444d0fd83 Author: Lars Ingebrigtsen Date: Fri Aug 12 17:24:38 2022 +0200 Clarify bookmark-set prompt * lisp/bookmark.el (bookmark-set): Clarify prompt further (bug#57128). diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 30a03e0431..d0893e932b 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -966,7 +966,7 @@ it removes only the first instance of a bookmark with that name from the list of bookmarks.)" (interactive (list nil current-prefix-arg)) (let ((prompt - (if no-overwrite "Append bookmark named" "Set bookmark named"))) + (if no-overwrite "Add bookmark named" "Set bookmark named"))) (bookmark-set-internal prompt name (if no-overwrite 'push 'overwrite)))) ;;;###autoload commit 16ec99702c9a785e9c3cbded60b2b920b01d488b Author: Harald Jörg Date: Fri Aug 12 17:15:19 2022 +0200 gud.el: invoke 'perldb' with '-E' instead of '-e' * lisp/progmodes/gud.el (gud-perldb-massage-args): Allow '-E' switch and use it as a default in favor of '-e' * etc/NEWS ('perldb' now recognizes '-E') New entry in section 'Gud' diff --git a/etc/NEWS b/etc/NEWS index 2747cec18c..be647f6bbb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1250,6 +1250,12 @@ be used as a file-local variable. If given a prefix, it will query the user for an argument to use for the run/continue command. +--- +*** 'perldb' now recognizes '-E' +As of Perl 5.10, 'perl -E 0' behaves like 'perl -e 0' but also activates +all optional features of the Perl version in use. 'perldb' now uses +this invocation as its default. + ** Customize --- diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be43effed7..ccc5720575 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1577,16 +1577,17 @@ into one that invokes an Emacs-enabled debugging session. (seen-e nil) (shift (lambda () (push (pop args) new-args)))) - ;; Pass all switches and -e scripts through. + ;; Pass all switches and -E/-e scripts through. (while (and args (string-match "^-" (car args)) (not (equal "-" (car args))) (not (equal "--" (car args)))) - (when (equal "-e" (car args)) + (when (or (equal "-E" (car args)) (equal "-e" (car args))) ;; -e goes with the next arg, so shift one extra. - (or (funcall shift) - ;; -e as the last arg is an error in Perl. - (error "No code specified for -e")) + (funcall shift) + (or args + ;; -E (or -e) as the last arg is an error in Perl. + (error "No code specified for %s" (car new-args))) (setq seen-e t)) (funcall shift)) @@ -1697,7 +1698,7 @@ The directory containing the perl program becomes the initial working directory and source-file directory for your debugger." (interactive (list (gud-query-cmdline 'perldb - (concat (or (buffer-file-name) "-e 0") " ")))) + (concat (or (buffer-file-name) "-E 0") " ")))) (gud-common-init command-line 'gud-perldb-massage-args 'gud-perldb-marker-filter) commit e0045ba2bce11bb4cf93210c8ff1588b0893b74b Author: Lars Ingebrigtsen Date: Fri Aug 12 17:10:27 2022 +0200 Remove some more outdated Gnus manual stuff * doc/misc/gnus.texi (Mail Source Customization): Remove more outdated text (bug#57156). diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index bba2a18eab..f84ae8bb74 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -15438,8 +15438,6 @@ files. If a positive number, delete files older than number of days (the deletion will only happen when receiving new mail). You may also set @code{mail-source-delete-incoming} to @code{nil} and call @code{mail-source-delete-old-incoming} from a hook or interactively. -@code{mail-source-delete-incoming} defaults to @code{10} in alpha Gnusae -and @code{2} in released Gnusae. @item mail-source-delete-old-incoming-confirm @vindex mail-source-delete-old-incoming-confirm commit 9ef988c0e03751c30cc94e66af980e6c2adc28a4 Author: Lars Ingebrigtsen Date: Fri Aug 12 17:09:25 2022 +0200 Remove (gnus) Gnus Development manual section * doc/misc/gnus.texi (Gnus Development): Remove outdated section (bug#57156). diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a3dd6f2392..bba2a18eab 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -885,7 +885,6 @@ History * Why?:: What's the point of Gnus? * Compatibility:: Just how compatible is Gnus with @sc{gnus}? * Conformity:: Gnus tries to conform to all standards. -* Gnus Development:: How Gnus is developed. * Contributors:: Oodles of people. * New Features:: Pointers to some of the new stuff in Gnus. @@ -15440,7 +15439,7 @@ files. If a positive number, delete files older than number of days set @code{mail-source-delete-incoming} to @code{nil} and call @code{mail-source-delete-old-incoming} from a hook or interactively. @code{mail-source-delete-incoming} defaults to @code{10} in alpha Gnusae -and @code{2} in released Gnusae. @xref{Gnus Development}. +and @code{2} in released Gnusae. @item mail-source-delete-old-incoming-confirm @vindex mail-source-delete-old-incoming-confirm @@ -26918,7 +26917,6 @@ renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. * Why?:: What's the point of Gnus? * Compatibility:: Just how compatible is Gnus with @sc{gnus}? * Conformity:: Gnus tries to conform to all standards. -* Gnus Development:: How Gnus is developed. * Contributors:: Oodles of people. * New Features:: Pointers to some of the new stuff in Gnus. @end menu @@ -27145,56 +27143,6 @@ mentioned above, don't hesitate to drop a note to Gnus Towers and let us know. -@node Gnus Development -@subsection Gnus Development - -Gnus is developed in a two-phased cycle. The first phase involves much -discussion on the development mailing list @samp{ding@@gnus.org}, where people -propose changes and new features, post patches and new back ends. This -phase is called the @dfn{alpha} phase, since the Gnusae released in this -phase are @dfn{alpha releases}, or (perhaps more commonly in other -circles) @dfn{snapshots}. During this phase, Gnus is assumed to be -unstable and should not be used by casual users. Gnus alpha releases -have names like ``Oort Gnus'' and ``No Gnus''. @xref{Gnus Versions}. - -After futzing around for 10--100 alpha releases, Gnus is declared -@dfn{frozen}, and only bug fixes are applied. Gnus loses the prefix, -and is called things like ``Gnus 5.10.1'' instead. Normal people are -supposed to be able to use these, and these are mostly discussed on the -@samp{gnu.emacs.gnus} newsgroup. This newgroup is mirrored to the -mailing list @samp{info-gnus-english@@gnu.org} which is carried on Gmane -as @samp{gmane.emacs.gnus.user}. These releases are finally integrated -in Emacs. - -@cindex Incoming* -@vindex mail-source-delete-incoming -Some variable defaults differ between alpha Gnusae and released Gnusae, -in particular, @code{mail-source-delete-incoming}. This is to prevent -lossage of mail if an alpha release hiccups while handling the mail. -@xref{Mail Source Customization}. - -The division of discussion between the ding mailing list and the Gnus -newsgroup is not purely based on publicity concerns. It's true that -having people write about the horrible things that an alpha Gnus release -can do (sometimes) in a public forum may scare people off, but more -importantly, talking about new experimental features that have been -introduced may confuse casual users. New features are frequently -introduced, fiddled with, and judged to be found wanting, and then -either discarded or totally rewritten. People reading the mailing list -usually keep up with these rapid changes, while people on the newsgroup -can't be assumed to do so. - -So if you have problems with or questions about the alpha versions, -direct those to the ding mailing list @samp{ding@@gnus.org}. This list -is also available on Gmane as @samp{gmane.emacs.gnus.general}. - -@cindex Incoming* -@vindex mail-source-delete-incoming -Some variable defaults differ between alpha Gnusae and released Gnusae, -in particular, @code{mail-source-delete-incoming}. This is to prevent -lossage of mail if an alpha release hiccups while handling the mail. -@xref{Mail Source Customization}. - @node Contributors @subsection Contributors @cindex contributors commit 23e4e811932b11295f15d477cd7a328039aa902f Author: Stefan Kangas Date: Fri Aug 12 16:06:43 2022 +0200 * doc/misc/gnus.texi (Emacsen): Delete section. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 7da90dfb1d..a3dd6f2392 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -885,7 +885,6 @@ History * Why?:: What's the point of Gnus? * Compatibility:: Just how compatible is Gnus with @sc{gnus}? * Conformity:: Gnus tries to conform to all standards. -* Emacsen:: Gnus can be run on a few modern Emacsen. * Gnus Development:: How Gnus is developed. * Contributors:: Oodles of people. * New Features:: Pointers to some of the new stuff in Gnus. @@ -26919,7 +26918,6 @@ renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. * Why?:: What's the point of Gnus? * Compatibility:: Just how compatible is Gnus with @sc{gnus}? * Conformity:: Gnus tries to conform to all standards. -* Emacsen:: Gnus can be run on a few modern Emacsen. * Gnus Development:: How Gnus is developed. * Contributors:: Oodles of people. * New Features:: Pointers to some of the new stuff in Gnus. @@ -27147,29 +27145,6 @@ mentioned above, don't hesitate to drop a note to Gnus Towers and let us know. -@node Emacsen -@subsection Emacsen -@cindex Emacsen -@cindex Mule -@cindex Emacs - -This version of Gnus should work on: - -@itemize @bullet - -@item -Emacs 23.1 and up. - -@end itemize - -This Gnus version will absolutely not work on any Emacsen older than -that. Not reliably, at least. Older versions of Gnus may work on older -Emacs versions. Particularly, Gnus 5.10.8 should also work on Emacs -20.7. - -@c No-merge comment: The paragraph added in v5-10 here must not be -@c synced here! - @node Gnus Development @subsection Gnus Development commit fdbdbc2e1bb7bc54c7c747c8520f7cc6b6baf721 Author: Stefan Kangas Date: Fri Aug 12 15:35:18 2022 +0200 Make some more cedet version variables obsolete * lisp/cedet/ede.el (ede-version): * lisp/cedet/semantic.el (semantic-version): * lisp/cedet/srecode.el (srecode-version): Make obsolete. * lisp/cedet/semantic/db-file.el (semanticdb-file-version): Don't use above obsolete variable semantic-version. diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 4ea14e33c5..bcd572e21a 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1,6 +1,6 @@ ;;; ede.el --- Emacs Development Environment gloss -*- lexical-binding: t; -*- -;; Copyright (C) 1998-2005, 2007-2022 Free Software Foundation, Inc. +;; Copyright (C) 1998-2022 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: project, make @@ -39,6 +39,8 @@ ;; ;; (global-ede-mode t) +;;; Code: + (require 'cedet) (require 'cl-lib) (require 'eieio) @@ -66,10 +68,11 @@ (defconst ede-version "2.0" "Current version of the Emacs EDE.") +(make-obsolete-variable 'ede-version 'emacs-version "29.1") -;;; Code: (defun ede-version () "Display the current running version of EDE." + (declare (obsolete emacs-version "29.1")) (interactive) (message "EDE %s" ede-version)) (defgroup ede nil diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 78002dd8ab..3166279de4 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -34,6 +34,8 @@ ;; menu). To enable it at startup, put (semantic-mode 1) in your init ;; file. +;;; Code: + (require 'cedet) (require 'semantic/tag) (require 'semantic/lex) @@ -41,6 +43,7 @@ (defvar semantic-version "2.2" "Current version of Semantic.") +(make-obsolete-variable 'semantic-version 'emacs-version "29.1") (declare-function inversion-test "inversion") (declare-function semanticdb-load-ebrowse-caches "semantic/db-ebrowse") @@ -73,9 +76,6 @@ introduced." (require 'semantic/fw) -;;; Code: -;; - ;;; Variables and Configuration ;; (defvar-local semantic--parse-table nil diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index d00ab47ce6..e2c9d618ba 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -29,7 +29,7 @@ (require 'cedet-files) (require 'data-debug) -(defvar semanticdb-file-version semantic-version +(defvar semanticdb-file-version "2.2" "Version of semanticdb we are writing files to disk with.") (defvar semanticdb-file-incompatible-version "1.4" "Version of semanticdb we are not reverse compatible with.") diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index 7c054d4c10..9691f906a4 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -37,14 +37,16 @@ ;; ;; See the srecode manual for specific details. +;;; Code: + (require 'eieio) (require 'mode-local) (load "srecode/loaddefs" nil 'nomessage) (defvar srecode-version "1.2" "Current version of the Semantic Recoder.") +(make-obsolete-variable 'srecode-version 'emacs-version "29.1") -;;; Code: (defgroup srecode nil "Semantic Recoder." :group 'extensions commit e746fc2e7b54d962569a61c15d14c34294d9647e Author: Stefan Kangas Date: Fri Aug 12 15:58:33 2022 +0200 Delete stale comments from Lisp Intro manual * doc/lispintro/emacs-lisp-intro.texi (Args as Variable or List) (print-elements-of-list, Miscellaneous): Delete some references to Emacs 22. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 8caf107a4c..860a758e75 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -2022,7 +2022,6 @@ the arguments to the function @code{concat} are the strings @w{@code{"The "}} and @w{@code{" red foxes."}} and the list @code{(number-to-string (+ 2 fill-column))}. -@c For GNU Emacs 22, need number-to-string @smallexample (concat "The " (number-to-string (+ 2 fill-column)) " red foxes.") @end smallexample @@ -10318,9 +10317,8 @@ loop with a list. @cindex @file{*scratch*} buffer The function requires several lines for its output. If you are -reading this in a recent instance of GNU Emacs, -@c GNU Emacs 21, GNU Emacs 22, or a later version, -you can evaluate the following expression inside of Info, as usual. +reading this in a recent instance of GNU Emacs, you can evaluate the +following expression inside of Info, as usual. If you are using an earlier version of Emacs, you need to copy the necessary expressions to your @file{*scratch*} buffer and evaluate @@ -17742,17 +17740,6 @@ or start GNU Emacs with the command @code{emacs -nbc}. (setq grep-command "grep -i -nH -e ") @end smallexample -@ignore -@c Evidently, no longer needed in GNU Emacs 22 - -item Automatically uncompress compressed files when visiting them - -smallexample -(load "uncompress") -end smallexample - -@end ignore - @item Find an existing buffer, even if it has a different name@* This avoids problems with symbolic links. commit 829b131e5b3ad3b077be9d31215770b251341c68 Author: Lars Ingebrigtsen Date: Fri Aug 12 15:54:55 2022 +0200 Clarify face-at-point doc string and add (thing-at-point 'face) * lisp/faces.el (face-at-point): Say what this function does. * lisp/thingatpt.el (thing-at-point-face-at-point): Add `face' type (bug#57087). (thing-at-point-provider-alist, thing-at-point): Mention it in the doc strings. diff --git a/lisp/faces.el b/lisp/faces.el index c7acbf5758..390ddbf606 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2046,18 +2046,29 @@ as backgrounds." (when msg (message "Color: `%s'" color)) color)) -(defun face-at-point (&optional thing multiple) - "Return the face of the character after point. -If it has more than one face, return the first one. -If THING is non-nil try first to get a face name from the buffer. -IF MULTIPLE is non-nil, return a list of all faces. -Return nil if there is no face." +(defun face-at-point (&optional text multiple) + "Return a face name from point in the current buffer. +This function is meant to be used as a conveniency function for +providing defaults when prompting the user for a face name. + +If TEXT is non-nil, return the text at point if it names an +existing face. + +Otherwise, look at the faces in effect at point as text +properties or overlay properties, and return one of these face +names. + +IF MULTIPLE is non-nil, return a list of faces. + +Return nil if there is no face at point. + +This function is not meant for handling faces programatically; to +do that, use `get-text-property' and `get-char-property'." (let (faces) - (if thing - ;; Try to get a face name from the buffer. - (let ((face (intern-soft (thing-at-point 'symbol)))) - (if (facep face) - (push face faces)))) + (when text + ;; Try to get a face name from the buffer. + (when-let ((face (thing-at-point 'face))) + (push face faces))) ;; Add the named faces that the `read-face-name' or `face' property uses. (let ((faceprop (or (get-char-property (point) 'read-face-name) (get-char-property (point) 'face)))) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index a7c86fb24f..462f87d3c1 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -74,7 +74,7 @@ question. \"things\" include `symbol', `list', `sexp', `defun', `filename', `existing-filename', `url', `email', `uuid', `word', `sentence', -`whitespace', `line', and `page'.") +`whitespace', `line', `face' and `page'.") ;; Basic movement @@ -166,7 +166,7 @@ positions of the thing found." THING should be a symbol specifying a type of syntactic entity. Possibilities include `symbol', `list', `sexp', `defun', `filename', `existing-filename', `url', `email', `uuid', `word', -`sentence', `whitespace', `line', `number', and `page'. +`sentence', `whitespace', `line', `number', `face' and `page'. When the optional argument NO-PROPERTIES is non-nil, strip text properties from the return value. @@ -361,6 +361,15 @@ E.g.: (put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point) +;; Faces + +(defun thing-at-point-face-at-point (&optional _lax _bounds) + "Return the name of the face at point as a symbol." + (when-let ((face (thing-at-point 'symbol))) + (and (facep face) (intern face)))) + +(put 'face 'thing-at-point 'thing-at-point-face-at-point) + ;; URIs (defvar thing-at-point-beginning-of-url-regexp nil commit 77613b9217caf89659aff60204343d6ce36d15cb Author: Stefan Kangas Date: Fri Aug 12 15:46:29 2022 +0200 ; Delete redundant installation instructions from ebnf2ps.el * lisp/progmodes/ebnf2ps.el: Delete redundant installation instructions. diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 96cbcba9be..e47591d5e7 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -45,20 +45,12 @@ Please send all bug fixes and enhancements to ;; ;; (require 'ebnf2ps) ;; -;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to +;; ebnf2ps uses ps-print package (bundled with Emacs), so see ps-print to ;; know how to set options like landscape printing, page headings, margins, ;; etc. ;; -;; NOTE: ps-print zebra stripes and line number options doesn't have effect on -;; ebnf2ps, they behave as it's turned off. -;; -;; For good performance, be sure to byte-compile ebnf2ps.el, e.g. -;; -;; M-x byte-compile-file -;; -;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el. -;; -;; ebnf2ps was tested with GNU Emacs 20.4.1. +;; NOTE: ps-print zebra stripes and line number options don't have an +;; effect on ebnf2ps, they behave as if it's turned off. ;; ;; ;; Using ebnf2ps commit c0d761bf7f441f8ab9792351a493dc6bd5525dc1 Author: Lars Ingebrigtsen Date: Fri Aug 12 15:15:11 2022 +0200 Further seq-uniq speed-ups for lists * lisp/emacs-lisp/seq.el (seq-uniq): Speed up more for long lists (bug#57079). diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 6ddd8de6e8..b6f0f66e5b 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -458,11 +458,21 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (cl-defmethod seq-uniq ((sequence list) &optional testfn) (let ((result nil)) (if (not testfn) - ;; Fast path. - (while sequence - (unless (member (car sequence) result) - (push (car sequence) result)) - (pop sequence)) + ;; Fast path. If the list is long, use a hash table to speed + ;; things up even more. + (let ((l (length sequence))) + (if (> l 100) + (let ((hash (make-hash-table :test #'equal :size l))) + (while sequence + (unless (gethash (car sequence) hash) + (setf (gethash (car sequence) hash) t) + (push (car sequence) result)) + (setq sequence (cdr sequence)))) + ;; Short list. + (while sequence + (unless (member (car sequence) result) + (push (car sequence) result)) + (pop sequence)))) ;; Slower path. (while sequence (unless (seq-find (lambda (elem) diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index a655377e6c..1a27467d29 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -570,7 +570,12 @@ Evaluate BODY for each created sequence. (substring "2") (substring "1")))) (should (equal (seq-uniq list) '("1" "2" "3"))) - (should (equal (seq-uniq list #'eq) '("1" "2" "3" "2" "1"))))) + (should (equal (seq-uniq list #'eq) '("1" "2" "3" "2" "1")))) + ;; Long lists have a different code path. + (let ((list (seq-map-indexed (lambda (_ i) i) + (make-list 10000 nil)))) + (should (= (length list) 10000)) + (should (= (length (seq-uniq (append list list))) 10000)))) (provide 'seq-tests) ;;; seq-tests.el ends here commit f947b20a1926ffc5b0553297dfc26d8390bcb328 Author: Stefan Kangas Date: Fri Aug 12 14:51:36 2022 +0200 Make finder-mode inherit special-mode * lisp/finder.el (finder-mode): Inherit special-mode. (finder-mode-map): Inherit special-mode-map. diff --git a/lisp/finder.el b/lisp/finder.el index 869c5b4b77..08d20963b4 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -77,6 +77,7 @@ Each element has the form (KEYWORD . DESCRIPTION).") (defvar-keymap finder-mode-map :doc "Keymap used in `finder-mode'." + :parent special-mode-map "SPC" #'finder-select "f" #'finder-select "" 'mouse-face @@ -420,15 +421,14 @@ FILE should be in a form suitable for passing to `locate-library'." (interactive) (finder-list-keywords)) -(define-derived-mode finder-mode nil "Finder" +(define-derived-mode finder-mode special-mode "Finder" "Major mode for browsing package documentation. \\ \\[finder-select] more help for the item on the current line -\\[finder-exit] exit Finder mode and kill the Finder buffer." - :syntax-table finder-mode-syntax-table +\\[finder-exit] exit Finder mode and kill the Finder buffer. + +\\{finder-mode-map}" :interactive nil - (setq buffer-read-only t - buffer-undo-list t) (setq-local finder-headmark nil)) (defun finder-summary () commit dc2879864536d89491af7f830881ecf5505cee07 Author: Stefan Kangas Date: Fri Aug 12 14:25:27 2022 +0200 * lisp/finder.el (finder-summary): Improve formatting. diff --git a/lisp/finder.el b/lisp/finder.el index 73072c0cd4..869c5b4b77 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -436,9 +436,9 @@ FILE should be in a form suitable for passing to `locate-library'." (interactive nil finder-mode) (message "%s" (substitute-command-keys - "\\\\[finder-select] = select, \ -\\[finder-mouse-select] = select, \\[finder-list-keywords] = to \ -finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"))) + "\\\\[finder-select] select, \ +\\[finder-mouse-select] select, \\[finder-list-keywords] go to \ +finder directory, \\[finder-exit] quit, \\[finder-summary] help"))) (defun finder-exit () "Exit Finder mode. commit 8ae68308a1a2988260a521792977e1cb69c47fd2 Author: Stefan Kangas Date: Fri Aug 12 14:22:59 2022 +0200 Use help-key-binding face in package list help * lisp/emacs-lisp/package.el (package--prettify-quick-help-key): Use help-key-binding face. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d2959f7728..ed23ee5f22 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -3530,7 +3530,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (let ((place (cdr desc)) (out (copy-sequence (car desc)))) (add-text-properties place (1+ place) - '(face (bold font-lock-warning-face)) + '(face help-key-binding) out) out)) (package--prettify-quick-help-key (cons desc 0)))) commit 9e983f4e8383bb183a60fb9ef2998d8db2ae3666 Author: Stefan Kangas Date: Thu Aug 11 23:26:43 2022 +0200 ; * lisp/cedet/cedet.el: Delete stale comment. Since 2009, it is no longer the case that this file depends on other parts of CEDET (see commit 715f35a55d). diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index 429b275828..c33ac85072 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -25,10 +25,6 @@ ;;; Commentary: ;;; Code: -;; -;; This file depends on the major components of CEDET, so that you can -;; load them all by doing (require 'cedet). This is mostly for -;; compatibility with the upstream, stand-alone CEDET distribution. (declare-function inversion-find-version "inversion") commit 43d46a7b3a7ace28015f795aa16de06908f82f9c Author: Stefan Kangas Date: Thu Aug 11 23:23:32 2022 +0200 Make cedet version variables obsolete * lisp/cedet/cedet.el (cedet-version, cedet-packages): Make obsolete. diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index e6befb10e9..429b275828 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -34,6 +34,7 @@ (defconst cedet-version "2.0" "Current version of CEDET.") +(make-obsolete-variable 'cedet-version 'emacs-version "29.1") (defconst cedet-packages `( @@ -45,6 +46,7 @@ (ede "1.2" nil "ede" ) ) "Table of CEDET packages to install.") +(make-obsolete-variable 'cedet-packages 'package-built-in-p "29.1") (defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") (let ((map (make-sparse-keymap "CEDET menu"))) commit 95d8a4544ec097058d908235060f6fcbf63cf643 Author: Lars Ingebrigtsen Date: Fri Aug 12 14:56:46 2022 +0200 Default outline-minor-mode-use-buttons to only happen in *Help* * lisp/outline.el (outline-minor-mode-use-buttons): Change the default to only use buttons in the *Help* buffer (for now), because it's too disruptive in other modes. This will probably be changed again to have some other mechanism to opt in in certain modes, but it's not clear what that mechanism should look like. diff --git a/lisp/outline.el b/lisp/outline.el index 8132043097..bb62c573c4 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -281,7 +281,7 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil." [outline-1 outline-2 outline-3 outline-4 outline-5 outline-6 outline-7 outline-8]) -(defcustom outline-minor-mode-use-buttons '(derived-mode . special-mode) +(defcustom outline-minor-mode-use-buttons '(derived-mode . help-mode) "Whether to display clickable buttons on the headings. The value should be a `buffer-match-p' condition. commit a23f9b7bda9f56ea97a4d5ff590e81625de63a6b Author: Stephen Berman Date: Fri Aug 12 14:49:22 2022 +0200 Reverse the outline arrows * lisp/outline.el (outline-open): Reverse the arrows to match arrows in Customize (bug#57082). diff --git a/lisp/outline.el b/lisp/outline.el index 35524a79a9..8132043097 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -294,16 +294,16 @@ buffers (yet) -- that will be amended in a future version." :version "29.1") (define-icon outline-open button - '((emoji "▶️") - (symbol " ⯈ ") + '((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 "🔽") - (symbol " ⯆ ") + '((emoji "▶️") + (symbol " ⯈ ") (text " close ")) "Icon used for buttons for closing a section in outline buffers." :version "29.1"