commit 21c8a9d944b37e431f56738c10a9fa7a75f4c3a9 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Mon Sep 5 09:51:05 2022 +0800 Fix crash while converting empty vector to X data * src/xselect.c (lisp_data_to_selection_data): Assume an empty vector represents INTEGER data, instead of blindly trying to aref it's first element. diff --git a/src/xselect.c b/src/xselect.c index 74d762f305..66782d4172 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2017,7 +2017,17 @@ lisp_data_to_selection_data (struct x_display_info *dpyinfo, ptrdiff_t i; ptrdiff_t size = ASIZE (obj); - if (SYMBOLP (AREF (obj, 0))) + if (!size) + { + /* This vector is empty and of unknown type. Assume that it + is a vector of integers. */ + + cs->data = NULL; + cs->format = 32; + cs->size = 0; + type = QINTEGER; + } + else if (SYMBOLP (AREF (obj, 0))) /* This vector is an ATOM set */ { void *data; commit f07505d1ecf15ca9f6e6461e042092ceee96cc25 Author: Jim Porter Date: Sun Aug 28 11:53:07 2022 -0700 Let external Eshell processes send stdout and stderr to different places * lisp/eshell/esh-proc.el (eshell-put-process-properties): Pass INDEX. (eshell-gather-process-output): Create a pipe process for stderr when stderr goes somewhere different than stdout. (eshell-insertion-filter, eshell-sentinel): Consult ':eshell-handle-index' property. * test/lisp/eshell/esh-proc-tests.el (esh-proc-test/output/stdout-to-buffer) (esh-proc-test/output/stderr-to-buffer) (esh-proc-test/exit-status/with-stderr-pipe): New tests (bug#21605). diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 5ca35b71db..7e005a0fc1 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -247,11 +247,15 @@ The prompt will be set to PROMPT." (setq eshell-process-list (delq entry eshell-process-list))) -(defun eshell-record-process-properties (process) +(defun eshell-record-process-properties (process &optional index) "Record Eshell bookkeeping properties for PROCESS. `eshell-insertion-filter' and `eshell-sentinel' will use these to -do their jobs." +do their jobs. + +INDEX is the index of the output handle to use for writing; if +nil, write to `eshell-output-handle'." (process-put process :eshell-handles eshell-current-handles) + (process-put process :eshell-handle-index (or index eshell-output-handle)) (process-put process :eshell-pending nil) (process-put process :eshell-busy nil)) @@ -273,9 +277,21 @@ Used only on systems which do not support async subprocesses.") eshell-delete-exited-processes delete-exited-processes)) (process-environment (eshell-environment-variables)) - proc decoding encoding changed) + proc stderr-proc decoding encoding changed) (cond ((fboundp 'make-process) + (unless (equal (car (aref eshell-current-handles eshell-output-handle)) + (car (aref eshell-current-handles eshell-error-handle))) + (eshell-protect-handles eshell-current-handles) + (setq stderr-proc + (make-pipe-process + :name (concat (file-name-nondirectory command) "-stderr") + :buffer (current-buffer) + :filter (if (eshell-interactive-output-p eshell-error-handle) + #'eshell-output-filter + #'eshell-insertion-filter) + :sentinel #'eshell-sentinel)) + (eshell-record-process-properties stderr-proc eshell-error-handle)) (setq proc (let ((command (file-local-name (expand-file-name command))) (conn-type (pcase (bound-and-true-p eshell-in-pipeline-p) @@ -292,6 +308,7 @@ Used only on systems which do not support async subprocesses.") #'eshell-insertion-filter) :sentinel #'eshell-sentinel :connection-type conn-type + :stderr stderr-proc :file-handler t))) (eshell-record-process-object proc) (eshell-record-process-properties proc) @@ -381,12 +398,13 @@ output." (unless (process-get proc :eshell-busy) ; Already being handled? (while (process-get proc :eshell-pending) (let ((handles (process-get proc :eshell-handles)) + (index (process-get proc :eshell-handle-index)) (data (process-get proc :eshell-pending))) (process-put proc :eshell-pending nil) (process-put proc :eshell-busy t) (unwind-protect (condition-case nil - (eshell-output-object data nil handles) + (eshell-output-object data index handles) ;; FIXME: We want to send SIGPIPE to the process ;; here. However, remote processes don't currently ;; support that, and not all systems have SIGPIPE in @@ -418,9 +436,13 @@ PROC is the process that's exiting. STRING is the exit message." (not (string-match "^\\(finished\\|exited\\)" string))) (funcall (process-filter proc) proc string)) - (let ((handles (process-get proc :eshell-handles)) - (data (process-get proc :eshell-pending)) - (status (process-exit-status proc))) + (let* ((handles (process-get proc :eshell-handles)) + (index (process-get proc :eshell-handle-index)) + (data (process-get proc :eshell-pending)) + ;; Only get the status for the primary subprocess, + ;; not the pipe process (if any). + (status (when (= index eshell-output-handle) + (process-exit-status proc)))) (process-put proc :eshell-pending nil) ;; If we're in the middle of handling output from this ;; process then schedule the EOF for later. @@ -431,9 +453,10 @@ PROC is the process that's exiting. STRING is the exit message." (when data (ignore-error 'eshell-pipe-broken (eshell-output-object - data nil handles))) + data index handles))) (eshell-close-handles - status (list 'quote (= status 0)) + status + (when status (list 'quote (= status 0))) handles))))) (funcall finish-io)))) (when-let ((entry (assq proc eshell-process-list))) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index 4cb0b796a8..52a0d1eeeb 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -55,6 +55,26 @@ (eshell-match-command-output esh-proc-test--output-cmd "stdout\nstderr\n"))) +(ert-deftest esh-proc-test/output/stdout-to-buffer () + "Check that redirecting only stdout works." + (skip-unless (executable-find "sh")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "%s > #<%s>" esh-proc-test--output-cmd bufname) + "stderr\n")) + (should (equal (buffer-string) "stdout\n")))) + +(ert-deftest esh-proc-test/output/stderr-to-buffer () + "Check that redirecting only stderr works." + (skip-unless (executable-find "sh")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "%s 2> #<%s>" esh-proc-test--output-cmd bufname) + "stdout\n")) + (should (equal (buffer-string) "stderr\n")))) + (ert-deftest esh-proc-test/output/stdout-and-stderr-to-buffer () "Check that redirecting stdout and stderr works." (skip-unless (executable-find "sh")) @@ -86,6 +106,16 @@ (should (= eshell-last-command-status 1)) (should (eq eshell-last-command-result nil)))) +(ert-deftest esh-proc-test/exit-status/with-stderr-pipe () + "Check that failed execution is properly recorded even with a pipe process." + (skip-unless (executable-find "sh")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command (format "sh -c 'exit 1' > #<%s>" bufname)) + (eshell-wait-for-subprocess) + (should (= eshell-last-command-status 1)) + (should (eq eshell-last-command-result nil))))) + ;; Pipelines commit a87c7aff554213651678e9390dd7500b11419012 Author: Jim Porter Date: Sun Aug 28 11:19:30 2022 -0700 Put Eshell's bookkeeping data for external processes on the process object This allows tracking this information for process objects not recorded in 'eshell-process-list', which will be useful for pipe processes for stderr output. * lisp/eshell/esh-proc.el (eshell-process-list): Add docstring. (eshell-record-process-object): Only record the process object and whether it's a subjob. (eshell-remove-process-entry): Adapt to changes in 'eshell-record-process-object'. (eshell-record-process-properties): New function... (eshell-gather-process-output): ... call it. (eshell-insertion-filter, eshell-sentinel): Use new process properties, don't require process to be in 'eshell-process-list'. * test/lisp/eshell/esh-proc-tests.el (esh-proc-test--output-cmd): New variable. (esh-proc-test--detect-pty-cmd): Add docstring. (esh-proc-test/output/to-screen) (esh-proc-test/output/stdout-and-stderr-to-buffer) (esh-proc-test/exit-status/success, esh-proc-test/exit-status/failure) (esh-proc-test/kill-process/foreground-only): New tests. (esh-proc-test/kill-background-process): Rename to... (esh-proc-test/kill-process/background-prompt): ... this, and use 'eshell-wait-for-subprocess' instead of 'sit-for'. diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index c367b5cd64..5ca35b71db 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -99,7 +99,13 @@ information, for example." (defvar eshell-current-subjob-p nil) (defvar eshell-process-list nil - "A list of the current status of subprocesses.") + "A list of the current status of subprocesses. +Each element has the form (PROC . SUBJOB-P), where PROC is the +process object and SUBJOB-P is non-nil if the process is a +subjob. + +To add or remove elements of this list, see +`eshell-record-process-object' and `eshell-remove-process-entry'.") (declare-function eshell-send-eof-to-process "esh-mode") (declare-function eshell-tail-process "esh-cmd") @@ -229,21 +235,26 @@ The prompt will be set to PROMPT." (declare-function eshell-interactive-print "esh-mode" (string)) (eshell-interactive-print (format "[%s] %d\n" (process-name object) (process-id object)))) - (setq eshell-process-list - (cons (list object eshell-current-handles - eshell-current-subjob-p nil nil) - eshell-process-list))) + (push (cons object eshell-current-subjob-p) eshell-process-list)) (defun eshell-remove-process-entry (entry) "Record the process ENTRY as fully completed." (if (and (eshell-processp (car entry)) - (nth 2 entry) + (cdr entry) eshell-done-messages-in-minibuffer) (message "[%s]+ Done %s" (process-name (car entry)) (process-command (car entry)))) (setq eshell-process-list (delq entry eshell-process-list))) +(defun eshell-record-process-properties (process) + "Record Eshell bookkeeping properties for PROCESS. +`eshell-insertion-filter' and `eshell-sentinel' will use these to +do their jobs." + (process-put process :eshell-handles eshell-current-handles) + (process-put process :eshell-pending nil) + (process-put process :eshell-busy nil)) + (defvar eshell-scratch-buffer " *eshell-scratch*" "Scratch buffer for holding Eshell's input/output.") (defvar eshell-last-sync-output-start nil @@ -283,6 +294,7 @@ Used only on systems which do not support async subprocesses.") :connection-type conn-type :file-handler t))) (eshell-record-process-object proc) + (eshell-record-process-properties proc) (run-hook-with-args 'eshell-exec-hook proc) (when (fboundp 'process-coding-system) (let ((coding-systems (process-coding-system proc))) @@ -363,36 +375,35 @@ PROC is the process for which we're inserting output. STRING is the output." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) - (let ((entry (assq proc eshell-process-list))) - (when entry - (setcar (nthcdr 3 entry) - (concat (nth 3 entry) string)) - (unless (nth 4 entry) ; already being handled? - (while (nth 3 entry) - (let ((data (nth 3 entry))) - (setcar (nthcdr 3 entry) nil) - (setcar (nthcdr 4 entry) t) - (unwind-protect - (condition-case nil - (eshell-output-object data nil (cadr entry)) - ;; FIXME: We want to send SIGPIPE to the process - ;; here. However, remote processes don't - ;; currently support that, and not all systems - ;; have SIGPIPE in the first place (e.g. MS - ;; Windows). In these cases, just delete the - ;; process; this is reasonably close to the - ;; right behavior, since the default action for - ;; SIGPIPE is to terminate the process. For use - ;; cases where SIGPIPE is truly needed, using an - ;; external pipe operator (`*|') may work - ;; instead (e.g. when working with remote - ;; processes). - (eshell-pipe-broken - (if (or (process-get proc 'remote-pid) - (eq system-type 'windows-nt)) - (delete-process proc) - (signal-process proc 'SIGPIPE)))) - (setcar (nthcdr 4 entry) nil)))))))))) + (process-put proc :eshell-pending + (concat (process-get proc :eshell-pending) + string)) + (unless (process-get proc :eshell-busy) ; Already being handled? + (while (process-get proc :eshell-pending) + (let ((handles (process-get proc :eshell-handles)) + (data (process-get proc :eshell-pending))) + (process-put proc :eshell-pending nil) + (process-put proc :eshell-busy t) + (unwind-protect + (condition-case nil + (eshell-output-object data nil handles) + ;; FIXME: We want to send SIGPIPE to the process + ;; here. However, remote processes don't currently + ;; support that, and not all systems have SIGPIPE in + ;; the first place (e.g. MS Windows). In these + ;; cases, just delete the process; this is + ;; reasonably close to the right behavior, since the + ;; default action for SIGPIPE is to terminate the + ;; process. For use cases where SIGPIPE is truly + ;; needed, using an external pipe operator (`*|') + ;; may work instead (e.g. when working with remote + ;; processes). + (eshell-pipe-broken + (if (or (process-get proc 'remote-pid) + (eq system-type 'windows-nt)) + (delete-process proc) + (signal-process proc 'SIGPIPE)))) + (process-put proc :eshell-busy nil)))))))) (defun eshell-sentinel (proc string) "Generic sentinel for command processes. Reports only signals. @@ -400,37 +411,34 @@ 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 - (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))))) + (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 (process-get proc :eshell-handles)) + (data (process-get proc :eshell-pending)) + (status (process-exit-status proc))) + (process-put proc :eshell-pending nil) + ;; If we're in the middle of handling output from this + ;; process then schedule the EOF for later. + (letrec ((finish-io + (lambda () + (if (process-get proc :eshell-busy) + (run-at-time 0 nil finish-io) + (when data + (ignore-error 'eshell-pipe-broken + (eshell-output-object + data nil handles))) + (eshell-close-handles + status (list 'quote (= status 0)) + handles))))) + (funcall finish-io)))) + (when-let ((entry (assq proc eshell-process-list))) + (eshell-remove-process-entry entry)) + (eshell-kill-process-function proc string))))) (defun eshell-process-interact (func &optional all query) "Interact with a process, using PROMPT if more than one, via FUNC. @@ -441,7 +449,7 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC." (if (and (memq (process-status (car entry)) '(run stop open closed)) (or all - (not (nth 2 entry))) + (not (cdr entry))) (or (not query) (y-or-n-p (format-message query (process-name (car entry)))))) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index b9f4470be6..4cb0b796a8 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -28,15 +28,67 @@ (file-name-directory (or load-file-name default-directory)))) +(defvar esh-proc-test--output-cmd + (concat "sh -c '" + "echo stdout; " + "echo stderr >&2" + "'") + "A shell command that prints to both stdout and stderr.") + (defvar esh-proc-test--detect-pty-cmd (concat "sh -c '" "if [ -t 0 ]; then echo stdin; fi; " "if [ -t 1 ]; then echo stdout; fi; " "if [ -t 2 ]; then echo stderr; fi" - "'")) + "'") + "A shell command that prints the standard streams connected as TTYs.") ;;; Tests: + +;; Output and redirection + +(ert-deftest esh-proc-test/output/to-screen () + "Check that outputting stdout and stderr to the screen works." + (skip-unless (executable-find "sh")) + (with-temp-eshell + (eshell-match-command-output esh-proc-test--output-cmd + "stdout\nstderr\n"))) + +(ert-deftest esh-proc-test/output/stdout-and-stderr-to-buffer () + "Check that redirecting stdout and stderr works." + (skip-unless (executable-find "sh")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "%s &> #<%s>" esh-proc-test--output-cmd bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\n")))) + + +;; Exit status + +(ert-deftest esh-proc-test/exit-status/success () + "Check that successful execution is properly recorded." + (skip-unless (executable-find "sh")) + (with-temp-eshell + (eshell-insert-command "sh -c 'exit 0'") + (eshell-wait-for-subprocess) + (should (= eshell-last-command-status 0)) + (should (eq eshell-last-command-result t)))) + +(ert-deftest esh-proc-test/exit-status/failure () + "Check that failed execution is properly recorded." + (skip-unless (executable-find "sh")) + (with-temp-eshell + (eshell-insert-command "sh -c 'exit 1'") + (eshell-wait-for-subprocess) + (should (= eshell-last-command-status 1)) + (should (eq eshell-last-command-result nil)))) + + +;; Pipelines + (ert-deftest esh-proc-test/sigpipe-exits-process () "Test that a SIGPIPE is properly sent to a process if a pipe closes" (skip-unless (and (executable-find "sh") @@ -94,6 +146,35 @@ pipeline." (unless (eq system-type 'windows-nt) "stdout\nstderr\n")))) + +;; Killing processes + +(ert-deftest esh-proc-test/kill-process/foreground-only () + "Test that `eshell-kill-process' only kills foreground processes." + (with-temp-eshell + (eshell-insert-command "sleep 100 &") + (eshell-insert-command "sleep 100") + (should (equal (length eshell-process-list) 2)) + ;; This should kill only the foreground process. + (eshell-kill-process) + (eshell-wait-for-subprocess) + (should (equal (length eshell-process-list) 1)) + ;; Now kill everything, including the background process. + (eshell-process-interact 'kill-process t) + (eshell-wait-for-subprocess t) + (should (equal (length eshell-process-list) 0)))) + +(ert-deftest esh-proc-test/kill-process/background-prompt () + "Test that killing a background process doesn't emit a new +prompt. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command "sh -c 'while true; do sleep 1; done' &") + (kill-process (caar eshell-process-list)) + (eshell-wait-for-subprocess) + (should (eshell-match-output "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n")))) + (ert-deftest esh-proc-test/kill-pipeline () "Test that killing a pipeline of processes only emits a single prompt. See bug#54136." @@ -133,14 +214,4 @@ write the exit status to the pipe. See bug#54136." output-start (eshell-end-of-output)) ""))))) -(ert-deftest esh-proc-test/kill-background-process () - "Test that killing a background process doesn't emit a new -prompt. See bug#54136." - (skip-unless (and (executable-find "sh") - (executable-find "sleep"))) - (with-temp-eshell - (eshell-insert-command "sh -c 'while true; do sleep 1; done' &") - (kill-process (caar eshell-process-list)) - ;; Give `eshell-sentinel' a chance to run. - (sit-for 0.1) - (should (eshell-match-output "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n")))) +;;; esh-proc-tests.el ends here commit ab7e94fb1d9b794c9d199435d72f569fba6ab017 Author: Jim Porter Date: Sat Jul 9 16:26:55 2022 -0700 Add support for more kinds of redirect operators in Eshell * lisp/eshell/esh-arg.el: Require cl-lib. (eshell-finish-arg): Allow passing multiple ARGUMENTS. (eshell-quote-argument): Handle the case when 'eshell-finish-arg' was passed multiple arguments. * lisp/eshell/esh-cmd.el (eshell-do-pipelines) (eshell-do-pipelines-synchronously): Only set stdout output handle. * lisp/eshell/esh-io.el (eshell-redirection-operators-alist): New constant. (eshell-io-initialize): Prefer sharp quotes for functions. (eshell-parse-redirection, eshell-strip-redirections): Add support for more redirection forms. (eshell-copy-output-handle, eshell-set-all-output-handles): New functions. * test/lisp/eshell/esh-io-tests.el (esh-io-test/redirect-all/overwrite, esh-io-test/redirect-all/append) (esh-io-test/redirect-all/insert, esh-io-test/redirect-copy) (esh-io-test/redirect-copy-first, esh-io-test/redirect-pipe): New tests. * doc/misc/eshell.texi (Redirection): Document new redirection syntax. (Pipelines): Document '|&' syntax. (Bugs and ideas): Update item about redirection syntax. * etc/NEWS: Announce this change. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 0c98d2860e..bc3b21d019 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1659,6 +1659,40 @@ Redirect output to @var{dest}, inserting it at the current mark if @var{dest} is a buffer, at the beginning of the file if @var{dest} is a file, or otherwise behaving the same as @code{>>}. +@item &> @var{file} +@itemx >& @var{file} +Redirect both standard output and standard error to @var{dest}, +overwriting its contents with the new output. + +@item &>> @var{file} +@itemx >>& @var{file} +Redirect both standard output and standard error to @var{dest}, +appending it to the existing contents of @var{dest}. + +@item &>>> @var{file} +@itemx >>>& @var{file} +Redirect both standard output and standard error to @var{dest}, +inserting it like with @code{>>> @var{file}}. + +@item >&@var{other-fd} +@itemx @var{fd}>&@var{other-fd} +Duplicate the file descriptor @var{other-fd} to @var{fd} (or 1 if +unspecified). The order in which this is used is signficant, so + +@example +@var{command} > @var{file} 2>&1 +@end example + +redirects both standard output and standard error to @var{file}, +whereas + +@example +@var{command} 2>&1 > @var{file} +@end example + +only redirects standard output to @var{file} (and sends standard error +to the display via standard output's original handle). + @end table Eshell supports redirecting output to several different types of @@ -1721,14 +1755,18 @@ The output function is called once on each line of output until @node Pipelines @section Pipelines As with most other shells, Eshell supports pipelines to pass the -output of one command the input of the next command. You can pipe -commands to each other using the @code{|} operator. For example, +output of one command the input of the next command. You can send the +standard output of one command to the standard input of another using +the @code{|} operator. For example, @example ~ $ echo hello | rev olleh @end example +To send both the standard output and standard error of a command to +another command's input, you can use the @code{|&} operator. + @subsection Running Shell Pipelines Natively When constructing shell pipelines that will move a lot of data, it is a good idea to bypass Eshell's own pipelining support and use the @@ -2217,10 +2255,9 @@ current being used. @item How can Eshell learn if a background process has requested input? -@item Support @samp{2>&1} and @samp{>&} and @samp{2>} and @samp{|&} +@item Make a customizable syntax table for redirects -The syntax table for parsing these should be customizable, such that the -user could change it to use rc syntax: @samp{>[2=1]}. +This way, the user could change it to use rc syntax: @samp{>[2=1]}. @item Allow @samp{$_[-1]}, which would indicate the last element of the array diff --git a/etc/NEWS b/etc/NEWS index 77ac0f5e6c..476cd7ba6c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -321,6 +321,10 @@ been restricted to "...", '...', /.../, |...|, (...), [...], <...>, and {...}. See the "(eshell) Argument Predication and Modification" node in the Eshell manual for more details. ++++ +*** Eshell pipelines now only pipe stdout by default. +To pipe both stdout and stderr, use the '|&' operator instead of '|'. + --- ** The 'delete-forward-char' command now deletes by grapheme clusters. This command is by default bound to the function key @@ -2237,6 +2241,13 @@ Lisp function. This frees you from having to keep track of whether commands are Lisp function or external when supplying absolute file name arguments. See "Electric forward slash" in the Eshell manual. ++++ +*** Improved support for redirection operators in Eshell. +Eshell now supports a wider variety of redirection operators. For +example, you can now redirect both stdout and stderr via '&>' or +duplicate one output handle to another via 'NEW-FD>&OLD-FD'. For more +information, see "Redirections" in the Eshell manual. + +++ *** Double-quoting an Eshell expansion now treats the result as a single string. If an Eshell expansion like '$FOO' is surrounded by double quotes, the diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 50fb7f5fdc..576d32b8c5 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -29,6 +29,9 @@ (require 'esh-util) +(eval-when-compile + (require 'cl-lib)) + (defgroup eshell-arg nil "Argument parsing involves transforming the arguments passed on the command line into equivalent Lisp forms that, when evaluated, will @@ -248,10 +251,16 @@ convert the result to a number as well." eshell-current-modifiers (cdr eshell-current-modifiers)))) (setq eshell-current-modifiers nil)) -(defun eshell-finish-arg (&optional argument) - "Finish the current ARGUMENT being processed." - (if argument - (setq eshell-current-argument argument)) +(defun eshell-finish-arg (&rest arguments) + "Finish the current argument being processed. +If any ARGUMENTS are specified, they will be added to the final +argument list in place of the value of the current argument." + (when arguments + (if (= (length arguments) 1) + (setq eshell-current-argument (car arguments)) + (cl-assert (and (not eshell-arg-listified) + (not eshell-current-modifiers))) + (setq eshell-current-argument (cons 'eshell-flatten-args arguments)))) (throw 'eshell-arg-done t)) (defun eshell-quote-argument (string) @@ -291,7 +300,11 @@ Point is left at the end of the arguments." (if (= (point) here) (error "Failed to parse argument `%s'" (buffer-substring here (point-max)))) - (and arg (nconc args (list arg))))))) + (when arg + (nconc args + (if (eq (car-safe arg) 'eshell-flatten-args) + (cdr arg) + (list arg)))))))) (throw 'eshell-incomplete (if (listp delim) delim (list delim (point) (cdr args))))) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index a43ad77213..413336e3eb 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -810,8 +810,6 @@ This macro calls itself recursively, with NOTFIRST non-nil." `(let ((nextproc (eshell-do-pipelines (quote ,(cdr pipeline)) t))) (eshell-set-output-handle ,eshell-output-handle - 'append nextproc) - (eshell-set-output-handle ,eshell-error-handle 'append nextproc))) ,(let ((head (car pipeline))) (if (memq (car head) '(let progn)) @@ -842,8 +840,6 @@ This is used on systems where async subprocesses are not supported." ,(when (cdr pipeline) `(let ((output-marker ,(point-marker))) (eshell-set-output-handle ,eshell-output-handle - 'append output-marker) - (eshell-set-output-handle ,eshell-error-handle 'append output-marker))) ,(let ((head (car pipeline))) (if (memq (car head) '(let progn)) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 01e8aceeab..4620565f85 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -154,6 +154,14 @@ not be added to this variable." ;;; Internal Variables: +(defconst eshell-redirection-operators-alist + '(("<" . input) ; FIXME: Not supported yet. + (">" . overwrite) + (">>" . append) + (">>>" . insert)) + "An association list of redirection operators to symbols +describing the mode, e.g. for using with `eshell-get-target'.") + (defvar eshell-current-handles nil) (defvar eshell-last-command-status 0 @@ -173,53 +181,104 @@ not be added to this variable." (defun eshell-io-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the I/O subsystem code." (add-hook 'eshell-parse-argument-hook - 'eshell-parse-redirection nil t) + #'eshell-parse-redirection nil t) (make-local-variable 'eshell-current-redirections) (add-hook 'eshell-pre-rewrite-command-hook - 'eshell-strip-redirections nil t) + #'eshell-strip-redirections nil t) (add-function :filter-return (local 'eshell-post-rewrite-command-function) #'eshell--apply-redirections)) (defun eshell-parse-redirection () - "Parse an output redirection, such as `2>'." - (if (and (not eshell-current-quoted) - (looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*")) + "Parse an output redirection, such as `2>' or `>&'." + (when (not eshell-current-quoted) + (cond + ;; Copying a handle (e.g. `2>&1'). + ((looking-at (rx (? (group digit)) + (group (or "<" ">")) + "&" (group digit) + (* (syntax whitespace)))) + (let ((source (string-to-number (or (match-string 1) "1"))) + (mode (cdr (assoc (match-string 2) + eshell-redirection-operators-alist))) + (target (string-to-number (match-string 3)))) + (when (eq mode 'input) + (error "Eshell does not support input redirection")) + (goto-char (match-end 0)) + (eshell-finish-arg (list 'eshell-copy-output-handle + source target)))) + ;; Shorthand for redirecting both stdout and stderr (e.g. `&>'). + ((looking-at (rx (or (seq (group (** 1 3 ">")) "&") + (seq "&" (group-n 1 (** 1 3 ">")))) + (* (syntax whitespace)))) + (if eshell-current-argument + (eshell-finish-arg) + (goto-char (match-end 0)) + (eshell-finish-arg + (let ((mode (cdr (assoc (match-string 1) + eshell-redirection-operators-alist)))) + (list 'eshell-set-all-output-handles + (list 'quote mode)))))) + ;; Shorthand for piping both stdout and stderr (i.e. `|&'). + ((looking-at (rx "|&" (* (syntax whitespace)))) + (if eshell-current-argument + (eshell-finish-arg) + (goto-char (match-end 0)) + (eshell-finish-arg + '(eshell-copy-output-handle eshell-error-handle + eshell-output-handle) + '(eshell-operator "|")))) + ;; Regular redirecting (e.g. `2>'). + ((looking-at (rx (? (group digit)) + (group (or "<" (** 1 3 ">"))) + (* (syntax whitespace)))) (if eshell-current-argument - (eshell-finish-arg) - (let ((sh (match-string 1)) - (oper (match-string 2)) -; (th (match-string 3)) - ) - (if (string= oper "<") - (error "Eshell does not support input redirection")) - (eshell-finish-arg - (prog1 - (list 'eshell-set-output-handle - (or (and sh (string-to-number sh)) 1) - (list 'quote - (aref [overwrite append insert] - (1- (length oper))))) - (goto-char (match-end 0)))))))) + (eshell-finish-arg) + (let ((source (if (match-string 1) + (string-to-number (match-string 1)) + eshell-output-handle)) + (mode (cdr (assoc (match-string 2) + eshell-redirection-operators-alist)))) + (when (eq mode 'input) + (error "Eshell does not support input redirection")) + (goto-char (match-end 0)) + (eshell-finish-arg + ;; Note: the target will be set later by + ;; `eshell-strip-redirections'. + (list 'eshell-set-output-handle + source (list 'quote mode))))))))) (defun eshell-strip-redirections (terms) "Rewrite any output redirections in TERMS." (setq eshell-current-redirections (list t)) (let ((tl terms) - (tt (cdr terms))) + (tt (cdr terms))) (while tt - (if (not (and (consp (car tt)) - (eq (caar tt) 'eshell-set-output-handle))) - (setq tt (cdr tt) - tl (cdr tl)) - (unless (cdr tt) - (error "Missing redirection target")) - (nconc eshell-current-redirections - (list (list 'ignore - (append (car tt) (list (cadr tt)))))) - (setcdr tl (cddr tt)) - (setq tt (cddr tt)))) + (cond + ;; Strip `eshell-copy-output-handle'. + ((and (consp (car tt)) + (eq (caar tt) 'eshell-copy-output-handle)) + (nconc eshell-current-redirections + (list (car tt))) + (setcdr tl (cddr tt)) + (setq tt (cdr tt))) + ;; Strip `eshell-set-output-handle' or + ;; `eshell-set-all-output-handles' and the term immediately + ;; after (the redirection target). + ((and (consp (car tt)) + (memq (caar tt) '(eshell-set-output-handle + eshell-set-all-output-handles))) + (unless (cdr tt) + (error "Missing redirection target")) + (nconc eshell-current-redirections + (list (list 'ignore + (append (car tt) (list (cadr tt)))))) + (setcdr tl (cddr tt)) + (setq tt (cddr tt))) + (t + (setq tt (cdr tt) + tl (cdr tl))))) (setq eshell-current-redirections - (cdr eshell-current-redirections)))) + (cdr eshell-current-redirections)))) (defun eshell--apply-redirections (cmd) "Apply any redirection which were specified for COMMAND." @@ -295,6 +354,22 @@ If HANDLES is nil, use `eshell-current-handles'." (aset handles index (cons nil 1))) (setcar (aref handles index) current)))))) +(defun eshell-copy-output-handle (index index-to-copy &optional handles) + "Copy the handle INDEX-TO-COPY to INDEX for the current HANDLES. +If HANDLES is nil, use `eshell-current-handles'." + (let* ((handles (or handles eshell-current-handles)) + (handle-to-copy (car (aref handles index-to-copy)))) + (setcar (aref handles index) + (if (listp handle-to-copy) + (copy-sequence handle-to-copy) + handle-to-copy)))) + +(defun eshell-set-all-output-handles (mode &optional target handles) + "Set output and error HANDLES to point to TARGET using MODE. +If HANDLES is nil, use `eshell-current-handles'." + (eshell-set-output-handle eshell-output-handle mode target handles) + (eshell-copy-output-handle eshell-error-handle eshell-output-handle handles)) + (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." diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el index 6cd2dff1c1..37b234eaf0 100644 --- a/test/lisp/eshell/esh-io-tests.el +++ b/test/lisp/eshell/esh-io-tests.el @@ -199,6 +199,78 @@ (should (equal (buffer-string) "stderr\n"))) (should (equal (buffer-string) "stdout\n")))) +(ert-deftest esh-io-test/redirect-all/overwrite () + "Check that redirecting to stdout and stderr via shorthand works." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output &> #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\n"))) + ;; Also check the alternate (and less-preferred in Bash) `>&' syntax. + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output >& #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\n")))) + +(ert-deftest esh-io-test/redirect-all/append () + "Check that redirecting to stdout and stderr via shorthand works." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output &>> #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "oldstdout\nstderr\n"))) + ;; Also check the alternate (and less-preferred in Bash) `>>&' syntax. + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output >>& #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "oldstdout\nstderr\n")))) + +(ert-deftest esh-io-test/redirect-all/insert () + "Check that redirecting to stdout and stderr via shorthand works." + (eshell-with-temp-buffer bufname "old" + (goto-char (point-min)) + (with-temp-eshell + (eshell-match-command-output (format "test-output &>>> #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\nold"))) + ;; Also check the alternate `>>>&' syntax. + (eshell-with-temp-buffer bufname "old" + (goto-char (point-min)) + (with-temp-eshell + (eshell-match-command-output (format "test-output >>>& #<%s>" bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\nold")))) + +(ert-deftest esh-io-test/redirect-copy () + "Check that redirecting stdout and then copying stdout to stderr works. +This should redirect both stdout and stderr to the same place." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output > #<%s> 2>&1" bufname) + "\\`\\'")) + (should (equal (buffer-string) "stdout\nstderr\n")))) + +(ert-deftest esh-io-test/redirect-copy-first () + "Check that copying stdout to stderr and then redirecting stdout works. +This should redirect stdout to a buffer, and stderr to where +stdout originally pointed (the terminal)." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output 2>&1 > #<%s>" bufname) + "stderr\n")) + (should (equal (buffer-string) "stdout\n")))) + +(ert-deftest esh-io-test/redirect-pipe () + "Check that \"redirecting\" to a pipe works." + ;; `|' should only redirect stdout. + (eshell-command-result-equal "test-output | rev" + "stderr\ntuodts\n") + ;; `|&' should redirect stdout and stderr. + (eshell-command-result-equal "test-output |& rev" + "tuodts\nrredts\n")) + ;; Virtual targets commit 3d6c013a27e0b72c8fbe2d47f752dd0dfd4ff47a Author: Jim Porter Date: Sun Aug 28 20:50:27 2022 -0700 Allow checking specific Eshell handles for interactive output This changes the default behavior of the function to check only stdout for interactivity, but for most cases this should be what we want. * lisp/eshell/esh-io.el (eshell-interactive-output-p): Pass HANDLES and handle INDEX. * lisp/eshell/em-term.el (eshell-visual-command-p): Check for interactivity of both stdout and stderr. diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index a4fa699aa9..6811e70313 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -153,7 +153,7 @@ behavior for short-lived processes, see bug#18108." If either COMMAND or a subcommand in ARGS (e.g. git log) is a visual command, returns non-nil." (let ((command (file-name-nondirectory command))) - (and (eshell-interactive-output-p) + (and (eshell-interactive-output-p 'all) (or (member command eshell-visual-commands) (member (car args) (cdr (assoc command eshell-visual-subcommands))) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index f5dac2c81c..01e8aceeab 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -407,12 +407,20 @@ it defaults to `insert'." (error "Invalid redirection target: %s" (eshell-stringify target))))) -(defun eshell-interactive-output-p () - "Return non-nil if current handles are bound for interactive display." - (and (eq (car (aref eshell-current-handles - eshell-output-handle)) t) - (eq (car (aref eshell-current-handles - eshell-error-handle)) t))) +(defun eshell-interactive-output-p (&optional index handles) + "Return non-nil if the specified handle is bound for interactive display. +HANDLES is the set of handles to check; if nil, use +`eshell-current-handles'. + +INDEX is the handle index to check. If nil, check +`eshell-output-handle'. If `all', check both +`eshell-output-handle' and `eshell-error-handle'." + (let ((handles (or handles eshell-current-handles)) + (index (or index eshell-output-handle))) + (if (eq index 'all) + (and (eq (car (aref handles eshell-output-handle)) t) + (eq (car (aref handles eshell-error-handle)) t)) + (eq (car (aref handles index)) t)))) (defvar eshell-print-queue nil) (defvar eshell-print-queue-count -1) commit 1be925faa1065af5754fc11914b56ae98dfb2a83 Author: Jim Porter Date: Sat Jul 9 10:34:31 2022 -0700 Simplify Eshell handle functions and add tests/documentation * lisp/eshell/esh-arg.el (eshell-parse-argument-hook): Explain how to use 'eshell-finish-arg'. * lisp/eshell/esh-io.el (eshell-create-handles): Only call 'eshell-get-target' for stderr if necessary. (eshell-protect-handles): Use 'dotimes'. (eshell-set-output-handle): Pass HANDLES and fix an edge case with setting a duplicate TARGET. * test/lisp/eshell/eshell-tests-helpers.el (eshell-with-temp-buffer): New macro. * test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/quoted-lisp-form) (esh-cmd-test/backquoted-lisp-form) (esh-cmd-test/backquoted-lisp-form/splice): New tests. * test/lisp/eshell/eshell-tests.el (eshell-test/redirect-buffer) (eshell-test/redirect-buffer-escaped): Move to... * test/lisp/eshell/esh-io-tests.el: ... here, and add other I/O tests. * doc/misc/eshell.texi (Arguments): Add documentation for special argument types. (Input/Output): Expand documentation for redirection and pipelines. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 13f13163dd..0c98d2860e 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -256,7 +256,6 @@ as an argument will ``spread'' the elements into multiple arguments: @end example @subsection Quoting and escaping - As with other shells, you can escape special characters and spaces with by prefixing the character with a backslash (@code{\}), or by surrounding the string with apostrophes (@code{''}) or double quotes @@ -268,6 +267,40 @@ When using expansions (@pxref{Expansion}) in an Eshell command, the result may potentially be of any data type. To ensure that the result is always a string, the expansion can be surrounded by double quotes. +@subsection Special argument types +In addition to strings and numbers, Eshell supports a number of +special argument types. These let you refer to various other Emacs +Lisp data types, such as lists or buffers. + +@table @code + +@item #'@var{lisp-form} +This refers to the quoted Emacs Lisp form @var{lisp-form}. Though +this looks similar to the ``sharp quote'' syntax for functions +(@pxref{Special Read Syntax, , , elisp, The Emacs Lisp Reference +Manual}), it instead corresponds to @code{quote} and can be used for +any quoted form.@footnote{Eshell would interpret a bare apostrophe +(@code{'}) as the start of a single-quoted string.} + +@item `@var{lisp-form} +This refers to the backquoted Emacs Lisp form @var{lisp-form} +(@pxref{Backquote, , , elisp, The Emacs Lisp Reference Manual}). As +in Emacs Lisp, you can use @samp{,} and @samp{,@@} to refer to +non-constant values. + +@item # +@itemx #<@var{name}> +Return the buffer named @var{name}. This is equivalent to +@samp{$(get-buffer-create "@var{name}")} (@pxref{Creating Buffers, , , +elisp, The Emacs Lisp Reference Manual}). + +@item # +Return the process named @var{name}. This is equivalent to +@samp{$(get-process "@var{name}")} (@pxref{Process Information, , , +elisp, The Emacs Lisp Reference Manual}). + +@end table + @node Built-ins @section Built-in commands Several commands are built-in in Eshell. In order to call the @@ -1560,6 +1593,13 @@ Reverses the order of a list of values. Since Eshell does not communicate with a terminal like most command shells, IO is a little different. +@menu +* Visual Commands:: +* Redirection:: +* Pipelines:: +@end menu + +@node Visual Commands @section Visual Commands If you try to run programs from within Eshell that are not line-oriented, such as programs that use ncurses, you will just get @@ -1592,40 +1632,104 @@ program exits, customize the variable @code{eshell-destroy-buffer-when-process-dies} to a non-@code{nil} value; the default is @code{nil}. +@node Redirection @section Redirection -Redirection is mostly the same in Eshell as it is in other command -shells. The output redirection operators @code{>} and @code{>>} as -well as pipes are supported, but there is not yet any support for -input redirection. Output can also be redirected to buffers, using -the @code{>>>} redirection operator, and Elisp functions, using -virtual devices. - -The buffer redirection operator, @code{>>>}, expects a buffer object -on the right-hand side, into which it inserts the output of the -left-hand side. e.g., @samp{echo hello >>> #} -inserts the string @code{"hello"} into the @file{*scratch*} buffer. -The convenience shorthand variant @samp{#<@var{buffer-name}>}, as in -@samp{#<*scratch*>}, is also accepted. - -@code{eshell-virtual-targets} is a list of mappings of virtual device -names to functions. Eshell comes with two virtual devices: -@file{/dev/kill}, which sends the text to the kill ring, and -@file{/dev/clip}, which sends text to the clipboard. +Redirection in Eshell is similar to that of other command shells. You +can use the output redirection operators @code{>} and @code{>>}, but +there is not yet any support for input redirection. In the cases +below, @var{fd} specifies the file descriptor to redirect; if not +specified, file descriptor 1 (standard output) will be used by +default. + +@table @code + +@item > @var{dest} +@itemx @var{fd}> @var{dest} +Redirect output to @var{dest}, overwriting its contents with the new +output. + +@item >> @var{dest} +@itemx @var{fd}>> @var{dest} +Redirect output to @var{dest}, appending it to the existing contents +of @var{dest}. + +@item >>> @var{buffer} +@itemx @var{fd}>>> @var{buffer} +Redirect output to @var{dest}, inserting it at the current mark if +@var{dest} is a buffer, at the beginning of the file if @var{dest} is +a file, or otherwise behaving the same as @code{>>}. + +@end table + +Eshell supports redirecting output to several different types of +targets: + +@itemize @bullet + +@item +files, including virtual targets (see below); +@item +buffers (@pxref{Buffers, , , elisp, GNU Emacs Lisp Reference Manual}); + +@item +markers (@pxref{Markers, , , elisp, GNU Emacs Lisp Reference Manual}); + +@item +processes (@pxref{Processes, , , elisp, GNU Emacs Lisp Reference +Manual}); and + +@item +symbols (@pxref{Symbols, , , elisp, GNU Emacs Lisp Reference Manual}). + +@end itemize + +@subsection Virtual Targets +Virtual targets are mapping of device names to functions. Eshell +comes with four virtual devices: + +@table @file + +@item /dev/null +Does nothing with the output passed to it. + +@item /dev/eshell +Writes the text passed to it to the display. + +@item /dev/kill +Adds the text passed to it to the kill ring. + +@item /dev/clip +Adds the text passed to it to the clipboard. + +@end table + +@vindex eshell-virtual-targets You can, of course, define your own virtual targets. They are defined -by adding a list of the form @samp{("/dev/name" @var{function} @var{mode})} to -@code{eshell-virtual-targets}. The first element is the device name; -@var{function} may be either a lambda or a function name. If -@var{mode} is @code{nil}, then the function is the output function; if it is -non-@code{nil}, then the function is passed the redirection mode as a -symbol--@code{overwrite} for @code{>}, @code{append} for @code{>>}, or -@code{insert} for @code{>>>}--and the function is expected to return -the output function. +by adding a list of the form @samp{("/dev/name" @var{function} +@var{mode})} to @code{eshell-virtual-targets}. The first element is +the device name; @var{function} may be either a lambda or a function +name. If @var{mode} is @code{nil}, then the function is the output +function; if it is non-@code{nil}, then the function is passed the +redirection mode as a symbol--@code{overwrite} for @code{>}, +@code{append} for @code{>>}, or @code{insert} for @code{>>>}--and the +function is expected to return the output function. The output function is called once on each line of output until @code{nil} is passed, indicating end of output. -@section Running Shell Pipelines Natively +@node Pipelines +@section Pipelines +As with most other shells, Eshell supports pipelines to pass the +output of one command the input of the next command. You can pipe +commands to each other using the @code{|} operator. For example, + +@example +~ $ echo hello | rev +olleh +@end example + +@subsection Running Shell Pipelines Natively When constructing shell pipelines that will move a lot of data, it is a good idea to bypass Eshell's own pipelining support and use the operating system shell's instead. This is especially relevant when diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 8e44a88459..50fb7f5fdc 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -147,6 +147,10 @@ return the result of the parse as a sexp. It is also responsible for moving the point forward to reflect the amount of input text that was parsed. +If the hook determines that it has reached the end of an argument, it +should call `eshell-finish-arg' to complete processing of the current +argument and proceed to the next. + If no function handles the current character at point, it will be treated as a literal character." :type 'hook diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index d54be55c13..f5dac2c81c 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -236,22 +236,21 @@ The default location for standard output and standard error will go to STDOUT and STDERR, respectively. OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert'; a nil value of mode defaults to `insert'." - (let ((handles (make-vector eshell-number-of-handles nil)) - (output-target (eshell-get-target stdout output-mode)) - (error-target (eshell-get-target stderr error-mode))) + (let* ((handles (make-vector eshell-number-of-handles nil)) + (output-target (eshell-get-target stdout output-mode)) + (error-target (if stderr + (eshell-get-target stderr error-mode) + output-target))) (aset handles eshell-output-handle (cons output-target 1)) - (aset handles eshell-error-handle - (cons (if stderr error-target output-target) 1)) + (aset handles eshell-error-handle (cons error-target 1)) handles)) (defun eshell-protect-handles (handles) "Protect the handles in HANDLES from a being closed." - (let ((idx 0)) - (while (< idx eshell-number-of-handles) - (if (aref handles idx) - (setcdr (aref handles idx) - (1+ (cdr (aref handles idx))))) - (setq idx (1+ idx)))) + (dotimes (idx eshell-number-of-handles) + (when (aref handles idx) + (setcdr (aref handles idx) + (1+ (cdr (aref handles idx)))))) handles) (defun eshell-close-handles (&optional exit-code result handles) @@ -278,6 +277,24 @@ the value already set in `eshell-last-command-result'." (eshell-close-target target (= eshell-last-command-status 0))) (setcar handle nil)))))) +(defun eshell-set-output-handle (index mode &optional target handles) + "Set handle INDEX for the current HANDLES to point to TARGET using MODE. +If HANDLES is nil, use `eshell-current-handles'." + (when target + (let ((handles (or handles eshell-current-handles))) + (if (and (stringp target) + (string= target (null-device))) + (aset handles index nil) + (let ((where (eshell-get-target target mode)) + (current (car (aref handles index)))) + (if (listp current) + (unless (member where current) + (setq current (append current (list where)))) + (setq current (list where))) + (if (not (aref handles index)) + (aset handles index (cons nil 1))) + (setcar (aref handles index) current)))))) + (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." @@ -390,22 +407,6 @@ it defaults to `insert'." (error "Invalid redirection target: %s" (eshell-stringify target))))) -(defun eshell-set-output-handle (index mode &optional target) - "Set handle INDEX, using MODE, to point to TARGET." - (when target - (if (and (stringp target) - (string= target (null-device))) - (aset eshell-current-handles index nil) - (let ((where (eshell-get-target target mode)) - (current (car (aref eshell-current-handles index)))) - (if (and (listp current) - (not (member where current))) - (setq current (append current (list where))) - (setq current (list where))) - (if (not (aref eshell-current-handles index)) - (aset eshell-current-handles index (cons nil 1))) - (setcar (aref eshell-current-handles index) current))))) - (defun eshell-interactive-output-p () "Return non-nil if current handles are bound for interactive display." (and (eq (car (aref eshell-current-handles diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 3a582965d6..92d785d7fd 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -73,6 +73,25 @@ Test that trailing arguments outside the subcommand are ignored. e.g. \"{(+ 1 2)} 3\" => 3" (eshell-command-result-equal "{(+ 1 2)} 3" 3)) + +;; Lisp forms + +(ert-deftest esh-cmd-test/quoted-lisp-form () + "Test parsing of a quoted Lisp form." + (eshell-command-result-equal "echo #'(1 2)" '(1 2))) + +(ert-deftest esh-cmd-test/backquoted-lisp-form () + "Test parsing of a backquoted Lisp form." + (let ((eshell-test-value 42)) + (eshell-command-result-equal "echo `(answer ,eshell-test-value)" + '(answer 42)))) + +(ert-deftest esh-cmd-test/backquoted-lisp-form/splice () + "Test parsing of a backquoted Lisp form using splicing." + (let ((eshell-test-value '(2 3))) + (eshell-command-result-equal "echo `(1 ,@eshell-test-value)" + '(1 2 3)))) + ;; Logical operators diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el new file mode 100644 index 0000000000..6cd2dff1c1 --- /dev/null +++ b/test/lisp/eshell/esh-io-tests.el @@ -0,0 +1,220 @@ +;;; esh-io-tests.el --- esh-io 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 . + +;;; Code: + +(require 'ert) +(require 'ert-x) +(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) + +(defun eshell-test-file-string (file) + "Return the contents of FILE as a string." + (with-temp-buffer + (insert-file-contents file) + (buffer-string))) + +(defun eshell/test-output () + "Write some test output separately to stdout and stderr." + (eshell-printn "stdout") + (eshell-errorn "stderr")) + +;;; Tests: + + +;; Basic redirection + +(ert-deftest esh-io-test/redirect-file/overwrite () + "Check that redirecting to a file in overwrite mode works." + (ert-with-temp-file temp-file + :text "old" + (with-temp-eshell + (eshell-insert-command (format "echo new > %s" temp-file))) + (should (equal (eshell-test-file-string temp-file) "new")))) + +(ert-deftest esh-io-test/redirect-file/append () + "Check that redirecting to a file in append mode works." + (ert-with-temp-file temp-file + :text "old" + (with-temp-eshell + (eshell-insert-command (format "echo new >> %s" temp-file))) + (should (equal (eshell-test-file-string temp-file) "oldnew")))) + +(ert-deftest esh-io-test/redirect-file/insert () + "Check that redirecting to a file in insert works." + (ert-with-temp-file temp-file + :text "old" + (with-temp-eshell + (eshell-insert-command (format "echo new >>> %s" temp-file))) + (should (equal (eshell-test-file-string temp-file) "newold")))) + +(ert-deftest esh-io-test/redirect-buffer/overwrite () + "Check that redirecting to a buffer in overwrite mode works." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command (format "echo new > #<%s>" bufname))) + (should (equal (buffer-string) "new")))) + +(ert-deftest esh-io-test/redirect-buffer/append () + "Check that redirecting to a buffer in append mode works." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command (format "echo new >> #<%s>" bufname))) + (should (equal (buffer-string) "oldnew")))) + +(ert-deftest esh-io-test/redirect-buffer/insert () + "Check that redirecting to a buffer in insert mode works." + (eshell-with-temp-buffer bufname "old" + (goto-char (point-min)) + (with-temp-eshell + (eshell-insert-command (format "echo new >>> #<%s>" bufname))) + (should (equal (buffer-string) "newold")))) + +(ert-deftest esh-io-test/redirect-buffer/escaped () + "Check that redirecting to a buffer with escaped characters works." + (with-temp-buffer + (rename-buffer "eshell\\temp\\buffer" t) + (let ((bufname (buffer-name))) + (with-temp-eshell + (eshell-insert-command (format "echo hi > #<%s>" + (string-replace "\\" "\\\\" bufname)))) + (should (equal (buffer-string) "hi"))))) + +(ert-deftest esh-io-test/redirect-symbol/overwrite () + "Check that redirecting to a symbol in overwrite mode works." + (let ((eshell-test-value "old")) + (with-temp-eshell + (eshell-insert-command "echo new > #'eshell-test-value")) + (should (equal eshell-test-value "new")))) + +(ert-deftest esh-io-test/redirect-symbol/append () + "Check that redirecting to a symbol in append mode works." + (let ((eshell-test-value "old")) + (with-temp-eshell + (eshell-insert-command "echo new >> #'eshell-test-value")) + (should (equal eshell-test-value "oldnew")))) + +(ert-deftest esh-io-test/redirect-marker () + "Check that redirecting to a marker works." + (with-temp-buffer + (let ((eshell-test-value (point-marker))) + (with-temp-eshell + (eshell-insert-command "echo hi > $eshell-test-value")) + (should (equal (buffer-string) "hi"))))) + +(ert-deftest esh-io-test/redirect-multiple () + "Check that redirecting to multiple targets works." + (let ((eshell-test-value "old")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command (format "echo new > #<%s> > #'eshell-test-value" + bufname))) + (should (equal (buffer-string) "new")) + (should (equal eshell-test-value "new"))))) + +(ert-deftest esh-io-test/redirect-multiple/repeat () + "Check that redirecting to multiple targets works when repeating a target." + (let ((eshell-test-value "old")) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command + (format "echo new > #<%s> > #'eshell-test-value > #<%s>" + bufname bufname))) + (should (equal (buffer-string) "new")) + (should (equal eshell-test-value "new"))))) + + +;; Redirecting specific handles + +(ert-deftest esh-io-test/redirect-stdout () + "Check that redirecting to stdout doesn't redirect stderr." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output > #<%s>" bufname) + "stderr\n")) + (should (equal (buffer-string) "stdout\n"))) + ;; Also check explicitly specifying the stdout fd. + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output 1> #<%s>" bufname) + "stderr\n")) + (should (equal (buffer-string) "stdout\n")))) + +(ert-deftest esh-io-test/redirect-stderr/overwrite () + "Check that redirecting to stderr doesn't redirect stdout." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output 2> #<%s>" bufname) + "stdout\n")) + (should (equal (buffer-string) "stderr\n")))) + +(ert-deftest esh-io-test/redirect-stderr/append () + "Check that redirecting to stderr doesn't redirect stdout." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output 2>> #<%s>" bufname) + "stdout\n")) + (should (equal (buffer-string) "oldstderr\n")))) + +(ert-deftest esh-io-test/redirect-stderr/insert () + "Check that redirecting to stderr doesn't redirect stdout." + (eshell-with-temp-buffer bufname "old" + (goto-char (point-min)) + (with-temp-eshell + (eshell-match-command-output (format "test-output 2>>> #<%s>" bufname) + "stdout\n")) + (should (equal (buffer-string) "stderr\nold")))) + +(ert-deftest esh-io-test/redirect-stdout-and-stderr () + "Check that redirecting to both stdout and stderr works." + (eshell-with-temp-buffer bufname-1 "old" + (eshell-with-temp-buffer bufname-2 "old" + (with-temp-eshell + (eshell-match-command-output (format "test-output > #<%s> 2> #<%s>" + bufname-1 bufname-2) + "\\`\\'")) + (should (equal (buffer-string) "stderr\n"))) + (should (equal (buffer-string) "stdout\n")))) + + +;; Virtual targets + +(ert-deftest esh-io-test/virtual-dev-eshell () + "Check that redirecting to /dev/eshell works." + (with-temp-eshell + (eshell-match-command-output "echo hi > /dev/eshell" "hi"))) + +(ert-deftest esh-io-test/virtual-dev-kill () + "Check that redirecting to /dev/kill works." + (with-temp-eshell + (eshell-insert-command "echo one > /dev/kill") + (should (equal (car kill-ring) "one")) + (eshell-insert-command "echo two > /dev/kill") + (should (equal (car kill-ring) "two")) + (eshell-insert-command "echo three >> /dev/kill") + (should (equal (car kill-ring) "twothree")))) + +;;; esh-io-tests.el ends here diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index 8f0f993447..73abfcbb55 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -51,6 +51,16 @@ See `eshell-wait-for-subprocess'.") (let (kill-buffer-query-functions) (kill-buffer eshell-buffer))))))) +(defmacro eshell-with-temp-buffer (bufname text &rest body) + "Create a temporary buffer containing TEXT and evaluate BODY there. +BUFNAME will be set to the name of the temporary buffer." + (declare (indent 2)) + `(with-temp-buffer + (insert ,text) + (rename-buffer "eshell-temp-buffer" t) + (let ((,bufname (buffer-name))) + ,@body))) + (defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. If ALL is non-nil, wait until there are no Eshell subprocesses at diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 1845dba280..d5112146c2 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -105,25 +105,6 @@ (format template "format \"%s\" eshell-in-pipeline-p") "nil"))) -(ert-deftest eshell-test/redirect-buffer () - "Check that piping to a buffer works" - (with-temp-buffer - (rename-buffer "eshell-temp-buffer" t) - (let ((bufname (buffer-name))) - (with-temp-eshell - (eshell-insert-command (format "echo hi > #<%s>" bufname))) - (should (equal (buffer-string) "hi"))))) - -(ert-deftest eshell-test/redirect-buffer-escaped () - "Check that piping to a buffer with escaped characters works" - (with-temp-buffer - (rename-buffer "eshell\\temp\\buffer" t) - (let ((bufname (buffer-name))) - (with-temp-eshell - (eshell-insert-command (format "echo hi > #<%s>" - (string-replace "\\" "\\\\" bufname)))) - (should (equal (buffer-string) "hi"))))) - (ert-deftest eshell-test/escape-nonspecial () "Test that \"\\c\" and \"c\" are equivalent when \"c\" is not a special character." commit 5af5ed6c6271a452bf37afa0e7349838960d446a Author: Matt Armstrong Date: Sun Sep 4 23:58:55 2022 +0200 Add basic test coverage for overlay modification hooks * test/src/buffer-tests.el: (overlay-modification-hooks) new ert-deftest. (overlay-tests-start-recording-modification-hooks): New function. (overlay-tests-get-recorded-modification-hooks): New function (bug#57150). diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 3c6a9208ff..558d05de14 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -22,6 +22,199 @@ (require 'ert) (require 'ert-x) (require 'cl-lib) +(require 'let-alist) + +(defun overlay-tests-start-recording-modification-hooks (overlay) + "Start recording modification hooks on OVERLAY. + +Always overwrites the `insert-in-front-hooks', +`modification-hooks' and `insert-behind-hooks' properties. Any +recorded history from a previous call is erased. + +The history is stored in a property on the overlay itself. Call +`overlay-tests-get-recorded-modification-hooks' to retrieve the +recorded calls conveniently." + (dolist (hooks-property '(insert-in-front-hooks + modification-hooks + insert-behind-hooks)) + (overlay-put + overlay + hooks-property + (list (lambda (ov &rest args) + (message " %S called on %S with args %S" hooks-property ov args) + (should inhibit-modification-hooks) + (should (eq ov overlay)) + (push (list hooks-property args) + (overlay-get overlay + 'recorded-modification-hook-calls))))) + (overlay-put overlay 'recorded-modification-hook-calls nil))) + +(defun overlay-tests-get-recorded-modification-hooks (overlay) + "Extract the recorded calls made to modification hooks on OVERLAY. + +Must be preceded by a call to +`overlay-tests-start-recording-modification-hooks' on OVERLAY. + +Returns a list. Each element of the list represents a recorded +call to a particular modification hook. + +Each call is itself a sub-list where the first element is a +symbol matching the modification hook property (one of +`insert-in-front-hooks', `modification-hooks' or +`insert-behind-hooks') and the second element is the list of +arguments passed to the hook. The first hook argument, the +overlay itself, is omitted to make test result verification +easier." + (reverse (overlay-get overlay + 'recorded-modification-hook-calls))) + +(ert-deftest overlay-modification-hooks () + "Test the basic functionality of overlay modification hooks. + +This exercises hooks registered on the `insert-in-front-hooks', +`modification-hooks' and `insert-behind-hooks' overlay +properties." + ;; This is a data driven test loop. Each test case is described + ;; by an alist. The test loop initializes a new temporary buffer + ;; for each case, creates an overlay, registers modification hooks + ;; on the overlay, modifies the buffer, and then verifies which + ;; modification hooks (if any) were called for the overlay, as + ;; well as which arguments were passed to the hooks. + ;; + ;; The following keys are available in the alist: + ;; + ;; `buffer-text': the initial buffer text of the temporary buffer. + ;; Defaults to "1234". + ;; + ;; `overlay-beg' and `overlay-end': the begin and end positions of + ;; the overlay under test. Defaults to 2 and 4 respectively. + ;; + ;; `insert-at': move to the given position and insert the string + ;; "x" into the test case's buffer. + ;; + ;; `replace': replace the first occurrence of the given string in + ;; the test case's buffer with "x". The test will fail if the + ;; string is not found. + ;; + ;; `expected-calls': a description of the expected buffer + ;; modification hooks. See + ;; `overlay-tests-get-recorded-modification-hooks' for the format. + ;; May be omitted, in which case the test will insist that no + ;; modification hooks are called. + ;; + ;; The test will fail itself in the degenerate case where no + ;; buffer modifications are requested. + (dolist (test-case + '( + ;; Remember that the default buffer text is "1234" and + ;; the default overlay begins at position 2 and ends at + ;; position 4. Most of the test cases below assume + ;; this. + + ;; TODO: (info "(elisp) Special Properties") says this + ;; about `modification-hooks': "Furthermore, insertion + ;; will not modify any existing character, so this hook + ;; will only be run when removing some characters, + ;; replacing them with others, or changing their + ;; text-properties." So, why are modification-hooks + ;; being called when inserting at position 3 below? + ((insert-at . 1)) + ((insert-at . 2) + (expected-calls . ((insert-in-front-hooks (nil 2 2)) + (insert-in-front-hooks (t 2 3 0))))) + ((insert-at . 3) + (expected-calls . ((modification-hooks (nil 3 3)) + (modification-hooks (t 3 4 0))))) + ((insert-at . 4) + (expected-calls . ((insert-behind-hooks (nil 4 4)) + (insert-behind-hooks (t 4 5 0))))) + ((insert-at . 5)) + + ;; Replacing text never calls `insert-in-front-hooks' + ;; or `insert-behind-hooks'. It calls + ;; `modification-hooks' if the overlay covers any text + ;; that has changed. + ((replace . "1")) + ((replace . "2") + (expected-calls . ((modification-hooks (nil 2 3)) + (modification-hooks (t 2 3 1))))) + ((replace . "3") + (expected-calls . ((modification-hooks (nil 3 4)) + (modification-hooks (t 3 4 1))))) + ((replace . "4")) + ((replace . "12") + (expected-calls . ((modification-hooks (nil 1 3)) + (modification-hooks (t 1 2 2))))) + ((replace . "23") + (expected-calls . ((modification-hooks (nil 2 4)) + (modification-hooks (t 2 3 2))))) + ((replace . "34") + (expected-calls . ((modification-hooks (nil 3 5)) + (modification-hooks (t 3 4 2))))) + ((replace . "123") + (expected-calls . ((modification-hooks (nil 1 4)) + (modification-hooks (t 1 2 3))))) + ((replace . "234") + (expected-calls . ((modification-hooks (nil 2 5)) + (modification-hooks (t 2 3 3))))) + ((replace . "1234") + (expected-calls . ((modification-hooks (nil 1 5)) + (modification-hooks (t 1 2 4))))) + + ;; Inserting at the position of a zero-length overlay + ;; calls both `insert-in-front-hooks' and + ;; `insert-behind-hooks'. + ((buffer-text . "") (overlay-beg . 1) (overlay-end . 1) + (insert-at . 1) + (expected-calls . ((insert-in-front-hooks + (nil 1 1)) + (insert-behind-hooks + (nil 1 1)) + (insert-in-front-hooks + (t 1 2 0)) + (insert-behind-hooks + (t 1 2 0))))))) + (message "BEGIN overlay-modification-hooks test-case %S" test-case) + + ;; All three hooks ignore the overlay's `front-advance' and + ;; `rear-advance' option, so test both ways while expecting the same + ;; result. + (dolist (advance '(nil t)) + (message " advance is %S" advance) + (let-alist test-case + (with-temp-buffer + ;; Set up the temporary buffer and overlay as specified by + ;; the test case. + (insert (or .buffer-text "1234")) + (let ((overlay (make-overlay + (or .overlay-beg 2) + (or .overlay-end 4) + nil + advance advance))) + (message " (buffer-string) is %S" (buffer-string)) + (message " overlay is %S" overlay) + (overlay-tests-start-recording-modification-hooks overlay) + + ;; Modify the buffer, possibly inducing calls to the + ;; overlay's modification hooks. + (should (or .insert-at .replace)) + (when .insert-at + (goto-char .insert-at) + (insert "x") + (message " inserted \"x\" at %S, buffer-string now %S" + .insert-at (buffer-string))) + (when .replace + (goto-char (point-min)) + (search-forward .replace) + (replace-match "x") + (message " replaced %S with \"x\"" .replace)) + + ;; Verify that the expected and actual modification hook + ;; calls match. + (should (equal + .expected-calls + (overlay-tests-get-recorded-modification-hooks + overlay))))))))) (ert-deftest overlay-modification-hooks-message-other-buf () "Test for bug#21824. commit 72ba9efe72a6e9f390d1eb51fddf0466dc0a3de6 Author: Lars Ingebrigtsen Date: Sun Sep 4 22:58:52 2022 +0200 Clarify that the region is in the Emacs manual * doc/emacs/mark.texi (Mark): Try to clarify what's so special about Emacs' regions (bug#50950). diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index ad25ed6a8a..b5956cc85b 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -8,26 +8,29 @@ @cindex setting a mark @cindex region - Many Emacs commands operate on an arbitrary contiguous part of the -current buffer. To specify the text for such a command to operate on, -you set @dfn{the mark} at one end of it, and move point to the other -end. The text between point and the mark is called @dfn{the region}. -The region always extends between point and the mark, no matter which -one comes earlier in the text; each time you move point, the region -changes. + Emacs, like many other applications, lets you select some arbitrary +part of the buffer text and invoke commands that operate on such +@dfn{selected text}. In Emacs, we call the selected text @dfn{the +region}; its handling is very similar to that of selected text in +other programs, but there are also important differences. @cindex active region @cindex activating the mark - Setting the mark at a position in the text also @dfn{activates} it. -When the mark is active, we say also that the region is active; Emacs + The region is the portion of the buffer between @dfn{the mark} and +the current @dfn{point}. You define a region by setting the mark +somewhere (with, for instance, the @kbd{C-SPC} command), and then +moving point to where you want the region to end. (Or you can use the +mouse to define a region.) + + The region always extends between point and the mark, no matter +which of them comes earlier in the text; each time you move point, the +region changes. + + Setting the mark at a position in the text @dfn{activates} it. When +the mark is active, we say also that the region is active; Emacs indicates its extent by highlighting the text within it, using the @code{region} face (@pxref{Face Customization}). -This is one of the few faces that has the @code{:extend t} attribute -by default, which implies that the same face is used to highlight the -text and space between end of line and the window border. To -highlight only the text you could set this attribute to @code{nil}. - @cindex deactivating the mark After certain non-motion commands, including any command that changes the text in the buffer, Emacs automatically @dfn{deactivates} @@ -35,6 +38,17 @@ the mark; this turns off the highlighting. You can also explicitly deactivate the mark at any time, by typing @kbd{C-g} (@pxref{Quitting}). + Many commands limit what they do to the active region. For +instance, the @kbd{M-%} command (which replaces matching text) +normally works on the entire visible part of the buffer, but if you +have an active region, it'll work on just that region instead. + + The mark is useful even if it is not active. For example, you can +move to previous mark locations using the mark ring. @xref{Mark +Ring}. Additionally, some commands will have an effect even on an +inactive region (for example @dfn{upcase-region}). You can also +reactivate the region with commands like @kbd{C-x C-x}. + The above default behavior is known as Transient Mark mode. Disabling Transient Mark mode switches Emacs to an alternative behavior, in which the region is usually not highlighted. commit 1dad2cba159abc05c567491c959471da12d24722 Author: Lars Ingebrigtsen Date: Sun Sep 4 20:44:30 2022 +0200 Mark some filenotify tests unstable on EMBA * test/lisp/filenotify-tests.el (file-notify-test03-events) (file-notify-test09-watched-file-in-watched-dir): Mark as unstable on EMBA, because they seem to fail regularly. diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 4ed1786a8e..2d147e900d 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -639,7 +639,9 @@ delivered." (ert-deftest file-notify-test03-events () "Check file creation/change/removal notifications." - :tags '(:expensive-test) + :tags (if (getenv "EMACS_EMBA_CI") + '(:expensive-test :unstable) + '(:expensive-test)) (skip-unless (file-notify--test-local-enabled)) (unwind-protect @@ -1382,7 +1384,9 @@ descriptors that were issued when registering the watches. This test caters for the situation in bug#22736 where the callback for the directory received events for the file with the descriptor of the file watch." - :tags '(:expensive-test) + :tags (if (getenv "EMACS_EMBA_CI") + '(:expensive-test :unstable) + '(:expensive-test)) (skip-unless (file-notify--test-local-enabled)) ;; A directory to be watched. commit 0fd0d0724919184315f76f395070e5f18d6a1e0f Author: Eli Zaretskii Date: Sun Sep 4 21:30:53 2022 +0300 ; * etc/NEWS: Move WebP entry to a proper place. diff --git a/etc/NEWS b/etc/NEWS index 4c596fd17e..77ac0f5e6c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -29,6 +29,13 @@ applies, and please also update docstrings as needed. This uses the popular sqlite3 library, and can be disabled by using the '--without-sqlite3' option to the 'configure' script. ++++ +** Support for the WebP image format. +This support is built by default when the libwebp library is +available, and includes support for animated WebP images. To disable +WebP support, use the '--without-webp' configure flag. Image +specifiers can now use ':type webp'. + +++ ** Emacs has been ported to the Haiku operating system. The configuration process should automatically detect and build for @@ -930,13 +937,6 @@ If non-nil, Outline Minor Mode will use buttons to hide/show outlines in addition to the ellipsis. The default is nil in editing modes, but non-nil in 'special-mode' and its derivatives. -+++ -** Support for the WebP image format. -This support is built by default when the libwebp library is -available, and includes support for animated WebP images. To disable -WebP support, use the '--without-webp' configure flag. Image -specifiers can now use ':type webp'. - ** Windows +++ commit 4eb3e6bdda2f233186f5a27f2ec5f50916eb73ef Author: Michael Albinus Date: Sun Sep 4 19:25:21 2022 +0200 Fix comment in tramp.el diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bf8c5d4a3d..b24525de3a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1431,9 +1431,14 @@ calling HANDLER.") ;; internal data structure. Convenience functions for internal ;; data structure. -;; The basic structure for remote file names. We must autoload it in -;; tramp-loaddefs.el, because some functions, which need it, wouldn't -;; work otherwise when unloading / reloading Tramp. (Bug#50869) +;; The basic structure for remote file names. + +;; Note: We started autoloading it in tramp-loaddefs.el, because some +;; functions, which needed it, wouldn't work otherwise when unloading +;; / reloading Tramp (Bug#50869). +;; This bug is fixed in Emacs 29, but other parts of Tramp have grown +;; dependencies on having this in tramp-loaddefs.el in the mean time, +;; so .... here we are. ;;;###tramp-autoload(require 'cl-lib) ;;;###tramp-autoload (progn commit 2dfce43103e5fa098f362bc6d715c3857e9cdc08 Author: Juri Linkov Date: Sun Sep 4 20:02:20 2022 +0300 Don't replace the first character with an arrow in outline-minor-mode * lisp/outline.el (outline--make-button-overlay): Add the first character to the displayed outline button (bug#56820). diff --git a/lisp/outline.el b/lisp/outline.el index 178cbe3071..9a94cad638 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -1005,7 +1005,8 @@ If non-nil, EVENT should be a mouse event." (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face))) (when-let ((image (plist-get icon 'image))) (overlay-put o 'display image)) - (overlay-put o 'display (plist-get icon 'string)) + (overlay-put o 'display (concat (plist-get icon 'string) + (string (char-after (point))))) (overlay-put o 'face (plist-get icon 'face))) o)) commit 40cdbf6dc133214c34da40cd7cc097dc39c05c3f Author: Juri Linkov Date: Sun Sep 4 19:55:59 2022 +0300 Use use-region-beginning/end in replacement commands (bug#45607) * lisp/isearch.el (isearch-query-replace): Use use-region-beginning and use-region-end. * lisp/textmodes/paragraphs.el (repunctuate-sentences): * lisp/replace.el (query-replace, query-replace-regexp) (map-query-replace-regexp, replace-string, replace-regexp): Add 'interactive-args' to 'declare' and use use-region-beginning, use-region-end, use-region-noncontiguous-p. * lisp/simple.el (use-region-noncontiguous-p): New function. (region-noncontiguous-p): Return more meaningful value. diff --git a/lisp/isearch.el b/lisp/isearch.el index 9f1fbb14a4..2ef35438e9 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2389,8 +2389,7 @@ type \\[help-command] at that time." (if (use-region-p) " in region" "")) isearch-regexp) t isearch-regexp (or delimited isearch-regexp-function) nil nil - (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)) + (use-region-beginning) (use-region-end) backward)) (and isearch-recursive-edit (exit-recursive-edit))) diff --git a/lisp/replace.el b/lisp/replace.el index 2bb9c1b90d..06cde771b9 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -448,6 +448,10 @@ Arguments FROM-STRING, TO-STRING, DELIMITED, START, END, BACKWARD, and REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see). To customize possible responses, change the bindings in `query-replace-map'." + (declare (interactive-args + (start (use-region-beginning)) + (end (use-region-end)) + (region-noncontiguous-p (use-region-noncontiguous-p)))) (interactive (let ((common (query-replace-read-args @@ -461,10 +465,9 @@ To customize possible responses, change the bindings in `query-replace-map'." ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)) + (use-region-beginning) (use-region-end) (nth 3 common) - (if (use-region-p) (region-noncontiguous-p))))) + (use-region-noncontiguous-p)))) (perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p)) (define-key esc-map "%" 'query-replace) @@ -541,6 +544,10 @@ Use \\[repeat-complex-command] after this command for details. Arguments REGEXP, TO-STRING, DELIMITED, START, END, BACKWARD, and REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see)." + (declare (interactive-args + (start (use-region-beginning)) + (end (use-region-end)) + (region-noncontiguous-p (use-region-noncontiguous-p)))) (interactive (let ((common (query-replace-read-args @@ -555,10 +562,9 @@ REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see)." ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)) + (use-region-beginning) (use-region-end) (nth 3 common) - (if (use-region-p) (region-noncontiguous-p))))) + (use-region-noncontiguous-p)))) (perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p)) (define-key esc-map [?\C-%] 'query-replace-regexp) @@ -592,6 +598,10 @@ Fourth and fifth arg START and END specify the region to operate on. Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to `perform-replace' (which see)." + (declare (interactive-args + (start (use-region-beginning)) + (end (use-region-end)) + (region-noncontiguous-p (use-region-noncontiguous-p)))) (interactive (let* ((from (read-regexp "Map query replace (regexp): " nil query-replace-from-history-variable)) @@ -603,9 +613,8 @@ Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to (list from to (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)) - (if (use-region-p) (region-noncontiguous-p))))) + (use-region-beginning) (use-region-end) + (use-region-noncontiguous-p)))) (let (replacements) (if (listp to-strings) (setq replacements to-strings) @@ -665,9 +674,10 @@ which will run faster and will not set the mark or print anything. and TO-STRING is also null.)" (declare (interactive-only "use `search-forward' and `replace-match' instead.") - (interactive-args + (interactive-args (start (use-region-beginning)) - (end (use-region-end)))) + (end (use-region-end)) + (region-noncontiguous-p (use-region-noncontiguous-p)))) (interactive (let ((common (query-replace-read-args @@ -681,7 +691,7 @@ and TO-STRING is also null.)" (list (nth 0 common) (nth 1 common) (nth 2 common) (use-region-beginning) (use-region-end) (nth 3 common) - (if (use-region-p) (region-noncontiguous-p))))) + (use-region-noncontiguous-p)))) (perform-replace from-string to-string nil nil delimited nil nil start end backward region-noncontiguous-p)) (defun replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p) @@ -746,7 +756,11 @@ What you probably want is a loop like this: (replace-match TO-STRING nil nil)) which will run faster and will not set the mark or print anything." (declare (interactive-only - "use `re-search-forward' and `replace-match' instead.")) + "use `re-search-forward' and `replace-match' instead.") + (interactive-args + (start (use-region-beginning)) + (end (use-region-end)) + (region-noncontiguous-p (use-region-noncontiguous-p)))) (interactive (let ((common (query-replace-read-args @@ -758,10 +772,9 @@ which will run faster and will not set the mark or print anything." (if (use-region-p) " in region" "")) t))) (list (nth 0 common) (nth 1 common) (nth 2 common) - (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)) + (use-region-beginning) (use-region-end) (nth 3 common) - (if (use-region-p) (region-noncontiguous-p))))) + (use-region-noncontiguous-p)))) (perform-replace regexp to-string nil t delimited nil nil start end backward region-noncontiguous-p)) diff --git a/lisp/simple.el b/lisp/simple.el index 2512397b24..60f2ad3452 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6878,6 +6878,10 @@ point otherwise." "Return the end of the region if `use-region-p'." (and (use-region-p) (region-end))) +(defun use-region-noncontiguous-p () + "Return non-nil for a non-contiguous region if `use-region-p'." + (and (use-region-p) (region-noncontiguous-p))) + (defun use-region-p () "Return t if the region is active and it is appropriate to act on it. This is used by commands that act specially on the region under @@ -6922,7 +6926,7 @@ see `region-noncontiguous-p' and `extract-rectangle-bounds'." "Return non-nil if the region contains several pieces. An example is a rectangular region handled as a list of separate contiguous regions for each line." - (cdr (region-bounds))) + (let ((bounds (region-bounds))) (and (cdr bounds) bounds))) (defun redisplay--unhighlight-overlay-function (rol) "If ROL is an overlay, call `delete-overlay'." diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index cd726ad477..c500dc014f 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -514,9 +514,9 @@ Second and third arg START and END specify the region to operate on. If optional argument NO-QUERY is non-nil, make changes without asking for confirmation. You can use `repunctuate-sentences-filter' to add filters to skip occurrences of spaces that don't need to be replaced." - (interactive (list nil - (if (use-region-p) (region-beginning)) - (if (use-region-p) (region-end)))) + (declare (interactive-args (start (use-region-beginning)) + (end (use-region-end)))) + (interactive (list nil (use-region-beginning) (use-region-end))) (let ((regexp "\\([]\"')]?\\)\\([.?!]\\)\\([]\"')]?\\) +") (to-string "\\1\\2\\3 ")) (if no-query commit ad6878005dbde428809c1f587555238892dd253d Author: Lars Ingebrigtsen Date: Sun Sep 4 16:29:06 2022 +0200 Add a basic widget type for buffer predicates * lisp/paren.el (show-paren-predicate): * lisp/outline.el (outline-minor-mode-use-buttons): Use it. * lisp/wid-edit.el (buffer-predicate): New widget type. diff --git a/lisp/outline.el b/lisp/outline.el index 2e18fd5b8f..178cbe3071 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -288,8 +288,7 @@ The value should be a `buffer-match-p' condition. These buttons can be used to hide and show the body under the heading. Note that this feature is not meant to be used in editing buffers (yet) -- that will be amended in a future version." - ;; FIXME -- is there a `buffer-match-p' defcustom type somewhere? - :type 'sexp + :type 'buffer-predicate :safe #'booleanp :version "29.1") diff --git a/lisp/paren.el b/lisp/paren.el index 13e219c8f6..e2c060ceb9 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -123,7 +123,7 @@ On non-graphical frames, the context is shown in the echo area." The default is to enable the mode in all buffers that have don't derive from `special-mode', which means that it's on (by default) in all editing buffers." - :type 'sexp + :type 'buffer-predicate :safe #'booleanp :version "29.1") diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index ec2eb146e9..9aec6b0244 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -4145,6 +4145,15 @@ is inline." (define-obsolete-function-alias 'widget-visibility-value-create #'widget-toggle-value-create "29.1") +;;; Buffer predicates. +(define-widget 'buffer-predicate 'lazy + "A buffer predicate." + :tag "Buffer predicate" + :type '(choice (const :tag "All buffers" t) + (const :tag "No buffers" nil) + ;; FIXME: This should be expanded somehow. + sexp)) + (provide 'wid-edit) ;;; wid-edit.el ends here commit 9aed695241a8919d422d5812dd62325720961153 Author: Eli Zaretskii Date: Sun Sep 4 16:30:03 2022 +0300 ; * doc/lispref/sequences.texi (Sequence Functions): Fix punctuation. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 214b1e76e1..12c15e6f9a 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -682,9 +682,9 @@ for which @var{predicate} returns @code{nil}. @defun seq-remove-at-position sequence n @cindex removing from sequences - This function returns a copy of @var{sequence} where the element at - (zero-based) index @var{n} got removed. The result is a sequence of - the same type as @var{sequence}. +This function returns a copy of @var{sequence} where the element at +(zero-based) index @var{n} got removed. The result is a sequence of +the same type as @var{sequence}. @example @group commit bcde498a734bcf518331dbae8573915021823810 Merge: fd47e62b01 55ff36485f Author: Eli Zaretskii Date: Sun Sep 4 16:27:55 2022 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit fd47e62b015ed6873261a3fbdbad3c4b23faa8f2 Author: Eli Zaretskii Date: Sun Sep 4 16:27:05 2022 +0300 ; * etc/NEWS: Fix a recently-added entry. diff --git a/etc/NEWS b/etc/NEWS index 6c0cf19fe6..4c596fd17e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2200,8 +2200,9 @@ Note that this historical web browser is different from Mozilla Firefox; it is its predecessor. ** Python Mode + +++ -*** Project shells and a new user option 'python-shell-dedicated' +*** Project shells and a new user option 'python-shell-dedicated'. When called with a prefix argument, 'run-python' now offers the choice of creating a shell dedicated to the current project. This shell runs in the project root directory and is shared among all project buffers. commit 55ff36485f42777a4eaecd187cd25da5a7c153cd Author: Po Lu Date: Sun Sep 4 21:03:31 2022 +0800 Fix earlier change to xterm.c * src/xterm.c (x_detect_focus_change): Finally figure out what the call to x_new_focus_frame does with the core focus, and do the equivalent with the XInput 2 focus. diff --git a/src/xterm.c b/src/xterm.c index accd1b90fb..c58f2d15da 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13174,7 +13174,12 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, void x_mouse_leave (struct x_display_info *dpyinfo) { - Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; +#if defined HAVE_XINPUT2 && !defined USE_X_TOOLKIT + struct xi_device_t *device; +#endif + Mouse_HLInfo *hlinfo; + + hlinfo = &dpyinfo->mouse_highlight; if (hlinfo->mouse_face_mouse_frame) { @@ -13182,13 +13187,30 @@ x_mouse_leave (struct x_display_info *dpyinfo) hlinfo->mouse_face_mouse_frame = NULL; } -#ifdef HAVE_XINPUT2 +#if defined HAVE_XINPUT2 && !defined USE_X_TOOLKIT if (!dpyinfo->supports_xi2) - /* I don't understand what the call below is supposed to do. But - reading dpyinfo->x_focus_event_frame is invalid on input - extension builds, so disable it there. */ + /* The call below is supposed to reset the implicit focus and + revert the focus back to the last explicitly focused frame. It + doesn't work on input extension builds because focus tracking + does not set x_focus_event_frame, and proceeds on a per-device + basis. On such builds, clear the implicit focus of the client + pointer instead. */ #endif x_new_focus_frame (dpyinfo, dpyinfo->x_focus_event_frame); +#if defined HAVE_XINPUT2 && !defined USE_X_TOOLKIT + else + { + if (dpyinfo->client_pointer_device == -1) + /* If there's no client pointer device, then no implicit focus + is currently set. */ + return; + + device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device); + + if (device) + device->focus_implicit_frame = NULL; + } +#endif } #endif commit f1635c8efb30cd42b83e31aa29be58aeb2965a9a Author: Michael Albinus Date: Sun Sep 4 13:44:30 2022 +0200 Fix rx forms in Tramp * lisp/net/tramp.el (tramp-restricted-shell-hosts-alist) (tramp-local-host-regexp, tramp-echoed-echo-mark-regexp) (tramp-login-prompt-regexp, tramp-terminal-prompt-regexp) (tramp-antispoof-regexp) (tramp-build-completion-file-name-regexp) (tramp-debug-outline-regexp) (tramp-use-absolute-autoload-file-names) (tramp-lock-file-info-regexp, tramp-shell-quote-argument): * lisp/net/tramp-adb.el (tramp-do-parse-file-attributes-with-ls) * lisp/net/tramp-cache.el (tramp-flush-file-function): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name): * lisp/net/tramp-integration.el (tramp-rfn-eshadow-update-overlay-regexp) (info-lookup-maybe-add-help): * lisp/net/tramp-sh.el (tramp-default-user-alist, tramp-sunos-unames) (tramp-scp-direct-remote-copying, tramp-get-remote-locale): * lisp/net/tramp-smb.el (tramp-smb-prompt, tramp-smb-wrong-passwd-regexp) (tramp-smb-errors, tramp-smb-get-localname) (tramp-smb-read-file-entry): Simplify rx forms. * lisp/net/tramp.el (tramp-handle-find-backup-file-name) (tramp-handle-lock-file, tramp-handle-make-auto-save-file-name): * lisp/net/tramp-adb.el (tramp-adb-handle-set-file-times) (tramp-adb-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-attributes-with-gvfs-ls-regexp): * lisp/net/tramp-sh.el (tramp-open-shell, tramp-find-shell): Do not use `eval-when-compile'. * lisp/net/tramp-cmds.el (tramp-rename-files, tramp-rename-these-files): Use rx. * lisp/net/tramp-gvfs.el (tramp-gvfs-password-tcrypt): New defonst. (tramp-gvfs-handle-file-attributes): Use `number-to-string'. * test/lisp/net/tramp-archive-tests.el (tramp-archive-test17-insert-directory): * test/lisp/net/tramp-tests.el (tramp-test17-insert-directory) (tramp--test-share-p): Simplify rx forms. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index b38b908edb..ab38ffa0cf 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -278,10 +278,10 @@ arguments to pass to the OPERATION." (name (match-string 6)) (symlink-target (and is-symlink - (cadr (split-string name (rx (group (| " -> " "\n")))))))) + (cadr (split-string name (rx (| " -> " "\n"))))))) (push (list (if is-symlink - (car (split-string name (rx (group (| " -> " "\n"))))) + (car (split-string name (rx (| " -> " "\n")))) name) (or is-dir symlink-target) 1 ;link-count @@ -560,10 +560,9 @@ Emacs dired can't find files." ;; (introduced in POSIX.1-2008) fails. (tramp-adb-send-command-and-check v (format - (eval-when-compile - (concat "touch -d %s %s %s 2>%s || " - "touch -d %s %s %s 2>%s || " - "touch -t %s %s %s")) + (concat "touch -d %s %s %s 2>%s || " + "touch -d %s %s %s 2>%s || " + "touch -t %s %s %s") (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) nofollow quoted-name (tramp-get-remote-null-device v) (format-time-string "%Y-%m-%dT%H:%M:%S" time t) @@ -1284,11 +1283,10 @@ connection if a previous connection has died for some reason." (tramp-message vec 5 "Checking system information") (tramp-adb-send-command vec - (eval-when-compile - (concat - "echo \\\"`getprop ro.product.model` " - "`getprop ro.product.version` " - "`getprop ro.build.version.release`\\\""))) + (concat + "echo \\\"`getprop ro.product.model` " + "`getprop ro.product.version` " + "`getprop ro.build.version.release`\\\"")) (let ((old-getprop (tramp-get-connection-property vec "getprop")) (new-getprop (tramp-set-connection-property diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 0d931b42da..c25d509671 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -185,14 +185,14 @@ It must be supported by libarchive(3).") (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." '(rx bos - ;; \1 + ;; This group is used in `tramp-archive-file-name-archive'. (group (+ nonl) ;; Default suffixes ... "." (regexp (regexp-opt tramp-archive-suffixes)) ;; ... with compression. (? "." (regexp (regexp-opt tramp-archive-compression-suffixes)))) - ;; \2 + ;; This group is used in `tramp-archive-file-name-localname'. (group "/" (* nonl)) eos))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 6a3e60f703..4c745092a3 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -278,7 +278,7 @@ Remove also properties of all files in subdirectories." This is suppressed for temporary buffers." (save-match-data (unless (or (null (buffer-name)) - (string-match-p (rx bos (| " " "*")) (buffer-name))) + (string-match-p (rx bos (| space "*")) (buffer-name))) (let ((bfn (if (stringp (buffer-file-name)) (buffer-file-name) default-directory)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index a7ac135266..ad531b427a 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -355,7 +355,7 @@ The remote connection identified by SOURCE is flushed by (dir (tramp-rename-read-file-name-dir default)) (init (tramp-rename-read-file-name-init default)) (tramp-ignored-file-name-regexp - (regexp-quote (file-remote-p source)))) + (rx (literal (file-remote-p source))))) (read-file-name-default "Enter new Tramp connection: " dir default 'confirm init #'file-directory-p))))) @@ -466,7 +466,7 @@ For details, see `tramp-rename-files'." (dir (tramp-rename-read-file-name-dir default)) (init (tramp-rename-read-file-name-init default)) (tramp-ignored-file-name-regexp - (regexp-quote (file-remote-p source)))) + (rx (literal (file-remote-p source))))) (read-file-name-default (format "Change Tramp connection `%s': " source) dir default 'confirm init #'file-directory-p))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 9060f37ed5..9c81bccffc 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -316,6 +316,10 @@ It has been changed in GVFS 1.14.") (defconst tramp-gvfs-password-anonymous-supported 16 "Operation supports anonymous users.") +;; Since: 2.58 +(defconst tramp-gvfs-password-tcrypt 32 + "Operation takes TCRYPT parameters.") + ;; For the time being, we just need org.goa.Account and org.goa.Files ;; interfaces. We document the other ones, just in case. @@ -710,11 +714,10 @@ It has been changed in GVFS 1.14.") "unix::device") "GVFS file attributes.")) -(eval-and-compile - (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) - "=" (group (+? nonl))) - "Regexp to parse GVFS file attributes with `gvfs-ls'.")) +(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp + (rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + "=" (group (+? nonl))) + "Regexp to parse GVFS file attributes with `gvfs-ls'.") (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp (rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes))) @@ -1317,7 +1320,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (eq id-format 'integer) (string-to-number (or (cdr (assoc "unix::uid" attributes)) - (eval-when-compile (format "%s" tramp-unknown-id-integer)))) + (number-to-string tramp-unknown-id-integer))) (or (cdr (assoc "owner::user" attributes)) (cdr (assoc "unix::uid" attributes)) tramp-unknown-id-string))) @@ -1325,7 +1328,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (if (eq id-format 'integer) (string-to-number (or (cdr (assoc "unix::gid" attributes)) - (eval-when-compile (format "%s" tramp-unknown-id-integer)))) + (number-to-string tramp-unknown-id-integer))) (or (cdr (assoc "owner::group" attributes)) (cdr (assoc "unix::gid" attributes)) tramp-unknown-id-string))) @@ -1726,7 +1729,7 @@ ID-FORMAT valid values are `string' and `integer'." "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier (replace-regexp-in-string - (rx bol (* nonl) "/" (+ (not (any "/"))) eol) "\\1" object-path))) + (rx bol (* nonl) "/" (group (+ (not (any "/")))) eol) "\\1" object-path))) (defun tramp-gvfs-url-host (url) "Return the host name part of URL, a string. diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 946f972502..afc3e94580 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -86,7 +86,7 @@ special handling of `substitute-in-file-name'." (defun tramp-rfn-eshadow-update-overlay-regexp () "An overlay covering the shadowed part of the filename." (rx-to-string - `(: (* (not (any ,tramp-postfix-host-format "/~"))) (or "/" "~")))) + `(: (* (not (any ,tramp-postfix-host-format "/~"))) (| "/" "~")))) (defun tramp-rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. @@ -218,11 +218,11 @@ NAME must be equal to `tramp-current-connection'." :mode 'tramp-info-lookup-mode :topic 'symbol :regexp (rx (+ (not (any "\t\n \"'(),[]`‘’")))) :doc-spec '(("(tramp)Function Index" nil - (rx bol " " (+ "-") " " (* nonl) ": ") - (rx (group (| " " eol)))) + (rx bol space (+ "-") space (* nonl) ": ") + (rx (| space eol))) ("(tramp)Variable Index" nil - (rx bol " " (+ "-") " " (* nonl) ": ") - (rx (group (| " " eol)))))) + (rx bol space (+ "-") space (* nonl) ": ") + (rx (| space eol))))) (add-hook 'tramp-integration-unload-hook diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2489ac9aec..dfb87059bd 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -414,15 +414,13 @@ The string is used in `tramp-methods'.") ,(rx bos (literal tramp-root-id-string) eos) "su")) (add-to-list 'tramp-default-user-alist - `(,(rx bos (regexp (regexp-opt '("su" "sudo" "doas" "ksu"))) eos) + `(,(rx bos (| "su" "sudo" "doas" "ksu") eos) nil ,tramp-root-id-string)) ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored. ;; Do not add "plink" based methods, they ask interactively for the user. (add-to-list 'tramp-default-user-alist `(,(rx bos - (regexp - (regexp-opt - '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))) + (| "rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp") eos) nil ,(user-login-name)))) @@ -1250,7 +1248,7 @@ component is used as the target of the symlink." (tramp-do-file-attributes-with-perl v localname)) (t (tramp-do-file-attributes-with-ls v localname))))))) -(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) +(defconst tramp-sunos-unames (rx (| "SunOS 5.10" "SunOS 5.11")) "Regexp to determine remote SunOS.") (defun tramp-sh--quoting-style-options (vec) @@ -4237,10 +4235,9 @@ file exists and nonzero exit status otherwise." ;; first. (tramp-send-command vec (format - (eval-when-compile - (concat - "exec env TERM='%s' INSIDE_EMACS='%s' " - "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")) + (concat + "exec env TERM='%s' INSIDE_EMACS='%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i") tramp-terminal-type (tramp-inside-emacs) (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) @@ -4316,10 +4313,9 @@ file exists and nonzero exit status otherwise." default-shell (tramp-message vec 2 - (eval-when-compile - (concat - "Couldn't find a remote shell which groks tilde " - "expansion, using `%s'")) + (concat + "Couldn't find a remote shell which groks tilde " + "expansion, using `%s'") default-shell))) default-shell))) @@ -4980,7 +4976,8 @@ Goes through the list `tramp-inline-compress-commands'." string (and (string-match - (rx bol (+ (not (any " #"))) " " (+ (not space)) " " + (rx bol (+ (not (any space "#"))) space + (+ (not space)) space (group (+ (not space))) eol) string) (match-string 1 string)) @@ -5554,7 +5551,7 @@ Nonexistent directories are removed from spec." (while candidates (goto-char (point-min)) (if (string-match-p - (rx bol (literal (car candidates))"%s" (? "\r") eol) + (rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 9e63d53262..3d65520282 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -98,15 +98,14 @@ this variable \"client min protocol=NT1\"." "Regexp of SMB server identification.") (defconst tramp-smb-prompt - (rx bol (| (: (| "smb:" "PS") " " (+ nonl) "> ") + (rx bol (| (: (| "smb:" "PS") space (+ nonl) "> ") (: (+ space) "Server" (+ space) "Comment" eol))) "Regexp used as prompt in smbclient or powershell.") (defconst tramp-smb-wrong-passwd-regexp - (regexp-opt - '("NT_STATUS_LOGON_FAILURE" - "NT_STATUS_WRONG_PASSWORD")) + (rx (| "NT_STATUS_LOGON_FAILURE" + "NT_STATUS_WRONG_PASSWORD")) "Regexp for login error strings of SMB servers.") (defconst tramp-smb-errors @@ -116,57 +115,56 @@ this variable \"client min protocol=NT1\"." "Call timed out: server did not respond" (: (+ (not space)) ": command not found") "Server doesn't support UNIX CIFS calls" - (regexp (regexp-opt - '(;; Samba. - "ERRDOS" - "ERRHRD" - "ERRSRV" - "ERRbadfile" - "ERRbadpw" - "ERRfilexists" - "ERRnoaccess" - "ERRnomem" - "ERRnosuchshare" - ;; See /usr/include/samba-4.0/core/ntstatus.h. - ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), - ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), - ;; Windows 6.3 (Windows Server 2012, Windows 10). - "NT_STATUS_ACCESS_DENIED" - "NT_STATUS_ACCOUNT_LOCKED_OUT" - "NT_STATUS_BAD_NETWORK_NAME" - "NT_STATUS_CANNOT_DELETE" - "NT_STATUS_CONNECTION_DISCONNECTED" - "NT_STATUS_CONNECTION_REFUSED" - "NT_STATUS_CONNECTION_RESET" - "NT_STATUS_DIRECTORY_NOT_EMPTY" - "NT_STATUS_DUPLICATE_NAME" - "NT_STATUS_FILE_IS_A_DIRECTORY" - "NT_STATUS_HOST_UNREACHABLE" - "NT_STATUS_IMAGE_ALREADY_LOADED" - "NT_STATUS_INVALID_LEVEL" - "NT_STATUS_INVALID_PARAMETER" - "NT_STATUS_INVALID_PARAMETER_MIX" - "NT_STATUS_IO_TIMEOUT" - "NT_STATUS_LOGON_FAILURE" - "NT_STATUS_NETWORK_ACCESS_DENIED" - "NT_STATUS_NOT_IMPLEMENTED" - "NT_STATUS_NO_LOGON_SERVERS" - "NT_STATUS_NO_SUCH_FILE" - "NT_STATUS_NO_SUCH_USER" - "NT_STATUS_NOT_A_DIRECTORY" - "NT_STATUS_NOT_SUPPORTED" - "NT_STATUS_OBJECT_NAME_COLLISION" - "NT_STATUS_OBJECT_NAME_INVALID" - "NT_STATUS_OBJECT_NAME_NOT_FOUND" - "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" - "NT_STATUS_PASSWORD_MUST_CHANGE" - "NT_STATUS_RESOURCE_NAME_NOT_FOUND" - "NT_STATUS_REVISION_MISMATCH" - "NT_STATUS_SHARING_VIOLATION" - "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" - "NT_STATUS_UNSUCCESSFUL" - "NT_STATUS_WRONG_PASSWORD"))))) + (| ;; Samba. + "ERRDOS" + "ERRHRD" + "ERRSRV" + "ERRbadfile" + "ERRbadpw" + "ERRfilexists" + "ERRnoaccess" + "ERRnomem" + "ERRnosuchshare" + ;; See /usr/include/samba-4.0/core/ntstatus.h. + ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), + ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), + ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), + ;; Windows 6.3 (Windows Server 2012, Windows 10). + "NT_STATUS_ACCESS_DENIED" + "NT_STATUS_ACCOUNT_LOCKED_OUT" + "NT_STATUS_BAD_NETWORK_NAME" + "NT_STATUS_CANNOT_DELETE" + "NT_STATUS_CONNECTION_DISCONNECTED" + "NT_STATUS_CONNECTION_REFUSED" + "NT_STATUS_CONNECTION_RESET" + "NT_STATUS_DIRECTORY_NOT_EMPTY" + "NT_STATUS_DUPLICATE_NAME" + "NT_STATUS_FILE_IS_A_DIRECTORY" + "NT_STATUS_HOST_UNREACHABLE" + "NT_STATUS_IMAGE_ALREADY_LOADED" + "NT_STATUS_INVALID_LEVEL" + "NT_STATUS_INVALID_PARAMETER" + "NT_STATUS_INVALID_PARAMETER_MIX" + "NT_STATUS_IO_TIMEOUT" + "NT_STATUS_LOGON_FAILURE" + "NT_STATUS_NETWORK_ACCESS_DENIED" + "NT_STATUS_NOT_IMPLEMENTED" + "NT_STATUS_NO_LOGON_SERVERS" + "NT_STATUS_NO_SUCH_FILE" + "NT_STATUS_NO_SUCH_USER" + "NT_STATUS_NOT_A_DIRECTORY" + "NT_STATUS_NOT_SUPPORTED" + "NT_STATUS_OBJECT_NAME_COLLISION" + "NT_STATUS_OBJECT_NAME_INVALID" + "NT_STATUS_OBJECT_NAME_NOT_FOUND" + "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" + "NT_STATUS_PASSWORD_MUST_CHANGE" + "NT_STATUS_RESOURCE_NAME_NOT_FOUND" + "NT_STATUS_REVISION_MISMATCH" + "NT_STATUS_SHARING_VIOLATION" + "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" + "NT_STATUS_UNSUCCESSFUL" + "NT_STATUS_WRONG_PASSWORD"))) "Regexp for possible error strings of SMB servers. Used instead of analyzing error codes of commands.") @@ -1658,11 +1656,11 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." ""))) ;; Sometimes we have discarded `substitute-in-file-name'. - (when (string-match (rx (group "$$") (group (| "/" eol))) localname) + (when (string-match (rx (group "$$") (| "/" eol)) localname) (setq localname (replace-match "$" nil nil localname 1))) ;; A trailing space is not supported. - (when (string-match-p (rx " " eol) localname) + (when (string-match-p (rx space eol) localname) (tramp-error vec 'file-error "Invalid file name %s" (tramp-make-tramp-file-name vec localname))) @@ -1821,7 +1819,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; weekday. - (if (string-match-p (rx (group (+ wordchar)) eol) line) + (if (string-match-p (rx (+ wordchar) eol) line) (setq line (substring line 0 -5)) (cl-return)) @@ -1856,7 +1854,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; localname. (if (string-match (rx bol (+ space) - (group (not space) (? (group (* nonl) (not space)))) + (group (not space) (? (* nonl) (not space))) (* space) eol) line) (setq localname (match-string 1 line)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bb6eeaa741..bf8c5d4a3d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -516,8 +516,8 @@ interpreted as a regular expression which always matches." (defcustom tramp-restricted-shell-hosts-alist (when (and (eq system-type 'windows-nt) (not (string-match-p (rx "sh" eol) tramp-encoding-shell))) - (list (rx bos (group (| (literal (downcase tramp-system-name)) - (literal (upcase tramp-system-name)))) + (list (rx bos (| (literal (downcase tramp-system-name)) + (literal (upcase tramp-system-name))) eos))) "List of hosts, which run a restricted shell. This is a list of regular expressions, which denote hosts running @@ -530,9 +530,8 @@ host runs a restricted shell, it shall be added to this list, too." ;;;###tramp-autoload (defcustom tramp-local-host-regexp (rx bos - (regexp (regexp-opt - `("localhost" "localhost4" "localhost6" - ,tramp-system-name "127.0.0.1" "::1"))) + (| (literal tramp-system-name) + (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1")) eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." @@ -582,7 +581,7 @@ usually suffice.") (defconst tramp-echoed-echo-mark-regexp (rx-to-string `(: ,tramp-echo-mark-marker - (= ,tramp-echo-mark-marker-length (group "\b" (? " \b"))))) + (= ,tramp-echo-mark-marker-length "\b" (? " \b")))) "Regexp which matches `tramp-echo-mark' as it gets echoed by \ the remote shell.") @@ -599,7 +598,7 @@ if you need to change this." :type 'string) (defcustom tramp-login-prompt-regexp - (rx (* nonl) (group (| "user" "login")) (? (group " " (* nonl))) ":" (* " ")) + (rx (* nonl) (| "user" "login") (? space (* nonl)) ":" (* space)) "Regexp matching login-like prompts. The regexp should match at end of buffer. @@ -692,9 +691,8 @@ files conditionalize this setup based on the TERM environment variable." :type 'string) (defcustom tramp-terminal-prompt-regexp - (rx (group - (| (: "TERM = (" (* nonl) ")") - (: "Terminal type? [" (* nonl) "]"))) + (rx (| (: "TERM = (" (* nonl) ")") + (: "Terminal type? [" (* nonl) "]")) (* space)) "Regular expression matching all terminal setting prompts. The regexp should match at end of buffer. @@ -706,7 +704,7 @@ The answer will be provided by `tramp-action-terminal', which see." ;; "-no-antispoof". However, since we don't know which PuTTY ;; version is installed, we must react interactively. (defcustom tramp-antispoof-regexp - (rx (literal "Access granted. Press Return to begin session. ")) + (rx "Access granted. Press Return to begin session. ") "Regular expression matching plink's anti-spoofing message. The regexp should match at end of buffer." :version "27.1" @@ -1177,7 +1175,7 @@ The `ftp' syntax does not support methods.") "Return `tramp-completion-file-name-regexp' according to `tramp-syntax'." (if (eq tramp-syntax 'separate) ;; FIXME: This shouldn't be necessary. - (rx bos "/" (? (group "[" (* (not (any "]"))))) eos) + (rx bos "/" (? "[" (* (not (any "]")))) eos) (rx bos ;; `file-name-completion' uses absolute paths for matching. ;; This means that on W32 systems, something like @@ -1942,11 +1940,11 @@ of `current-buffer'." (defconst tramp-debug-outline-regexp (rx ;; Timestamp. - (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) " " + (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) space ;; Thread. - (? (group "#") " ") + (? (group "#") space) ;; Function name, verbosity. - (+ (any "-" alnum)) " (" (group (group (+ digit))) ") #") + (+ (any "-" alnum)) " (" (group (+ digit)) ") #") "Used for highlighting Tramp debug buffers in `outline-mode'.") (defconst tramp-debug-font-lock-keywords @@ -2804,7 +2802,7 @@ remote file names." #'file-name-sans-extension (directory-files dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos))))) - (files-regexp (rx bol (: (regexp (regexp-opt files))) eol))) + (files-regexp (rx bol (regexp (regexp-opt files)) eol))) (mapatoms (lambda (atom) (when (and (functionp atom) @@ -3038,58 +3036,58 @@ not in completion mode." (defun tramp-completion-dissect-file-name (name) "Return a list of `tramp-file-name' structures for NAME. They are collected by `tramp-completion-dissect-file-name1'." - (let* (;; "/method" "/[method" - (tramp-completion-file-name-structure1 - (list - (rx (regexp tramp-prefix-regexp) - (group (? (regexp tramp-completion-method-regexp))) eol) - 1 nil nil nil)) - ;; "/method:user" "/[method/user" - (tramp-completion-file-name-structure2 - (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (? (regexp tramp-user-regexp))) eol) - 1 2 nil nil)) - ;; "/method:host" "/[method/host" - (tramp-completion-file-name-structure3 - (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (? (regexp tramp-host-regexp))) eol) - 1 nil 2 nil)) - ;; "/method:[ipv6" "/[method/ipv6" - (tramp-completion-file-name-structure4 - (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (regexp tramp-prefix-ipv6-regexp) - (group (? (regexp tramp-ipv6-regexp))) eol) - 1 nil 2 nil)) - ;; "/method:user@host" "/[method/user@host" - (tramp-completion-file-name-structure5 - (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (regexp tramp-user-regexp)) - (regexp tramp-postfix-user-regexp) - (group (? (regexp tramp-host-regexp))) eol) - 1 2 3 nil)) - ;; "/method:user@[ipv6" "/[method/user@ipv6" - (tramp-completion-file-name-structure6 - (list - (rx (regexp tramp-prefix-regexp) - (group (regexp tramp-method-regexp)) - (regexp tramp-postfix-method-regexp) - (group (regexp tramp-user-regexp)) - (regexp tramp-postfix-user-regexp) - (regexp tramp-prefix-ipv6-regexp) - (group (? (regexp tramp-ipv6-regexp))) eol) - 1 2 3 nil))) + (let (;; "/method" "/[method" + (tramp-completion-file-name-structure1 + (list + (rx (regexp tramp-prefix-regexp) + (group (? (regexp tramp-completion-method-regexp))) eol) + 1 nil nil nil)) + ;; "/method:user" "/[method/user" + (tramp-completion-file-name-structure2 + (list + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-user-regexp))) eol) + 1 2 nil nil)) + ;; "/method:host" "/[method/host" + (tramp-completion-file-name-structure3 + (list + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-host-regexp))) eol) + 1 nil 2 nil)) + ;; "/method:[ipv6" "/[method/ipv6" + (tramp-completion-file-name-structure4 + (list + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) + 1 nil 2 nil)) + ;; "/method:user@host" "/[method/user@host" + (tramp-completion-file-name-structure5 + (list + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (group (? (regexp tramp-host-regexp))) eol) + 1 2 3 nil)) + ;; "/method:user@[ipv6" "/[method/user@ipv6" + (tramp-completion-file-name-structure6 + (list + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) + 1 2 3 nil))) (delq nil (mapcar @@ -3356,14 +3354,14 @@ User is always nil." registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol)))) (defun tramp-parse-putty-group (registry) - "Return a (user host) tuple allowed to access. + "Return a (user host) tuple allowed to access. User is always nil." - (let (result - (regexp (rx (literal registry) "\\" (group (+ nonl))))) - (when (re-search-forward regexp (line-end-position) t) - (setq result (list nil (match-string 1)))) - (forward-line 1) - result)) + (let (result + (regexp (rx (literal registry) "\\" (group (+ nonl))))) + (when (re-search-forward regexp (line-end-position) t) + (setq result (list nil (match-string 1)))) + (forward-line 1) + result)) ;;; Skeleton macros for file name handler functions. @@ -4104,10 +4102,9 @@ Let-bind it when necessary.") (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (eval-when-compile - (concat - "Backup file on local temporary directory, " - "do you want to continue?")))))) + (concat + "Backup file on local temporary directory, " + "do you want to continue?"))))) (tramp-error v 'file-error "Unsafe backup file name")))))) (defun tramp-handle-insert-directory @@ -4439,7 +4436,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (rx bos (group (+ nonl)) "@" (group (+ nonl)) "." (group (+ digit)) - (? ":" (group (+ digit))) eos) + (? ":" (+ digit)) eos) "The format of a lock file.") (defun tramp-handle-file-locked-p (file) @@ -4494,10 +4491,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (eval-when-compile - (concat - "Lock file on local temporary directory, " - "do you want to continue?")))))) + (concat + "Lock file on local temporary directory, " + "do you want to continue?"))))) (tramp-error v 'file-error "Unsafe lock file name"))) ;; Do the lock. @@ -6112,10 +6108,9 @@ this file, if that variable is non-nil." (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (eval-when-compile - (concat - "Autosave file on local temporary directory, " - "do you want to continue?")))))) + (concat + "Autosave file on local temporary directory, " + "do you want to continue?"))))) (tramp-error v 'file-error "Unsafe autosave file name")))))) (defun tramp-subst-strs-in-string (alist string) @@ -6389,15 +6384,13 @@ would use a wrong quoting for local file names. See `w32-shell-name'." Only works for Bourne-like shells." (let ((system-type 'not-windows)) (save-match-data - (let ((result (tramp-unquote-shell-quote-argument s)) - (nl (regexp-quote (format "\\%s" tramp-rsh-end-of-line)))) + (let ((result (tramp-unquote-shell-quote-argument s))) (when (and (>= (length result) 2) (string= (substring result 0 2) "\\~")) (setq result (substring result 1))) - (while (string-match nl result) - (setq result (replace-match (format "'%s'" tramp-rsh-end-of-line) - t t result))) - result)))) + (replace-regexp-in-string + (rx "\\" (literal tramp-rsh-end-of-line)) + (format "'%s'" tramp-rsh-end-of-line) result))))) ;;; Signal handling. This works for remote processes, which have set ;;; the process property `remote-pid'. diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 964404b4bf..aa5d1cc496 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -622,7 +622,7 @@ This checks also `file-name-as-directory', `file-name-directory', (goto-char (point-min)) (should (looking-at-p - (rx bol (+ nonl) " " (literal tramp-archive-test-archive) eol)))) + (rx bol (+ nonl) space (literal tramp-archive-test-archive) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tramp-archive-test-archive) @@ -633,14 +633,14 @@ This checks also `file-name-as-directory', `file-name-directory', (rx-to-string `(: ;; There might be a summary line. - (? "total" (+ nonl) (+ digit) (? " ") + (? "total" (+ nonl) (+ digit) (? space) (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") ;; We don't know in which order the files appear. (= ,(length (directory-files tramp-archive-test-archive)) - (+ nonl) " " + (+ nonl) space (regexp ,(regexp-opt (directory-files tramp-archive-test-archive))) - (? " ->" (one-or-more nonl)) "\n")))))) + (? " ->" (+ nonl)) "\n")))))) ;; Check error case. (with-temp-buffer (should-error diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index bc67ff2ace..fed1d881c5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3222,13 +3222,13 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (insert-directory tmp-name1 "-al") (goto-char (point-min)) (should - (looking-at-p (rx bol (+ nonl) " " (literal tmp-name1) eol)))) + (looking-at-p (rx bol (+ nonl) space (literal tmp-name1) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al") (goto-char (point-min)) (should (looking-at-p - (rx bol (+ nonl) " " (literal tmp-name1) "/" eol)))) + (rx bol (+ nonl) space (literal tmp-name1) "/" eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) @@ -3238,11 +3238,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (rx-to-string `(: ;; There might be a summary line. - (? "total" (+ nonl) (+ digit) (? " ") + (? "total" (+ nonl) (+ digit) (? space) (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") ;; We don't know in which order ".", ".." and "foo" appear. (= ,(length (directory-files tmp-name1)) - (+ nonl) " " + (+ nonl) space (regexp ,(regexp-opt (directory-files tmp-name1))) (? " ->" (+ nonl)) "\n")))))) @@ -6703,7 +6703,7 @@ Additionally, ls does not support \"--dired\"." "Check, whether the method needs a share." (and (tramp--test-gvfs-p) (string-match-p - (rx bol (or "afp" (: "dav" (opt "s")) "smb") eol) + (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) (file-remote-p ert-remote-temporary-file-directory 'method)))) (defun tramp--test-sshfs-p () commit 4751b51d5e1182975aa002af08a625e4859ec276 Author: Damien Cassou Date: Sun Sep 4 13:21:59 2022 +0200 Add new function `seq-positions' * doc/lispref/sequences.texi (Sequence Functions): Document it. * lisp/emacs-lisp/seq.el (seq-positions): New function. * lisp/emacs-lisp/shortdoc.el (sequence): Mention it. * test/lisp/emacs-lisp/seq-tests.el (test-seq-positions): Test it (bug#57548). diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 2ee19efb1a..214b1e76e1 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -898,6 +898,27 @@ use instead of the default @code{equal}. @end example @end defun +@defun seq-positions sequence elt &optional testfn + This function returns a list of the (zero-based) indices of the +elements in @var{sequence} for which @var{testfn} returns +non-@code{nil} when passed the element and @var{elt} as +arguments. @var{testfn} defaults to @code{equal}. + +@example +@group +(seq-positions '(a b c a d) 'a) +@result{} (0 3) +@end group +@group +(seq-positions '(a b c a d) 'z) +@result{} nil +@end group +@group +(seq-positions '(11 5 7 12 9 15) 10 #'>=) +@result{} (0 3 5) +@end group +@end example +@end defun @defun seq-uniq sequence &optional function This function returns a list of the elements of @var{sequence} with diff --git a/etc/NEWS b/etc/NEWS index ee450317a0..6c0cf19fe6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2742,6 +2742,11 @@ compiler now emits a warning about this deprecated usage. These can be used for buttons in buffers and the like. See the "(elisp) Icons" and "(emacs) Icons" nodes in the manuals for details. ++++ +** New function 'seq-positions'. +This returns a list of the (zero-based) indices of elements matching a +given predicate in the specified sequence. + +++ ** New arguments MESSAGE and TIMEOUT of 'set-transient-map'. MESSAGE specifies a message to display after activating the transient diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 64197b55e5..31dcfa98b4 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -459,6 +459,23 @@ Equality is defined by the function TESTFN, which defaults to `equal'." (setq index (1+ index))) nil))) +;;;###autoload +(cl-defgeneric seq-positions (sequence elt &optional testfn) + "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil. + +TESTFN is a two-argument function which is passed each element of +SEQUENCE as first argument and ELT as second. TESTFN defaults to +`equal'. + +The result is a list of (zero-based) indices." + (let ((result '())) + (seq-do-indexed + (lambda (e index) + (when (funcall (or testfn #'equal) e elt) + (push index result))) + sequence) + (nreverse result))) + ;;;###autoload (cl-defgeneric seq-uniq (sequence &optional testfn) "Return a list of the elements of SEQUENCE with duplicates removed. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 6a366ec0fc..2472479bad 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -846,6 +846,10 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (seq-find #'numberp '(a b 3 4 f 6))) (seq-position :eval (seq-position '(a b c) 'c)) + (seq-positions + :eval (seq-positions '(a b c a d) 'a) + :eval (seq-positions '(a b c a d) 'z) + :eval (seq-positions '(11 5 7 12 9 15) 10 #'>=)) (seq-length :eval (seq-length "abcde")) (seq-max diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 6249e48617..d95b35c45e 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -490,6 +490,13 @@ Evaluate BODY for each created sequence. (should (= (seq-position seq 'a #'eq) 0)) (should (null (seq-position seq (make-symbol "a") #'eq))))) +(ert-deftest test-seq-positions () + (with-test-sequences (seq '(1 2 3 1 4)) + (should (equal '(0 3) (seq-positions seq 1))) + (should (seq-empty-p (seq-positions seq 9)))) + (with-test-sequences (seq '(11 5 7 12 9 15)) + (should (equal '(0 3 5) (seq-positions seq 10 #'>=))))) + (ert-deftest test-seq-sort-by () (let ((seq ["x" "xx" "xxx"])) (should (equal (seq-sort-by #'seq-length #'> seq) commit 4d50d413e67dd8ae183af8b68f315a667ebf2add Author: Augusto Stoffel Date: Sun Sep 4 13:14:58 2022 +0200 Add Python import management commands * lisp/progmodes/python.el (python-interpreter): New variable (python-mode-map): Keybindings and menu entries for new commands (python--list-imports, python-import-history, python--query-import) (python--do-isort): New variables and helper functions. (python-add-import, python-import-symbol-at-point) (python-remove-import, python-sort-imports, python-fix-imports): New interactive commands (bug#57574). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6020d52b91..147c5f248d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -34,7 +34,8 @@ ;; Implements Syntax highlighting, Indentation, Movement, Shell ;; interaction, Shell completion, Shell virtualenv support, Shell ;; package support, Shell syntax highlighting, Pdb tracking, Symbol -;; completion, Skeletons, FFAP, Code Check, ElDoc, Imenu. +;; completion, Skeletons, FFAP, Code Check, ElDoc, Imenu, Flymake, +;; Import management. ;; Syntax highlighting: Fontification of code is provided and supports ;; python's triple quoted strings properly. @@ -69,7 +70,7 @@ ;; variables. This example enables IPython globally: ;; (setq python-shell-interpreter "ipython" -;; python-shell-interpreter-args "-i") +;; python-shell-interpreter-args "--simple-prompt") ;; Using the "console" subcommand to start IPython in server-client ;; mode is known to fail intermittently due a bug on IPython itself @@ -240,6 +241,21 @@ ;; I'd recommend the first one since you'll get the same behavior for ;; all modes out-of-the-box. +;; Flymake: A Flymake backend, using the pyflakes program by default, +;; is provided. You can also use flake8 or pylint by customizing +;; `python-flymake-command'. + +;; Import management: The commands `python-sort-imports', +;; `python-add-import', `python-remove-import', and +;; `python-fix-imports' automate the editing of import statements at +;; the top of the buffer, which tend to be a tedious task in larger +;; projects. These commands require that the isort library is +;; available to the interpreter pointed at by `python-interpreter'. +;; The last command also requires pyflakes. These dependencies can be +;; installed, among other methods, with the following command: +;; +;; pip install isort pyflakes + ;;; Code: (require 'ansi-color) @@ -268,6 +284,12 @@ :version "24.3" :link '(emacs-commentary-link "python")) +(defcustom python-interpreter "python" + "Python interpreter for noninteractive use. +To customize the Python shell, modify `python-shell-interpreter' +instead." + :version "29.1" + :type 'string) ;;; Bindings @@ -306,6 +328,11 @@ (define-key map "\C-c\C-v" #'python-check) (define-key map "\C-c\C-f" #'python-eldoc-at-point) (define-key map "\C-c\C-d" #'python-describe-at-point) + ;; Import management + (define-key map "\C-c\C-ia" #'python-add-import) + (define-key map "\C-c\C-if" #'python-fix-imports) + (define-key map "\C-c\C-ir" #'python-remove-import) + (define-key map "\C-c\C-is" #'python-sort-imports) ;; Utilities (substitute-key-definition #'complete-symbol #'completion-at-point map global-map) @@ -351,7 +378,17 @@ ["Help on symbol" python-eldoc-at-point :help "Get help on symbol at point"] ["Complete symbol" completion-at-point - :help "Complete symbol before point"])) + :help "Complete symbol before point"] + "-----" + ["Add import" python-add-import + :help "Add an import statement to the top of this buffer"] + ["Remove import" python-remove-import + :help "Remove an import statement from the top of this buffer"] + ["Sort imports" python-sort-imports + :help "Sort the import statements at the top of this buffer"] + ["Fix imports" python-fix-imports + :help "Add missing imports and remove unused ones from the current buffer"] + )) map) "Keymap for `python-mode'.") @@ -5852,6 +5889,225 @@ REPORT-FN is Flymake's callback function." (process-send-eof python--flymake-proc)))) +;;; Import management +(defconst python--list-imports "\ +from isort import find_imports_in_stream, find_imports_in_paths +from sys import argv, stdin + +query, files, result = argv[1] or None, argv[2:], {} + +if files: + imports = find_imports_in_paths(files, top_only=True) +else: + imports = find_imports_in_stream(stdin, top_only=True) + +for imp in imports: + if query is None or query == (imp.alias or imp.attribute or imp.module): + key = (imp.module, imp.attribute or '', imp.alias or '') + if key not in result: + result[key] = imp.statement() + +for key in sorted(result): + print(result[key]) +" + "Script to list import statements in Python code.") + +(defvar python-import-history nil + "History variable for `python-import' commands.") + +(defun python--import-sources () + "List files containing Python imports that may be useful in the current buffer." + (if-let (((featurep 'project)) ;For compatibility with Emacs < 26 + (proj (project-current))) + (seq-filter (lambda (s) (string-match-p "\\.py[ciw]?\\'" s)) + (project-files proj)) + (list default-directory))) + +(defun python--list-imports (name source) + "List all Python imports matching NAME in SOURCE. +If NAME is nil, list all imports. SOURCE can be a buffer or a +list of file names or directories; the latter are searched +recursively." + (let ((buffer (current-buffer))) + (with-temp-buffer + (let* ((temp (current-buffer)) + (status (if (bufferp source) + (with-current-buffer source + (call-process-region (point-min) (point-max) + python-interpreter + nil (list temp nil) nil + "-c" python--list-imports + (or name ""))) + (with-current-buffer buffer + (apply #'call-process + python-interpreter + nil (list temp nil) nil + "-c" python--list-imports + (or name "") + (mapcar #'file-local-name source))))) + lines) + (unless (eq 0 status) + (error "%s exited with status %s (maybe isort is missing?)" + python-interpreter status)) + (goto-char (point-min)) + (while (not (eobp)) + (push (buffer-substring-no-properties (point) (pos-eol)) + lines) + (forward-line 1)) + (nreverse lines))))) + +(defun python--query-import (name source prompt) + "Read a Python import statement defining NAME. +A list of candidates is produced by `python--list-imports' using +the NAME and SOURCE arguments. An interactive query, using the +PROMPT string, is made unless there is a single candidate." + (let* ((cands (python--list-imports name source)) + ;; Don't use DEF argument of `completing-read', so it is able + ;; to return the empty string. + (minibuffer-default-add-function + (lambda () + (setq minibuffer-default (with-minibuffer-selected-window + (thing-at-point 'symbol))))) + (statement (cond ((and name (length= cands 1)) + (car cands)) + (prompt + (completing-read prompt + (or cands python-import-history) + nil nil nil + 'python-import-history))))) + (unless (string-empty-p statement) + statement))) + +(defun python--do-isort (&rest args) + "Edit the current buffer using isort called with ARGS. +Return non-nil if the buffer was actually modified." + (let ((buffer (current-buffer))) + (with-temp-buffer + (let ((temp (current-buffer))) + (with-current-buffer buffer + (let ((status (apply #'call-process-region + (point-min) (point-max) + python-interpreter + nil (list temp nil) nil + "-m" "isort" "-" args)) + (tick (buffer-chars-modified-tick))) + (unless (eq 0 status) + (error "%s exited with status %s (maybe isort is missing?)" + python-interpreter status)) + (replace-buffer-contents temp) + (not (eq tick (buffer-chars-modified-tick))))))))) + +;;;###autoload +(defun python-add-import (name) + "Add an import statement to the current buffer. + +Interactively, ask for an import statement using all imports +found in the current project as suggestions. With a prefix +argument, restrict the suggestions to imports defining the symbol +at point. If there is only one such suggestion, act without +asking. + +When calling from Lisp, use a non-nil NAME to restrict the +suggestions to imports defining NAME." + (interactive (list (when current-prefix-arg (thing-at-point 'symbol)))) + (when-let ((statement (python--query-import name + (python--import-sources) + "Add import: "))) + (if (python--do-isort "--add" statement) + (message "Added `%s'" statement) + (message "(No changes in Python imports needed)")))) + +;;;###autoload +(defun python-import-symbol-at-point () + "Add an import statement for the symbol at point to the current buffer. +This works like `python-add-import', but with the opposite +behavior regarding the prefix argument." + (interactive nil) + (python-add-import (unless current-prefix-arg (thing-at-point 'symbol)))) + +;;;###autoload +(defun python-remove-import (name) + "Remove an import statement from the current buffer. + +Interactively, ask for an import statement to remove, displaying +the imports of the current buffer as suggestions. With a prefix +argument, restrict the suggestions to imports defining the symbol +at point. If there is only one such suggestion, act without +asking." + (interactive (list (when current-prefix-arg (thing-at-point 'symbol)))) + (when-let ((statement (python--query-import name (current-buffer) + "Remove import: "))) + (if (python--do-isort "--rm" statement) + (message "Removed `%s'" statement) + (message "(No changes in Python imports needed)")))) + +;;;###autoload +(defun python-sort-imports () + "Sort Python imports in the current buffer." + (interactive) + (if (python--do-isort) + (message "Sorted imports") + (message "(No changes in Python imports needed)"))) + +;;;###autoload +(defun python-fix-imports () + "Add missing imports and remove unused ones from the current buffer." + (interactive) + (let ((buffer (current-buffer)) + undefined unused add remove) + ;; Compute list of undefined and unused names + (with-temp-buffer + (let ((temp (current-buffer))) + (with-current-buffer buffer + (call-process-region (point-min) (point-max) + python-interpreter + nil temp nil + "-m" "pyflakes")) + (goto-char (point-min)) + (when (looking-at-p ".* No module named pyflakes$") + (error "%s couldn't find pyflakes" python-interpreter)) + (while (not (eobp)) + (cond ((looking-at ".* undefined name '\\([^']+\\)'$") + (push (match-string 1) undefined)) + ((looking-at ".*'\\([^']+\\)' imported but unused$") + (push (match-string 1) unused))) + (forward-line 1)))) + ;; Compute imports to be added + (dolist (name (seq-uniq undefined)) + (when-let ((statement (python--query-import name + (python--import-sources) + (format "\ +Add import for undefined name `%s' (empty to skip): " + name)))) + (push statement add))) + ;; Compute imports to be removed + (dolist (name (seq-uniq unused)) + ;; The unused imported names, as provided by pyflakes, are of + ;; the form "module.var" or "module.var as alias", independently + ;; of style of import statement used. + (let* ((filter + (lambda (statement) + (string= name + (thread-last + statement + (replace-regexp-in-string "^\\(from\\|import\\) " "") + (replace-regexp-in-string " import " "."))))) + (statements (seq-filter filter (python--list-imports nil buffer)))) + (when (length= statements 1) + (push (car statements) remove)))) + ;; Edit buffer and say goodbye + (if (not (or add remove)) + (message "(No changes in Python imports needed)") + (apply #'python--do-isort + (append (mapcan (lambda (x) (list "--add" x)) add) + (mapcan (lambda (x) (list "--rm" x)) remove))) + (message "%s" (concat (when add "Added ") + (when add (string-join add ", ")) + (when remove (if add " and removed " "Removed ")) + (when remove (string-join remove ", " ))))))) + + +;;; Major mode (defun python-electric-pair-string-delimiter () (when (and electric-pair-mode (memq last-command-event '(?\" ?\')) @@ -5973,8 +6229,10 @@ REPORT-FN is Flymake's callback function." ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code -(dolist (sym '(python-check +(dolist (sym '(python-add-import + python-check python-fill-paragraph + python-fix-imports python-indent-dedent-line python-indent-dedent-line-backspace python-indent-guess-indent-offset @@ -5999,9 +6257,11 @@ REPORT-FN is Flymake's callback function." python-nav-forward-statement python-nav-if-name-main python-nav-up-list + python-remove-import python-shell-send-buffer python-shell-send-defun - python-shell-send-statement)) + python-shell-send-statement + python-sort-imports)) (put sym 'completion-predicate #'python--completion-predicate)) (defun python-shell--completion-predicate (_ buffer) commit 4932d26b5df14af01ae757b2a5232d157df69008 Author: Augusto Stoffel Date: Sun Sep 4 13:13:57 2022 +0200 Python shells dedicated to a project * lisp/progmodes/python.el: Require 'seq' and (optionally) 'compat' and 'project' libraries. (python-shell-dedicated): New user option (python-shell-get-process-name): Adapt to project-dedicated shells. (run-python): Offer possibility to create a project-dedicated shell, or use 'python-shell-dedicated' as the default behavior. (python-shell-get-buffer): Adapt to project-dedicated shells (bug#56997). diff --git a/etc/NEWS b/etc/NEWS index e9c322d74a..ee450317a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2199,6 +2199,17 @@ the Galeon web browser was released in September, 2008. Note that this historical web browser is different from Mozilla Firefox; it is its predecessor. +** Python Mode ++++ +*** Project shells and a new user option 'python-shell-dedicated' +When called with a prefix argument, 'run-python' now offers the choice +of creating a shell dedicated to the current project. This shell runs +in the project root directory and is shared among all project buffers. + +Without a prefix argument, the kind of shell (buffer-dedicated, +project-dedicated or global) is specified by the new +'python-shell-dedicated' variable. + ** Ruby Mode --- diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d3ffc2db2c..6020d52b91 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.4") (cl-lib "1.0")) +;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -245,6 +245,9 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) +(require 'compat nil 'noerror) +(require 'project nil 'noerror) +(require 'seq) (eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings @@ -2304,6 +2307,16 @@ virtualenv." "`compilation-error-regexp-alist' for inferior Python." :type '(alist regexp)) +(defcustom python-shell-dedicated nil + "Whether to make Python shells dedicated by default. +This option influences `run-python' when called without a prefix +argument. If `buffer' or `project', create a Python shell +dedicated to the current buffer or its project (if one is found)." + :version "29.1" + :type '(choice (const :tag "To buffer" buffer) + (const :tag "To project" project) + (const :tag "Not dedicated" nil))) + (defvar python-shell-output-filter-in-progress nil) (defvar python-shell-output-filter-buffer nil) @@ -2666,12 +2679,19 @@ from `python-shell-prompt-regexp', (defun python-shell-get-process-name (dedicated) "Calculate the appropriate process name for inferior Python process. -If DEDICATED is t returns a string with the form -`python-shell-buffer-name'[`buffer-name'] else returns the value -of `python-shell-buffer-name'." - (if dedicated - (format "%s[%s]" python-shell-buffer-name (buffer-name)) - python-shell-buffer-name)) +If DEDICATED is nil, this is simply `python-shell-buffer-name'. +If DEDICATED is `buffer' or `project', append the current buffer +name respectively the current project name." + (pcase dedicated + ('nil python-shell-buffer-name) + ('project + (if-let ((proj (and (featurep 'project) + (project-current)))) + (format "%s[%s]" python-shell-buffer-name (file-name-nondirectory + (directory-file-name + (project-root proj)))) + python-shell-buffer-name)) + (_ (format "%s[%s]" python-shell-buffer-name (buffer-name))))) (defun python-shell-internal-get-process-name () "Calculate the appropriate process name for Internal Python process. @@ -3129,8 +3149,8 @@ killed." Argument CMD defaults to `python-shell-calculate-command' return value. When called interactively with `prefix-arg', it allows the user to edit such value and choose whether the interpreter -should be DEDICATED for the current buffer. When numeric prefix -arg is other than 0 or 4 do not SHOW. +should be DEDICATED to the current buffer or project. When +numeric prefix arg is other than 0 or 4 do not SHOW. For a given buffer and same values of DEDICATED, if a process is already running for it, it will do nothing. This means that if @@ -3144,13 +3164,25 @@ process buffer for a list of commands.)" (if current-prefix-arg (list (read-shell-command "Run Python: " (python-shell-calculate-command)) - (y-or-n-p "Make dedicated process? ") + (alist-get (car (read-multiple-choice "Make dedicated process?" + '((?b "to buffer") + (?p "to project") + (?n "no")))) + '((?b . buffer) (?p . project))) (= (prefix-numeric-value current-prefix-arg) 4)) - (list (python-shell-calculate-command) nil t))) - (let ((buffer - (python-shell-make-comint - (or cmd (python-shell-calculate-command)) - (python-shell-get-process-name dedicated) show))) + (list (python-shell-calculate-command) + python-shell-dedicated + t))) + (let* ((project (and (eq 'project dedicated) + (featurep 'project) + (project-current t))) + (default-directory (if project + (project-root project) + default-directory)) + (buffer (python-shell-make-comint + (or cmd (python-shell-calculate-command)) + (python-shell-get-process-name dedicated) + show))) (get-buffer-process buffer))) (defun run-python-internal () @@ -3180,15 +3212,13 @@ startup." If current buffer is in `inferior-python-mode', return it." (if (derived-mode-p 'inferior-python-mode) (current-buffer) - (let* ((dedicated-proc-name (python-shell-get-process-name t)) - (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name)) - (global-proc-name (python-shell-get-process-name nil)) - (global-proc-buffer-name (format "*%s*" global-proc-name)) - (dedicated-running (comint-check-proc dedicated-proc-buffer-name)) - (global-running (comint-check-proc global-proc-buffer-name))) - ;; Always prefer dedicated - (or (and dedicated-running dedicated-proc-buffer-name) - (and global-running global-proc-buffer-name))))) + (seq-some + (lambda (dedicated) + (let* ((proc-name (python-shell-get-process-name dedicated)) + (buffer-name (format "*%s*" proc-name))) + (when (comint-check-proc buffer-name) + buffer-name))) + '(buffer project nil)))) (defun python-shell-get-process () "Return inferior Python process for current buffer." commit 2db8b0e12f913ecd720aa81a70580e58fd032397 Author: Damien Cassou Date: Sat Sep 3 18:47:04 2022 +0200 Add new function `seq-remove-at-position' * doc/lispref/sequences.texi (Sequence Functions): Document it. * lisp/emacs-lisp/seq.el (seq-remove-at-position): New function. * lisp/emacs-lisp/shortdoc.el (sequence): Mention it. * test/lisp/emacs-lisp/seq-tests.el (test-seq-remove-at-position): Test it. diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index cc956952d6..2ee19efb1a 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -680,6 +680,24 @@ for which @var{predicate} returns @code{nil}. @end example @end defun +@defun seq-remove-at-position sequence n +@cindex removing from sequences + This function returns a copy of @var{sequence} where the element at + (zero-based) index @var{n} got removed. The result is a sequence of + the same type as @var{sequence}. + +@example +@group +(seq-remove-at-position [1 -1 3 -3 5] 0) +@result{} [-1 3 -3 5] +@end group +@group +(seq-remove-at-position [1 -1 3 -3 5] 3) +@result{} [1 -1 3 5] +@end group +@end example +@end defun + @defun seq-reduce function sequence initial-value @cindex reducing sequences This function returns the result of calling @var{function} with diff --git a/etc/NEWS b/etc/NEWS index edd4b01eab..e9c322d74a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2743,6 +2743,11 @@ The default timeout value can be defined by the new variable ** New function 'seq-split'. This returns a list of sub-sequences of the specified sequence. ++++ +** New function 'seq-remove-at-position'. +This function returns a copy of the specified sequence where the +element at a given (zero-based) index got removed. + +++ ** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'. These function now take an optional comparison predicate argument. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index b5f762ef3a..64197b55e5 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -346,6 +346,20 @@ list." (seq-filter (lambda (elt) (not (funcall pred elt))) sequence)) +;;;###autoload +(cl-defgeneric seq-remove-at-position (sequence n) + "Return a copy of SEQUENCE where the element at N got removed. + +N is the (zero-based) index of the element that should not be in +the result. + +The result is a sequence of the same type as SEQUENCE." + (seq-concatenate + (let ((type (type-of sequence))) + (if (eq type 'cons) 'list type)) + (seq-subseq sequence 0 n) + (seq-subseq sequence (1+ n)))) + ;;;###autoload (cl-defgeneric seq-reduce (function sequence initial-value) "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 990dabe351..6a366ec0fc 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -888,6 +888,9 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (seq-filter #'numberp '(a b 3 4 f 6))) (seq-remove :eval (seq-remove #'numberp '(1 2 c d 5))) + (seq-remove-at-position + :eval (seq-remove-at-position '(a b c d e) 3) + :eval (seq-remove-at-position [a b c d e] 0)) (seq-group-by :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6))) (seq-union diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 1a27467d29..6249e48617 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -137,6 +137,14 @@ Evaluate BODY for each created sequence. (with-test-sequences (seq '()) (should (equal (seq-remove #'test-sequences-evenp seq) '())))) +(ert-deftest test-seq-remove-at-position () + (with-test-sequences (seq '(1 2 3 4)) + (should (same-contents-p (seq-remove-at-position seq 2) '(1 2 4))) + (should (same-contents-p (seq-remove-at-position seq 0) '(2 3 4))) + (should (same-contents-p (seq-remove-at-position seq 3) '(1 2 3))) + (should (eq (type-of (seq-remove-at-position seq 2)) + (type-of seq))))) + (ert-deftest test-seq-count () (with-test-sequences (seq '(6 7 8 9 10)) (should (equal (seq-count #'test-sequences-evenp seq) 3)) commit 77b761dafaf65d57dd05ecd586884340fa4e63e2 Author: Damien Cassou Date: Sun Sep 4 13:00:22 2022 +0200 Improve documentation of several functions in seq.el * doc/lispref/sequences.texi (Sequence Functions): * lisp/emacs-lisp/seq.el (seq-contains): (seq-contains-p): (seq-set-equal-p): (seq-position): (seq-union): (seq-intersection): (seq-difference): Use more standard wording in the docstrings (bug#57561). diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 1f6f80521c..cc956952d6 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -863,7 +863,7 @@ arguments to use instead of the default @code{equal}. @end defun @defun seq-position sequence elt &optional function - This function returns the index of the first element in + This function returns the (zero-based) index of the first element in @var{sequence} that is equal to @var{elt}. If the optional argument @var{function} is non-@code{nil}, it is a function of two arguments to use instead of the default @code{equal}. diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 1b4a49e4e3..b5f762ef3a 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -409,7 +409,7 @@ found or not." (cl-defgeneric seq-contains (sequence elt &optional testfn) "Return the first element in SEQUENCE that is equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (declare (obsolete seq-contains-p "27.1")) (seq-some (lambda (e) (when (funcall (or testfn #'equal) elt e) @@ -418,7 +418,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (cl-defgeneric seq-contains-p (sequence elt &optional testfn) "Return non-nil if SEQUENCE contains an element equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (catch 'seq--break (seq-doseq (e sequence) (let ((r (funcall (or testfn #'equal) e elt))) @@ -429,14 +429,14 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements. This does not depend on the order of the elements. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1) (seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2))) ;;;###autoload (cl-defgeneric seq-position (sequence elt &optional testfn) - "Return the index of the first element in SEQUENCE that is equal to ELT. -Equality is defined by TESTFN if non-nil or by `equal' if nil." + "Return the (zero-based) index of the first element in SEQUENCE equal to ELT. +Equality is defined by the function TESTFN, which defaults to `equal'." (let ((index 0)) (catch 'seq--break (seq-doseq (e sequence) @@ -502,7 +502,7 @@ negative integer or 0, nil is returned." ;;;###autoload (cl-defgeneric seq-union (sequence1 sequence2 &optional testfn) "Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (let* ((accum (lambda (acc elt) (if (seq-contains-p acc elt testfn) acc @@ -514,7 +514,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." ;;;###autoload (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn) "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) (cons elt acc) @@ -524,7 +524,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." (cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn) "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2. -Equality is defined by TESTFN if non-nil or by `equal' if nil." +Equality is defined by the function TESTFN, which defaults to `equal'." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) acc commit 40de3684fb824c797fa942ad5f99ca319aa34881 Author: Lars Ingebrigtsen Date: Sun Sep 4 12:41:02 2022 +0200 Rename the Mice node in the Emacs manual * doc/emacs/commands.texi (User Input, Keys): Rename "Mice" to Mouse Input. diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi index 64e75c9609..df3c47504a 100644 --- a/doc/emacs/commands.texi +++ b/doc/emacs/commands.texi @@ -69,7 +69,7 @@ where the @key{Meta} key does not function reliably. Emacs has extensive support for using mouse buttons, mouse wheels and other pointing devices like touchpads and touch screens. -@xref{Mice}, for details. +@xref{Mouse Input}, for details. @cindex keys stolen by window manager @cindex window manager, keys stolen by @@ -139,8 +139,8 @@ exception to this rule is @key{ESC}: @kbd{@key{ESC} C-h} is equivalent to @kbd{C-M-h}, which does something else entirely. You can, however, use @key{F1} to display a list of commands starting with @key{ESC}. -@node Mice -@section Mice +@node Mouse Input +@section Mouse Input @cindex mouse input By default, Emacs supports all the normal mouse actions like setting diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index d0e048ae06..6206dee485 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -148,7 +148,7 @@ Important General Concepts function keys). * Keys:: Key sequences: what you type to request one editing action. -* Mice:: Using the mouse and keypads. +* Mouse Input:: Using the mouse and keypads. * Commands:: Named functions run by key sequences to do editing. * Entering Emacs:: Starting Emacs from the shell. * Exiting:: Stopping or killing Emacs. commit 500af031c88b7ddb3252f4d28113cf1d3e8144c7 Author: Lars Ingebrigtsen Date: Sun Sep 4 11:37:32 2022 +0200 Fix some help-fns test failures * lisp/help-fns.el (help-fns--key-bindings): Fix test failures from recent change. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 3f3a5747dc..6d635ec9ee 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -516,7 +516,7 @@ the C sources, too." (remapped (command-remapping function))) (unless (memq remapped '(ignore undefined)) (let* ((all-keys - (with-current-buffer orig-buffer + (with-current-buffer (or orig-buffer (current-buffer)) (where-is-internal (or remapped function) overriding-local-map nil nil))) (seps (seq-group-by