config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

with-editor.el (42449B)


      1 ;;; with-editor.el --- Use the Emacsclient as $EDITOR  -*- lexical-binding:t -*-
      2 
      3 ;; Copyright (C) 2014-2024 The Magit Project Contributors
      4 
      5 ;; Author: Jonas Bernoulli <emacs.with-editor@jonas.bernoulli.dev>
      6 ;; Homepage: https://github.com/magit/with-editor
      7 ;; Keywords: processes terminals
      8 
      9 ;; Package-Version: 3.3.2
     10 ;; Package-Requires: ((emacs "25.1") (compat "29.1.4.1"))
     11 
     12 ;; SPDX-License-Identifier: GPL-3.0-or-later
     13 
     14 ;; This file is free software: you can redistribute it and/or modify
     15 ;; it under the terms of the GNU General Public License as published
     16 ;; by the Free Software Foundation, either version 3 of the License,
     17 ;; or (at your option) any later version.
     18 ;;
     19 ;; This file is distributed in the hope that it will be useful,
     20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     22 ;; GNU General Public License for more details.
     23 ;;
     24 ;; You should have received a copy of the GNU General Public License
     25 ;; along with this file.  If not, see <https://www.gnu.org/licenses/>.
     26 
     27 ;;; Commentary:
     28 
     29 ;; This library makes it possible to reliably use the Emacsclient as
     30 ;; the `$EDITOR' of child processes.  It makes sure that they know how
     31 ;; to call home.  For remote processes a substitute is provided, which
     32 ;; communicates with Emacs on standard output/input instead of using a
     33 ;; socket as the Emacsclient does.
     34 
     35 ;; It provides the commands `with-editor-async-shell-command' and
     36 ;; `with-editor-shell-command', which are intended as replacements
     37 ;; for `async-shell-command' and `shell-command'.  They automatically
     38 ;; export `$EDITOR' making sure the executed command uses the current
     39 ;; Emacs instance as "the editor".  With a prefix argument these
     40 ;; commands prompt for an alternative environment variable such as
     41 ;; `$GIT_EDITOR'.  To always use these variants add this to your init
     42 ;; file:
     43 ;;
     44 ;;   (keymap-global-set "<remap> <async-shell-command>"
     45 ;;                      #'with-editor-async-shell-command)
     46 ;;   (keymap-global-set "<remap> <shell-command>"
     47 ;;                      #'with-editor-shell-command)
     48 
     49 ;; Alternatively use the global `shell-command-with-editor-mode',
     50 ;; which always sets `$EDITOR' for all Emacs commands which ultimately
     51 ;; use `shell-command' to asynchronously run some shell command.
     52 
     53 ;; The command `with-editor-export-editor' exports `$EDITOR' or
     54 ;; another such environment variable in `shell-mode', `eshell-mode',
     55 ;; `term-mode' and `vterm-mode' buffers.  Use this Emacs command
     56 ;; before executing a shell command which needs the editor set, or
     57 ;; always arrange for the current Emacs instance to be used as editor
     58 ;; by adding it to the appropriate mode hooks:
     59 ;;
     60 ;;   (add-hook 'shell-mode-hook  #'with-editor-export-editor)
     61 ;;   (add-hook 'eshell-mode-hook #'with-editor-export-editor)
     62 ;;   (add-hook 'term-exec-hook   #'with-editor-export-editor)
     63 ;;   (add-hook 'vterm-mode-hook  #'with-editor-export-editor)
     64 
     65 ;; Some variants of this function exist, these two forms are
     66 ;; equivalent:
     67 ;;
     68 ;;   (add-hook 'shell-mode-hook
     69 ;;             (apply-partially #'with-editor-export-editor "GIT_EDITOR"))
     70 ;;   (add-hook 'shell-mode-hook #'with-editor-export-git-editor)
     71 
     72 ;; This library can also be used by other packages which need to use
     73 ;; the current Emacs instance as editor.  In fact this library was
     74 ;; written for Magit and its `git-commit-mode' and `git-rebase-mode'.
     75 ;; Consult `git-rebase.el' and the related code in `magit-sequence.el'
     76 ;; for a simple example.
     77 
     78 ;;; Code:
     79 
     80 (require 'cl-lib)
     81 (require 'compat)
     82 (require 'server)
     83 (require 'shell)
     84 (eval-when-compile (require 'subr-x))
     85 
     86 (declare-function dired-get-filename "dired"
     87                   (&optional localp no-error-if-not-filep))
     88 (declare-function term-emulate-terminal "term" (proc str))
     89 (defvar eshell-preoutput-filter-functions)
     90 (defvar git-commit-post-finish-hook)
     91 (defvar vterm--process)
     92 (defvar warning-minimum-level)
     93 (defvar warning-minimum-log-level)
     94 
     95 ;;; Options
     96 
     97 (defgroup with-editor nil
     98   "Use the Emacsclient as $EDITOR."
     99   :group 'external
    100   :group 'server)
    101 
    102 (defun with-editor-locate-emacsclient ()
    103   "Search for a suitable Emacsclient executable."
    104   (or (with-editor-locate-emacsclient-1
    105        (with-editor-emacsclient-path)
    106        (length (split-string emacs-version "\\.")))
    107       (prog1 nil (display-warning 'with-editor "\
    108 Cannot determine a suitable Emacsclient
    109 
    110 Determining an Emacsclient executable suitable for the
    111 current Emacs instance failed.  For more information
    112 please see https://github.com/magit/magit/wiki/Emacsclient."))))
    113 
    114 (defun with-editor-locate-emacsclient-1 (path depth)
    115   (let* ((version-lst (cl-subseq (split-string emacs-version "\\.") 0 depth))
    116          (version-reg (concat "^" (mapconcat #'identity version-lst "\\."))))
    117     (or (locate-file
    118          (cond ((equal (downcase invocation-name) "remacs")
    119                 "remacsclient")
    120                ((bound-and-true-p emacsclient-program-name))
    121                ("emacsclient"))
    122          path
    123          (cl-mapcan
    124           (lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes))
    125           (nconc (and (boundp 'debian-emacs-flavor)
    126                       (list (format ".%s" debian-emacs-flavor)))
    127                  (cl-mapcon (lambda (v)
    128                               (setq v (mapconcat #'identity (reverse v) "."))
    129                               (list v (concat "-" v) (concat ".emacs" v)))
    130                             (reverse version-lst))
    131                  (list "" "-snapshot" ".emacs-snapshot")))
    132          (lambda (exec)
    133            (ignore-errors
    134              (string-match-p version-reg
    135                              (with-editor-emacsclient-version exec)))))
    136         (and (> depth 1)
    137              (with-editor-locate-emacsclient-1 path (1- depth))))))
    138 
    139 (defun with-editor-emacsclient-version (exec)
    140   (let ((default-directory (file-name-directory exec)))
    141     (ignore-errors
    142       (cadr (split-string (car (process-lines exec "--version")))))))
    143 
    144 (defun with-editor-emacsclient-path ()
    145   (let ((path exec-path))
    146     (when invocation-directory
    147       (push (directory-file-name invocation-directory) path)
    148       (let* ((linkname (expand-file-name invocation-name invocation-directory))
    149              (truename (file-chase-links linkname)))
    150         (unless (equal truename linkname)
    151           (push (directory-file-name (file-name-directory truename)) path)))
    152       (when (eq system-type 'darwin)
    153         (let ((dir (expand-file-name "bin" invocation-directory)))
    154           (when (file-directory-p dir)
    155             (push dir path)))
    156         (when (string-search "Cellar" invocation-directory)
    157           (let ((dir (expand-file-name "../../../bin" invocation-directory)))
    158             (when (file-directory-p dir)
    159               (push dir path))))))
    160     (cl-remove-duplicates path :test #'equal)))
    161 
    162 (defcustom with-editor-emacsclient-executable (with-editor-locate-emacsclient)
    163   "The Emacsclient executable used by the `with-editor' macro."
    164   :group 'with-editor
    165   :type '(choice (string :tag "Executable")
    166                  (const  :tag "Don't use Emacsclient" nil)))
    167 
    168 (defcustom with-editor-sleeping-editor "\
    169 sh -c '\
    170 printf \"\\nWITH-EDITOR: $$ OPEN $0\\037$1\\037 IN $(pwd)\\n\"; \
    171 sleep 604800 & sleep=$!; \
    172 trap \"kill $sleep; exit 0\" USR1; \
    173 trap \"kill $sleep; exit 1\" USR2; \
    174 wait $sleep'"
    175   "The sleeping editor, used when the Emacsclient cannot be used.
    176 
    177 This fallback is used for asynchronous processes started inside
    178 the macro `with-editor', when the process runs on a remote machine
    179 or for local processes when `with-editor-emacsclient-executable'
    180 is nil (i.e., when no suitable Emacsclient was found, or the user
    181 decided not to use it).
    182 
    183 Where the latter uses a socket to communicate with Emacs' server,
    184 this substitute prints edit requests to its standard output on
    185 which a process filter listens for such requests.  As such it is
    186 not a complete substitute for a proper Emacsclient, it can only
    187 be used as $EDITOR of child process of the current Emacs instance.
    188 
    189 Some shells do not execute traps immediately when waiting for a
    190 child process, but by default we do use such a blocking child
    191 process.
    192 
    193 If you use such a shell (e.g., `csh' on FreeBSD, but not Debian),
    194 then you have to edit this option.  You can either replace \"sh\"
    195 with \"bash\" (and install that), or you can use the older, less
    196 performant implementation:
    197 
    198   \"sh -c '\\
    199   echo -e \\\"\\nWITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\\n\\\"; \\
    200   trap \\\"exit 0\\\" USR1; \\
    201   trap \\\"exit 1\" USR2; \\
    202   while true; do sleep 1; done'\"
    203 
    204 Note that the two unit separator characters () right after $0
    205 and $1 are required.  Normally $0 is the file name and $1 is
    206 missing or else gets ignored.  But if $0 has the form \"+N[:N]\",
    207 then it is treated as a position in the file and $1 is expected
    208 to be the file.
    209 
    210 Also note that using this alternative implementation leads to a
    211 delay of up to a second.  The delay can be shortened by replacing
    212 \"sleep 1\" with \"sleep 0.01\", or if your implementation does
    213 not support floats, then by using \"nanosleep\" instead."
    214   :package-version '(with-editor . "2.8.0")
    215   :group 'with-editor
    216   :type 'string)
    217 
    218 (defcustom with-editor-finish-query-functions nil
    219   "List of functions called to query before finishing session.
    220 
    221 The buffer in question is current while the functions are called.
    222 If any of them returns nil, then the session is not finished and
    223 the buffer is not killed.  The user should then fix the issue and
    224 try again.  The functions are called with one argument.  If it is
    225 non-nil then that indicates that the user used a prefix argument
    226 to force finishing the session despite issues.  Functions should
    227 usually honor that and return non-nil."
    228   :group 'with-editor
    229   :type 'hook)
    230 (put 'with-editor-finish-query-functions 'permanent-local t)
    231 
    232 (defcustom with-editor-cancel-query-functions nil
    233   "List of functions called to query before canceling session.
    234 
    235 The buffer in question is current while the functions are called.
    236 If any of them returns nil, then the session is not canceled and
    237 the buffer is not killed.  The user should then fix the issue and
    238 try again.  The functions are called with one argument.  If it is
    239 non-nil then that indicates that the user used a prefix argument
    240 to force canceling the session despite issues.  Functions should
    241 usually honor that and return non-nil."
    242   :group 'with-editor
    243   :type 'hook)
    244 (put 'with-editor-cancel-query-functions 'permanent-local t)
    245 
    246 (defcustom with-editor-mode-lighter " WE"
    247   "The mode-line lighter of the With-Editor mode."
    248   :group 'with-editor
    249   :type '(choice (const :tag "No lighter" "") string))
    250 
    251 (defvar with-editor-server-window-alist nil
    252   "Alist of filename patterns vs corresponding `server-window'.
    253 
    254 Each element looks like (REGEXP . FUNCTION).  Files matching
    255 REGEXP are selected using FUNCTION instead of the default in
    256 `server-window'.
    257 
    258 Note that when a package adds an entry here then it probably
    259 has a reason to disrespect `server-window' and it likely is
    260 not a good idea to change such entries.")
    261 
    262 (defvar with-editor-file-name-history-exclude nil
    263   "List of regexps for filenames `server-visit' should not remember.
    264 When a filename matches any of the regexps, then `server-visit'
    265 does not add it to the variable `file-name-history', which is
    266 used when reading a filename in the minibuffer.")
    267 
    268 (defcustom with-editor-shell-command-use-emacsclient t
    269   "Whether to use the emacsclient when running shell commands.
    270 
    271 This affects `with-editor-async-shell-command' and, if the input
    272 ends with \"&\" `with-editor-shell-command' .
    273 
    274 If `shell-command-with-editor-mode' is enabled, then it also
    275 affects `shell-command-async' and, if the input ends with \"&\"
    276 `shell-command'.
    277 
    278 This is a temporary kludge that lets you choose between two
    279 possible defects, the ones described in the issues #23 and #40.
    280 
    281 When t, then use the emacsclient.  This has the disadvantage that
    282 `with-editor-mode' won't be enabled because we don't know whether
    283 this package was involved at all in the call to the emacsclient,
    284 and when it is not, then we really should.  The problem is that
    285 the emacsclient doesn't pass along any environment variables to
    286 the server.  This will hopefully be fixed in Emacs eventually.
    287 
    288 When nil, then use the sleeping editor.  Because in this case we
    289 know that this package is involved, we can enable the mode.  But
    290 this makes it necessary that you invoke $EDITOR in shell scripts
    291 like so:
    292 
    293   eval \"$EDITOR\" file
    294 
    295 And some tools that do not handle $EDITOR properly also break."
    296   :package-version '(with-editor . "2.7.1")
    297   :group 'with-editor
    298   :type 'boolean)
    299 
    300 ;;; Mode Commands
    301 
    302 (defvar with-editor-pre-finish-hook nil)
    303 (defvar with-editor-pre-cancel-hook nil)
    304 (defvar with-editor-post-finish-hook nil)
    305 (defvar with-editor-post-finish-hook-1 nil)
    306 (defvar with-editor-post-cancel-hook nil)
    307 (defvar with-editor-post-cancel-hook-1 nil)
    308 (defvar with-editor-cancel-alist nil)
    309 (put 'with-editor-pre-finish-hook 'permanent-local t)
    310 (put 'with-editor-pre-cancel-hook 'permanent-local t)
    311 (put 'with-editor-post-finish-hook 'permanent-local t)
    312 (put 'with-editor-post-cancel-hook 'permanent-local t)
    313 
    314 (defvar-local with-editor-show-usage t)
    315 (defvar-local with-editor-cancel-message nil)
    316 (defvar-local with-editor-previous-winconf nil)
    317 (put 'with-editor-cancel-message 'permanent-local t)
    318 (put 'with-editor-previous-winconf 'permanent-local t)
    319 
    320 (defvar-local with-editor--pid nil "For internal use.")
    321 (put 'with-editor--pid 'permanent-local t)
    322 
    323 (defun with-editor-finish (force)
    324   "Finish the current edit session."
    325   (interactive "P")
    326   (when (run-hook-with-args-until-failure
    327          'with-editor-finish-query-functions force)
    328     (let ((post-finish-hook with-editor-post-finish-hook)
    329           (post-commit-hook (bound-and-true-p git-commit-post-finish-hook))
    330           (dir default-directory))
    331       (run-hooks 'with-editor-pre-finish-hook)
    332       (with-editor-return nil)
    333       (accept-process-output nil 0.1)
    334       (with-temp-buffer
    335         (setq default-directory dir)
    336         (setq-local with-editor-post-finish-hook post-finish-hook)
    337         (when post-commit-hook
    338           (setq-local git-commit-post-finish-hook post-commit-hook))
    339         (run-hooks 'with-editor-post-finish-hook)))))
    340 
    341 (defun with-editor-cancel (force)
    342   "Cancel the current edit session."
    343   (interactive "P")
    344   (when (run-hook-with-args-until-failure
    345          'with-editor-cancel-query-functions force)
    346     (let ((message with-editor-cancel-message))
    347       (when (functionp message)
    348         (setq message (funcall message)))
    349       (let ((post-cancel-hook with-editor-post-cancel-hook)
    350             (with-editor-cancel-alist nil)
    351             (dir default-directory))
    352         (run-hooks 'with-editor-pre-cancel-hook)
    353         (with-editor-return t)
    354         (accept-process-output nil 0.1)
    355         (with-temp-buffer
    356           (setq default-directory dir)
    357           (setq-local with-editor-post-cancel-hook post-cancel-hook)
    358           (run-hooks 'with-editor-post-cancel-hook)))
    359       (message (or message "Canceled by user")))))
    360 
    361 (defun with-editor-return (cancel)
    362   (let ((winconf with-editor-previous-winconf)
    363         (clients server-buffer-clients)
    364         (dir default-directory)
    365         (pid with-editor--pid))
    366     (remove-hook 'kill-buffer-query-functions
    367                  #'with-editor-kill-buffer-noop t)
    368     (cond (cancel
    369            (save-buffer)
    370            (if clients
    371                (let ((buf (current-buffer)))
    372                  (dolist (client clients)
    373                    (message "client %S" client)
    374                    (ignore-errors
    375                      (server-send-string client "-error Canceled by user"))
    376                    (delete-process client))
    377                  (when (buffer-live-p buf)
    378                    (kill-buffer buf)))
    379              ;; Fallback for when emacs was used as $EDITOR
    380              ;; instead of emacsclient or the sleeping editor.
    381              ;; See https://github.com/magit/magit/issues/2258.
    382              (ignore-errors (delete-file buffer-file-name))
    383              (kill-buffer)))
    384           (t
    385            (save-buffer)
    386            (if clients
    387                ;; Don't use `server-edit' because we do not want to
    388                ;; show another buffer belonging to another client.
    389                ;; See https://github.com/magit/magit/issues/2197.
    390                (server-done)
    391              (kill-buffer))))
    392     (when pid
    393       (let ((default-directory dir))
    394         (process-file "kill" nil nil nil
    395                       "-s" (if cancel "USR2" "USR1") pid)))
    396     (when (and winconf (eq (window-configuration-frame winconf)
    397                            (selected-frame)))
    398       (set-window-configuration winconf))))
    399 
    400 ;;; Mode
    401 
    402 (defvar-keymap with-editor-mode-map
    403   "C-c C-c"                                #'with-editor-finish
    404   "<remap> <server-edit>"                  #'with-editor-finish
    405   "<remap> <evil-save-and-close>"          #'with-editor-finish
    406   "<remap> <evil-save-modified-and-close>" #'with-editor-finish
    407   "C-c C-k"                                #'with-editor-cancel
    408   "<remap> <kill-buffer>"                  #'with-editor-cancel
    409   "<remap> <ido-kill-buffer>"              #'with-editor-cancel
    410   "<remap> <iswitchb-kill-buffer>"         #'with-editor-cancel
    411   "<remap> <evil-quit>"                    #'with-editor-cancel)
    412 
    413 (define-minor-mode with-editor-mode
    414   "Edit a file as the $EDITOR of an external process."
    415   :lighter with-editor-mode-lighter
    416   ;; Protect the user from killing the buffer without using
    417   ;; either `with-editor-finish' or `with-editor-cancel',
    418   ;; and from removing the key bindings for these commands.
    419   (unless with-editor-mode
    420     (user-error "With-Editor mode cannot be turned off"))
    421   (add-hook 'kill-buffer-query-functions
    422             #'with-editor-kill-buffer-noop nil t)
    423   ;; `server-execute' displays a message which is not
    424   ;; correct when using this mode.
    425   (when with-editor-show-usage
    426     (with-editor-usage-message)))
    427 
    428 (put 'with-editor-mode 'permanent-local t)
    429 
    430 (defun with-editor-kill-buffer-noop ()
    431   ;; We started doing this in response to #64, but it is not safe
    432   ;; to do so, because the client has already been killed, causing
    433   ;; `with-editor-return' (called by `with-editor-cancel') to delete
    434   ;; the file, see #66.  The reason we delete the file in the first
    435   ;; place are https://github.com/magit/magit/issues/2258 and
    436   ;; https://github.com/magit/magit/issues/2248.
    437   ;; (if (memq this-command '(save-buffers-kill-terminal
    438   ;;                          save-buffers-kill-emacs))
    439   ;;     (let ((with-editor-cancel-query-functions nil))
    440   ;;       (with-editor-cancel nil)
    441   ;;       t)
    442   ;;   ...)
    443   ;; So go back to always doing this instead:
    444   (user-error (substitute-command-keys (format "\
    445 Don't kill this buffer %S.  Instead cancel using \\[with-editor-cancel]"
    446                                                (current-buffer)))))
    447 
    448 (defvar-local with-editor-usage-message "\
    449 Type \\[with-editor-finish] to finish, \
    450 or \\[with-editor-cancel] to cancel")
    451 
    452 (defun with-editor-usage-message ()
    453   ;; Run after `server-execute', which is run using
    454   ;; a timer which starts immediately.
    455   (let ((buffer (current-buffer)))
    456     (run-with-timer
    457      0.05 nil
    458      (lambda ()
    459        (with-current-buffer buffer
    460          (message (substitute-command-keys with-editor-usage-message)))))))
    461 
    462 ;;; Wrappers
    463 
    464 (defvar with-editor--envvar nil "For internal use.")
    465 
    466 (defmacro with-editor (&rest body)
    467   "Use the Emacsclient as $EDITOR while evaluating BODY.
    468 Modify the `process-environment' for processes started in BODY,
    469 instructing them to use the Emacsclient as $EDITOR.  If optional
    470 ENVVAR is a literal string then bind that environment variable
    471 instead.
    472 \n(fn [ENVVAR] BODY...)"
    473   (declare (indent defun) (debug (body)))
    474   `(let ((with-editor--envvar ,(if (stringp (car body))
    475                                    (pop body)
    476                                  '(or with-editor--envvar "EDITOR")))
    477          (process-environment process-environment))
    478      (with-editor--setup)
    479      ,@body))
    480 
    481 (defmacro with-editor* (envvar &rest body)
    482   "Use the Emacsclient as the editor while evaluating BODY.
    483 Modify the `process-environment' for processes started in BODY,
    484 instructing them to use the Emacsclient as editor.  ENVVAR is the
    485 environment variable that is exported to do so, it is evaluated
    486 at run-time.
    487 \n(fn [ENVVAR] BODY...)"
    488   (declare (indent defun) (debug (sexp body)))
    489   `(let ((with-editor--envvar ,envvar)
    490          (process-environment process-environment))
    491      (with-editor--setup)
    492      ,@body))
    493 
    494 (defun with-editor--setup ()
    495   (if (or (not with-editor-emacsclient-executable)
    496           (file-remote-p default-directory))
    497       (push (concat with-editor--envvar "=" with-editor-sleeping-editor)
    498             process-environment)
    499     ;; Make sure server-use-tcp's value is valid.
    500     (unless (featurep 'make-network-process '(:family local))
    501       (setq server-use-tcp t))
    502     ;; Make sure the server is running.
    503     (unless (process-live-p server-process)
    504       (when (server-running-p server-name)
    505         (setq server-name (format "server%s" (emacs-pid)))
    506         (when (server-running-p server-name)
    507           (server-force-delete server-name)))
    508       (server-start))
    509     ;; Tell $EDITOR to use the Emacsclient.
    510     (push (concat with-editor--envvar "="
    511                   ;; Quoting is the right thing to do.  Applications that
    512                   ;; fail because of that, are the ones that need fixing,
    513                   ;; e.g., by using 'eval "$EDITOR" file'.  See #121.
    514                   (shell-quote-argument
    515                    ;; If users set the executable manually, they might
    516                    ;; begin the path with "~", which would get quoted.
    517                    (if (string-prefix-p "~" with-editor-emacsclient-executable)
    518                        (concat (expand-file-name "~")
    519                                (substring with-editor-emacsclient-executable 1))
    520                      with-editor-emacsclient-executable))
    521                   ;; Tell the process where the server file is.
    522                   (and (not server-use-tcp)
    523                        (concat " --socket-name="
    524                                (shell-quote-argument
    525                                 (expand-file-name server-name
    526                                                   server-socket-dir)))))
    527           process-environment)
    528     (when server-use-tcp
    529       (push (concat "EMACS_SERVER_FILE="
    530                     (expand-file-name server-name server-auth-dir))
    531             process-environment))
    532     ;; As last resort fallback to the sleeping editor.
    533     (push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor)
    534           process-environment)))
    535 
    536 (defun with-editor-server-window ()
    537   (or (and buffer-file-name
    538            (cdr (cl-find-if (lambda (cons)
    539                               (string-match-p (car cons) buffer-file-name))
    540                             with-editor-server-window-alist)))
    541       server-window))
    542 
    543 (define-advice server-switch-buffer
    544     (:around (fn &optional next-buffer &rest args)
    545              with-editor-server-window-alist)
    546   "Honor `with-editor-server-window-alist' (which see)."
    547   (let ((server-window (with-current-buffer
    548                            (or next-buffer (current-buffer))
    549                          (when with-editor-mode
    550                            (setq with-editor-previous-winconf
    551                                  (current-window-configuration)))
    552                          (with-editor-server-window))))
    553     (apply fn next-buffer args)))
    554 
    555 (define-advice start-file-process
    556     (:around (fn name buffer program &rest program-args)
    557              with-editor-process-filter)
    558   "When called inside a `with-editor' form and the Emacsclient
    559 cannot be used, then give the process the filter function
    560 `with-editor-process-filter'.  To avoid overriding the filter
    561 being added here you should use `with-editor-set-process-filter'
    562 instead of `set-process-filter' inside `with-editor' forms.
    563 
    564 When the `default-directory' is located on a remote machine,
    565 then also manipulate PROGRAM and PROGRAM-ARGS in order to set
    566 the appropriate editor environment variable."
    567   (if (not with-editor--envvar)
    568       (apply fn name buffer program program-args)
    569     (when (file-remote-p default-directory)
    570       (unless (equal program "env")
    571         (push program program-args)
    572         (setq program "env"))
    573       (push (concat with-editor--envvar "=" with-editor-sleeping-editor)
    574             program-args))
    575     (let ((process (apply fn name buffer program program-args)))
    576       (set-process-filter process #'with-editor-process-filter)
    577       (process-put process 'default-dir default-directory)
    578       process)))
    579 
    580 (advice-add #'make-process :around
    581             #'make-process@with-editor-process-filter)
    582 (cl-defun make-process@with-editor-process-filter
    583     (fn &rest keys &key name buffer command coding noquery stop
    584         connection-type filter sentinel stderr file-handler
    585         &allow-other-keys)
    586   "When called inside a `with-editor' form and the Emacsclient
    587 cannot be used, then give the process the filter function
    588 `with-editor-process-filter'.  To avoid overriding the filter
    589 being added here you should use `with-editor-set-process-filter'
    590 instead of `set-process-filter' inside `with-editor' forms.
    591 
    592 When the `default-directory' is located on a remote machine and
    593 FILE-HANDLER is non-nil, then also manipulate COMMAND in order
    594 to set the appropriate editor environment variable."
    595   (if (or (not file-handler) (not with-editor--envvar))
    596       (apply fn keys)
    597     (when (file-remote-p default-directory)
    598       (unless (equal (car command) "env")
    599         (push "env" command))
    600       (push (concat with-editor--envvar "=" with-editor-sleeping-editor)
    601             (cdr command)))
    602     (let* ((filter (if filter
    603                        (lambda (process output)
    604                          (funcall filter process output)
    605                          (with-editor-process-filter process output t))
    606                      #'with-editor-process-filter))
    607            (process (funcall fn
    608                              :name name
    609                              :buffer buffer
    610                              :command command
    611                              :coding coding
    612                              :noquery noquery
    613                              :stop stop
    614                              :connection-type connection-type
    615                              :filter filter
    616                              :sentinel sentinel
    617                              :stderr stderr
    618                              :file-handler file-handler)))
    619       (process-put process 'default-dir default-directory)
    620       process)))
    621 
    622 (defun with-editor-set-process-filter (process filter)
    623   "Like `set-process-filter' but keep `with-editor-process-filter'.
    624 Give PROCESS the new FILTER but keep `with-editor-process-filter'
    625 if that was added earlier by the advised `start-file-process'.
    626 
    627 Do so by wrapping the two filter functions using a lambda, which
    628 becomes the actual filter.  It calls FILTER first, which may or
    629 may not insert the text into the PROCESS's buffer.  Then it calls
    630 `with-editor-process-filter', passing t as NO-STANDARD-FILTER."
    631   (set-process-filter
    632    process
    633    (if (eq (process-filter process) 'with-editor-process-filter)
    634        `(lambda (proc str)
    635           (,filter proc str)
    636           (with-editor-process-filter proc str t))
    637      filter)))
    638 
    639 (defvar with-editor-filter-visit-hook nil)
    640 
    641 (defconst with-editor-sleeping-editor-regexp "^\
    642 WITH-EDITOR: \\([0-9]+\\) \
    643 OPEN \\([^]+?\\)\
    644 \\(?:\\([^]*\\)\\)?\
    645 \\(?: IN \\([^\r]+?\\)\\)?\r?$")
    646 
    647 (defvar with-editor--max-incomplete-length 1000)
    648 
    649 (defun with-editor-sleeping-editor-filter (process string)
    650   (when-let ((incomplete (and process (process-get process 'incomplete))))
    651     (setq string (concat incomplete string)))
    652   (save-match-data
    653     (cond
    654      ((and process (not (string-suffix-p "\n" string)))
    655       (let ((length (length string)))
    656         (when (> length with-editor--max-incomplete-length)
    657           (setq string
    658                 (substring string
    659                            (- length with-editor--max-incomplete-length)))))
    660       (process-put process 'incomplete string)
    661       nil)
    662      ((string-match with-editor-sleeping-editor-regexp string)
    663       (when process
    664         (process-put process 'incomplete nil))
    665       (let ((pid  (match-string 1 string))
    666             (arg0 (match-string 2 string))
    667             (arg1 (match-string 3 string))
    668             (dir  (match-string 4 string))
    669             file line column)
    670         (cond ((string-match "\\`\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" arg0)
    671                (setq file arg1)
    672                (setq line (string-to-number (match-string 1 arg0)))
    673                (setq column (match-string 2 arg0))
    674                (setq column (and column (string-to-number column))))
    675               ((setq file arg0)))
    676         (unless (file-name-absolute-p file)
    677           (setq file (expand-file-name file dir)))
    678         (when default-directory
    679           (setq file (concat (file-remote-p default-directory) file)))
    680         (with-current-buffer (find-file-noselect file)
    681           (with-editor-mode 1)
    682           (setq with-editor--pid pid)
    683           (setq with-editor-previous-winconf
    684                 (current-window-configuration))
    685           (when line
    686             (let ((pos (save-excursion
    687                          (save-restriction
    688                            (goto-char (point-min))
    689                            (forward-line (1- line))
    690                            (when column
    691                              (move-to-column column))
    692                            (point)))))
    693               (when (and (buffer-narrowed-p)
    694                          widen-automatically
    695                          (not (<= (point-min) pos (point-max))))
    696                 (widen))
    697               (goto-char pos)))
    698           (run-hooks 'with-editor-filter-visit-hook)
    699           (funcall (or (with-editor-server-window) #'switch-to-buffer)
    700                    (current-buffer))
    701           (kill-local-variable 'server-window)))
    702       nil)
    703      (t string))))
    704 
    705 (defun with-editor-process-filter
    706     (process string &optional no-default-filter)
    707   "Listen for edit requests by child processes."
    708   (let ((default-directory (process-get process 'default-dir)))
    709     (with-editor-sleeping-editor-filter process string))
    710   (unless no-default-filter
    711     (internal-default-process-filter process string)))
    712 
    713 (define-advice server-visit-files
    714     (:after (files _proc &optional _nowait)
    715             with-editor-file-name-history-exclude)
    716   "Prevent certain files from being added to `file-name-history'.
    717 Files matching a regexp in `with-editor-file-name-history-exclude'
    718 are prevented from being added to that list."
    719   (pcase-dolist (`(,file . ,_) files)
    720     (when (cl-find-if (lambda (regexp)
    721                         (string-match-p regexp file))
    722                       with-editor-file-name-history-exclude)
    723       (setq file-name-history (delete file file-name-history)))))
    724 
    725 ;;; Augmentations
    726 
    727 ;;;###autoload
    728 (cl-defun with-editor-export-editor (&optional (envvar "EDITOR"))
    729   "Teach subsequent commands to use current Emacs instance as editor.
    730 
    731 Set and export the environment variable ENVVAR, by default
    732 \"EDITOR\".  The value is automatically generated to teach
    733 commands to use the current Emacs instance as \"the editor\".
    734 
    735 This works in `shell-mode', `term-mode', `eshell-mode' and
    736 `vterm'."
    737   (interactive (list (with-editor-read-envvar)))
    738   (cond
    739    ((derived-mode-p 'comint-mode 'term-mode)
    740     (when-let ((process (get-buffer-process (current-buffer))))
    741       (goto-char (process-mark process))
    742       (process-send-string
    743        process (format " export %s=%s\n" envvar
    744                        (shell-quote-argument with-editor-sleeping-editor)))
    745       (while (accept-process-output process 0.1))
    746       (if (derived-mode-p 'term-mode)
    747           (with-editor-set-process-filter process #'with-editor-emulate-terminal)
    748         (add-hook 'comint-output-filter-functions #'with-editor-output-filter
    749                   nil t))))
    750    ((derived-mode-p 'eshell-mode)
    751     (add-to-list 'eshell-preoutput-filter-functions
    752                  #'with-editor-output-filter)
    753     (setenv envvar with-editor-sleeping-editor))
    754    ((and (derived-mode-p 'vterm-mode)
    755          (fboundp 'vterm-send-return)
    756          (fboundp 'vterm-send-string))
    757     (if with-editor-emacsclient-executable
    758         (let ((with-editor--envvar envvar)
    759               (process-environment process-environment))
    760           (with-editor--setup)
    761           (while (accept-process-output vterm--process 0.1))
    762           (when-let ((v (getenv envvar)))
    763             (vterm-send-string (format " export %s=%S" envvar v))
    764             (vterm-send-return))
    765           (when-let ((v (getenv "EMACS_SERVER_FILE")))
    766             (vterm-send-string (format " export EMACS_SERVER_FILE=%S" v))
    767             (vterm-send-return))
    768           (vterm-send-string "clear")
    769           (vterm-send-return))
    770       (error "Cannot use sleeping editor in this buffer")))
    771    (t
    772     (error "Cannot export environment variables in this buffer")))
    773   (message "Successfully exported %s" envvar))
    774 
    775 ;;;###autoload
    776 (defun with-editor-export-git-editor ()
    777   "Like `with-editor-export-editor' but always set `$GIT_EDITOR'."
    778   (interactive)
    779   (with-editor-export-editor "GIT_EDITOR"))
    780 
    781 ;;;###autoload
    782 (defun with-editor-export-hg-editor ()
    783   "Like `with-editor-export-editor' but always set `$HG_EDITOR'."
    784   (interactive)
    785   (with-editor-export-editor "HG_EDITOR"))
    786 
    787 (defun with-editor-output-filter (string)
    788   "Handle edit requests on behalf of `comint-mode' and `eshell-mode'."
    789   (with-editor-sleeping-editor-filter nil string))
    790 
    791 (defun with-editor-emulate-terminal (process string)
    792   "Like `term-emulate-terminal' but also handle edit requests."
    793   (let ((with-editor-sleeping-editor-regexp
    794          (substring with-editor-sleeping-editor-regexp 1)))
    795     (with-editor-sleeping-editor-filter process string))
    796   (term-emulate-terminal process string))
    797 
    798 (defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR"))
    799 
    800 (cl-defun with-editor-read-envvar
    801     (&optional (prompt  "Set environment variable")
    802                (default "EDITOR"))
    803   (let ((reply (completing-read (if default
    804                                     (format "%s (%s): " prompt default)
    805                                   (concat prompt ": "))
    806                                 with-editor-envvars nil nil nil nil default)))
    807     (if (string= reply "") (user-error "Nothing selected") reply)))
    808 
    809 ;;;###autoload
    810 (define-minor-mode shell-command-with-editor-mode
    811   "Teach `shell-command' to use current Emacs instance as editor.
    812 
    813 Teach `shell-command', and all commands that ultimately call that
    814 command, to use the current Emacs instance as editor by executing
    815 \"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\".
    816 
    817 CLIENT is automatically generated; EDITOR=CLIENT instructs
    818 COMMAND to use to the current Emacs instance as \"the editor\",
    819 assuming no other variable overrides the effect of \"$EDITOR\".
    820 CLIENT may be the path to an appropriate emacsclient executable
    821 with arguments, or a script which also works over Tramp.
    822 
    823 Alternatively you can use the `with-editor-async-shell-command',
    824 which also allows the use of another variable instead of
    825 \"EDITOR\"."
    826   :global t)
    827 
    828 ;;;###autoload
    829 (defun with-editor-async-shell-command
    830     (command &optional output-buffer error-buffer envvar)
    831   "Like `async-shell-command' but with `$EDITOR' set.
    832 
    833 Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell;
    834 display output, if any.  With a prefix argument prompt for an
    835 environment variable, otherwise the default \"EDITOR\" variable
    836 is used.  With a negative prefix argument additionally insert
    837 the COMMAND's output at point.
    838 
    839 CLIENT is automatically generated; ENVVAR=CLIENT instructs
    840 COMMAND to use to the current Emacs instance as \"the editor\",
    841 assuming it respects ENVVAR as an \"EDITOR\"-like variable.
    842 CLIENT may be the path to an appropriate emacsclient executable
    843 with arguments, or a script which also works over Tramp.
    844 
    845 Also see `async-shell-command' and `shell-command'."
    846   (interactive (with-editor-shell-command-read-args "Async shell command: " t))
    847   (let ((with-editor--envvar envvar))
    848     (with-editor
    849       (async-shell-command command output-buffer error-buffer))))
    850 
    851 ;;;###autoload
    852 (defun with-editor-shell-command
    853     (command &optional output-buffer error-buffer envvar)
    854   "Like `shell-command' or `with-editor-async-shell-command'.
    855 If COMMAND ends with \"&\" behave like the latter,
    856 else like the former."
    857   (interactive (with-editor-shell-command-read-args "Shell command: "))
    858   (if (string-match "&[ \t]*\\'" command)
    859       (with-editor-async-shell-command
    860        command output-buffer error-buffer envvar)
    861     (shell-command command output-buffer error-buffer)))
    862 
    863 (defun with-editor-shell-command-read-args (prompt &optional async)
    864   (let ((command (read-shell-command
    865                   prompt nil nil
    866                   (let ((filename (or buffer-file-name
    867                                       (and (eq major-mode 'dired-mode)
    868                                            (dired-get-filename nil t)))))
    869                     (and filename (file-relative-name filename))))))
    870     (list command
    871           (if (or async (setq async (string-match-p "&[ \t]*\\'" command)))
    872               (< (prefix-numeric-value current-prefix-arg) 0)
    873             current-prefix-arg)
    874           shell-command-default-error-buffer
    875           (and async current-prefix-arg (with-editor-read-envvar)))))
    876 
    877 (define-advice shell-command
    878     (:around (fn command &optional output-buffer error-buffer)
    879              shell-command-with-editor-mode)
    880   "`shell-mode' and its hook are intended for buffers in which an
    881 interactive shell is running, but `shell-command' also turns on
    882 that mode, even though it only runs the shell to run a single
    883 command.  The `with-editor-export-editor' hook function is only
    884 intended to be used in buffers in which an interactive shell is
    885 running, so it has to be removed here."
    886   (let ((shell-mode-hook (remove 'with-editor-export-editor shell-mode-hook)))
    887     (cond ((or (not (or with-editor--envvar shell-command-with-editor-mode))
    888                (not (string-suffix-p "&" command)))
    889            (funcall fn command output-buffer error-buffer))
    890           ((and with-editor-shell-command-use-emacsclient
    891                 with-editor-emacsclient-executable
    892                 (not (file-remote-p default-directory)))
    893            (with-editor (funcall fn command output-buffer error-buffer)))
    894           (t
    895            (funcall fn (format "%s=%s %s"
    896                                (or with-editor--envvar "EDITOR")
    897                                (shell-quote-argument with-editor-sleeping-editor)
    898                                command)
    899                     output-buffer error-buffer)
    900            (ignore-errors
    901              (let ((process (get-buffer-process
    902                              (or output-buffer
    903                                  (get-buffer "*Async Shell Command*")))))
    904                (set-process-filter
    905                 process (lambda (proc str)
    906                           (comint-output-filter proc str)
    907                           (with-editor-process-filter proc str t)))
    908                process))))))
    909 
    910 ;;; _
    911 
    912 (defun with-editor-debug ()
    913   "Debug configuration issues.
    914 See info node `(with-editor)Debugging' for instructions."
    915   (interactive)
    916   (require 'warnings)
    917   (with-current-buffer (get-buffer-create "*with-editor-debug*")
    918     (pop-to-buffer (current-buffer))
    919     (erase-buffer)
    920     (ignore-errors (with-editor))
    921     (insert
    922      (format "with-editor: %s\n" (locate-library "with-editor.el"))
    923      (format "emacs: %s (%s)\n"
    924              (expand-file-name invocation-name invocation-directory)
    925              emacs-version)
    926      "system:\n"
    927      (format "  system-type: %s\n" system-type)
    928      (format "  system-configuration: %s\n" system-configuration)
    929      (format "  system-configuration-options: %s\n" system-configuration-options)
    930      "server:\n"
    931      (format "  server-running-p: %s\n" (server-running-p))
    932      (format "  server-process: %S\n" server-process)
    933      (format "  server-use-tcp: %s\n" server-use-tcp)
    934      (format "  server-name: %s\n" server-name)
    935      (format "  server-socket-dir: %s\n" server-socket-dir))
    936     (if (and server-socket-dir (file-accessible-directory-p server-socket-dir))
    937         (dolist (file (directory-files server-socket-dir nil "^[^.]"))
    938           (insert (format "    %s\n" file)))
    939       (insert (format "    %s: not an accessible directory\n"
    940                       (if server-use-tcp "WARNING" "ERROR"))))
    941     (insert (format "  server-auth-dir: %s\n" server-auth-dir))
    942     (if (file-accessible-directory-p server-auth-dir)
    943         (dolist (file (directory-files server-auth-dir nil "^[^.]"))
    944           (insert (format "    %s\n" file)))
    945       (insert (format "    %s: not an accessible directory\n"
    946                       (if server-use-tcp "ERROR" "WARNING"))))
    947     (let ((val with-editor-emacsclient-executable)
    948           (def (default-value 'with-editor-emacsclient-executable))
    949           (fun (let ((warning-minimum-level :error)
    950                      (warning-minimum-log-level :error))
    951                  (with-editor-locate-emacsclient))))
    952       (insert "with-editor-emacsclient-executable:\n"
    953               (format " value:   %s (%s)\n" val
    954                       (and val (with-editor-emacsclient-version val)))
    955               (format " default: %s (%s)\n" def
    956                       (and def (with-editor-emacsclient-version def)))
    957               (format " funcall: %s (%s)\n" fun
    958                       (and fun (with-editor-emacsclient-version fun)))))
    959     (insert "path:\n"
    960             (format "  $PATH:     %s\n" (split-string (getenv "PATH") ":"))
    961             (format "  exec-path: %s\n" exec-path))
    962     (insert (format "  with-editor-emacsclient-path:\n"))
    963     (dolist (dir (with-editor-emacsclient-path))
    964       (insert (format "    %s (%s)\n" dir (car (file-attributes dir))))
    965       (when (file-directory-p dir)
    966         ;; Don't match emacsclientw.exe, it makes popup windows.
    967         (dolist (exec (directory-files dir t "emacsclient\\(?:[^w]\\|\\'\\)"))
    968           (insert (format "      %s (%s)\n" exec
    969                           (with-editor-emacsclient-version exec))))))))
    970 
    971 (defconst with-editor-font-lock-keywords
    972   '(("(\\(with-\\(?:git-\\)?editor\\)\\_>" (1 'font-lock-keyword-face))))
    973 (font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords)
    974 
    975 (provide 'with-editor)
    976 ;; Local Variables:
    977 ;; indent-tabs-mode: nil
    978 ;; byte-compile-warnings: (not docstrings-control-chars)
    979 ;; End:
    980 ;;; with-editor.el ends here