diff options
Diffstat (limited to 'lisp/eshell/em-extpipe.el')
| -rw-r--r-- | lisp/eshell/em-extpipe.el | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el new file mode 100644 index 00000000000..3db1dea5955 --- /dev/null +++ b/lisp/eshell/em-extpipe.el @@ -0,0 +1,204 @@ +;;; em-extpipe.el --- external shell pipelines -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Sean Whitton <spwhitton@spwhitton.name> + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; 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 module tries to make +;; that easy to do. + +;;; Code: + +(require 'cl-lib) +(require 'esh-arg) +(require 'esh-cmd) +(require 'esh-io) +(require 'esh-util) + +(eval-when-compile (require 'files-x)) + +;;; Functions: + +(defun eshell-extpipe-initialize () ;Called from `eshell-mode' via intern-soft! + "Initialize external pipelines support." + (when (boundp 'eshell-special-chars-outside-quoting) + (setq-local + eshell-special-chars-outside-quoting + (append eshell-special-chars-outside-quoting (list ?\*)))) + (add-hook 'eshell-parse-argument-hook + #'eshell-parse-external-pipeline -20 t) + (add-hook 'eshell-pre-rewrite-command-hook + #'eshell-rewrite-external-pipeline -20 t)) + +(defmacro em-extpipe--or-with-catch (&rest disjuncts) + "Evaluate DISJUNCTS like `or' but catch `eshell-incomplete'. + +If `eshell-incomplete' is thrown during the evaluation of a +disjunct, that disjunct yields nil." + (let ((result (gensym))) + `(let (,result) + (or ,@(cl-loop for disjunct in disjuncts collect + `(if (catch 'eshell-incomplete + (ignore (setq ,result ,disjunct))) + nil + ,result)))))) + +(defun eshell-parse-external-pipeline () + "Parse a pipeline intended for execution by the external shell. + +A sequence of arguments is rewritten to use the operating system +shell when it contains `*|', `*<' or `*>', where the asterisk is +preceded by whitespace or located at the start of input. + +The command extends to the next `|' character which is not +preceded by an unescaped asterisk following whitespace, or the +end of input, except that any Eshell-specific output redirections +occurring at the end are excluded. Any other `<' or `>' +appearing before the end of the command are treated as though +preceded by (whitespace and) an asterisk. + +For example, + + foo <bar *| baz >#<buffer quux> + +is equivalent to + + sh -c \"foo <bar | baz\" >#<buffer quux> + +when `shell-file-name' is `sh' and `shell-command-switch' is +`-c', but in + + foo >#<buffer quux> *| baz + +and + + foo *| baz >#<buffer quux> --some-argument + +the Eshell-specific redirect will be passed on to the operating +system shell, probably leading to undesired results. + +This function must appear early in `eshell-parse-argument-hook' +to ensure that operating system shell syntax is not interpreted +as though it were Eshell syntax." + ;; Our goal is to wrap the external command to protect it from the + ;; other members of `eshell-parse-argument-hook'. We must avoid + ;; misinterpreting a quoted `*|', `*<' or `*>' as indicating an + ;; external pipeline, hence the structure of the loop in `findbeg1'. + (cl-flet + ((findbeg1 (pat &optional go (bound (point-max))) + (let* ((start (point)) + (result + (catch 'found + (while (> bound (point)) + (let* ((found + (save-excursion + (re-search-forward + "\\(?:#?'\\|\"\\|\\\\\\)" bound t))) + (next (or (and found (match-beginning 0)) + bound))) + (if (re-search-forward pat next t) + (throw 'found (match-beginning 1)) + (goto-char next) + (while (em-extpipe--or-with-catch + (eshell-parse-lisp-argument) + (eshell-parse-backslash) + (eshell-parse-double-quote) + (eshell-parse-literal-quote))) + ;; Guard against an infinite loop if none of + ;; the parsers moved us forward. + (unless (or (> (point) next) (eobp)) + (forward-char 1)))))))) + (goto-char (if (and result go) (match-end 0) start)) + result))) + (unless (or eshell-current-argument eshell-current-quoted) + (let ((beg (point)) end + (next-marked (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)")) + (next-unmarked + (or (findbeg1 "\\(?:\\=\\|[^*]\\|\\S-\\*\\)\\(|\\)") + (point-max)))) + (when (and next-marked (> next-unmarked next-marked) + (or (> next-marked (point)) + (looking-back "\\`\\|\\s-" nil))) + ;; Skip to the final segment of the external pipeline. + (while (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*|\\)" t)) + ;; Find output redirections. + (while (findbeg1 + "\\([0-9]?>+&?[0-9]?\\s-*\\S-\\)" t next-unmarked) + ;; Is the output redirection Eshell-specific? We have our + ;; own logic, rather than calling `eshell-parse-argument', + ;; to avoid specifying here all the possible cars of + ;; parsed special references -- `get-buffer-create' etc. + (forward-char -1) + (let ((this-end + (save-match-data + (cond ((looking-at "#<") + (forward-char 1) + (1+ (eshell-find-delimiter ?\< ?\>))) + ((and (looking-at "/\\S-+") + (assoc (match-string 0) + eshell-virtual-targets)) + (match-end 0)))))) + (cond ((and this-end end) + (goto-char this-end)) + (this-end + (goto-char this-end) + (setq end (match-beginning 0))) + (t + (setq end nil))))) + ;; We've moved past all Eshell-specific output redirections + ;; we could find. If there is only whitespace left, then + ;; `end' is right before redirections we should exclude; + ;; otherwise, we must include everything. + (unless (and end (skip-syntax-forward "\s" next-unmarked) + (= next-unmarked (point))) + (setq end next-unmarked)) + (let ((cmd (string-trim + (buffer-substring-no-properties beg end)))) + (goto-char end) + ;; We must now drop the asterisks, unless quoted/escaped. + (with-temp-buffer + (insert cmd) + (goto-char (point-min)) + (cl-loop + for next = (findbeg1 "\\(?:\\=\\|\\s-\\)\\(\\*[|<>]\\)" t) + while next do (forward-char -2) (delete-char 1)) + (eshell-finish-arg + `(eshell-external-pipeline ,(buffer-string)))))))))) + +(defun eshell-rewrite-external-pipeline (terms) + "Rewrite an external pipeline in TERMS as parsed by +`eshell-parse-external-pipeline', which see." + (while terms + (when (and (listp (car terms)) + (eq (caar terms) 'eshell-external-pipeline)) + (with-connection-local-variables + (setcdr terms (cl-list* + shell-command-switch (cadar terms) (cdr terms))) + (setcar terms shell-file-name))) + (setq terms (cdr terms)))) + +(defsubst eshell-external-pipeline (&rest _args) + "Stub to generate an error if a pipeline is not rewritten." + (error "Unhandled external pipeline in input text")) + +(provide 'em-extpipe) +;;; esh-extpipe.el ends here |