config

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

with-editor.el (43324B)


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