dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

with-editor.el (40848B)


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