.emacs.d.git - Gitblit

Chizi123

2018-11-19 a4b9172aefa91861b587831e06f55b1e19f3f3be

commit \| author \| age
5cb5f7	1	;;; with-editor.el --- Use the Emacsclient as $EDITOR -- lexical-binding: t --
C	2
	3	;; Copyright (C) 2014-2018 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
	11	;; Package-Requires: ((emacs "24.4") (async "1.9"))
	12	;; Keywords: tools
	13	;; Homepage: https://github.com/magit/with-editor
	14
	15	;; This file is not part of GNU Emacs.
	16
	17	;; This file is free software; you can redistribute it and/or modify
	18	;; it under the terms of the GNU General Public License as published by
	19	;; the Free Software Foundation; either version 3, or (at your option)
	20	;; any later version.
	21
	22	;; This file is distributed in the hope that it will be useful,
	23	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	24	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	25	;; GNU General Public License for more details.
	26
	27	;; You should have received a copy of the GNU General Public License
	28	;; along with Magit. If not, see http://www.gnu.org/licenses.
	29
	30	;;; Commentary:
	31
	32	;; This library makes it possible to reliably use the Emacsclient as
	33	;; the `$EDITOR' of child processes. It makes sure that they know how
	34	;; to call home. For remote processes a substitute is provided, which
	35	;; communicates with Emacs on standard output/input instead of using a
	36	;; socket as the Emacsclient does.
	37
	38	;; It provides the commands `with-editor-async-shell-command' and
	39	;; `with-editor-shell-command', which are intended as replacements
	40	;; for `async-shell-command' and `shell-command'. They automatically
	41	;; export `$EDITOR' making sure the executed command uses the current
	42	;; Emacs instance as "the editor". With a prefix argument these
	43	;; commands prompt for an alternative environment variable such as
	44	;; `$GIT_EDITOR'. To always use these variants add this to your init
	45	;; file:
	46	;;
	47	;; (define-key (current-global-map)
	48	;; [remap async-shell-command] 'with-editor-async-shell-command)
	49	;; (define-key (current-global-map)
	50	;; [remap shell-command] 'with-editor-shell-command)
	51
	52	;; Alternatively use the global `shell-command-with-editor-mode',
	53	;; which always sets `$EDITOR' for all Emacs commands which ultimately
	54	;; use `shell-command' to asynchronously run some shell command.
	55
	56	;; The command `with-editor-export-editor' exports `$EDITOR' or
	57	;; another such environment variable in `shell-mode', `term-mode' and
	58	;; `eshell-mode' buffers. Use this Emacs command before executing a
	59	;; shell command which needs the editor set, or always arrange for the
	60	;; current Emacs instance to be used as editor by adding it to the
	61	;; appropriate mode hooks:
	62	;;
	63	;; (add-hook 'shell-mode-hook 'with-editor-export-editor)
	64	;; (add-hook 'term-exec-hook 'with-editor-export-editor)
	65	;; (add-hook 'eshell-mode-hook 'with-editor-export-editor)
	66
	67	;; Some variants of this function exist, these two forms are
	68	;; equivalent:
	69	;;
	70	;; (add-hook 'shell-mode-hook
	71	;; (apply-partially 'with-editor-export-editor "GIT_EDITOR"))
	72	;; (add-hook 'shell-mode-hook 'with-editor-export-git-editor)
	73
	74	;; This library can also be used by other packages which need to use
	75	;; the current Emacs instance as editor. In fact this library was
	76	;; written for Magit and its `git-commit-mode' and `git-rebase-mode'.
	77	;; Consult `git-rebase.el' and the related code in `magit-sequence.el'
	78	;; for a simple example.
	79
	80	;;; Code:
	81
	82	(require 'cl-lib)
	83	;; `pcase-dolist' is not autoloaded on Emacs 24.
	84	(eval-when-compile (require 'pcase))
	85	(require 'server)
	86	(require 'shell)
	87
	88	(and (require 'async-bytecomp nil t)
	89	(memq 'magit (bound-and-true-p async-bytecomp-allowed-packages))
	90	(fboundp 'async-bytecomp-package-mode)
	91	(async-bytecomp-package-mode 1))
	92
	93	(eval-when-compile
	94	(progn (require 'dired nil t)
	95	(require 'eshell nil t)
	96	(require 'term nil t)
	97	(require 'warnings nil t)))
	98	(declare-function dired-get-filename 'dired)
	99	(declare-function term-emulate-terminal 'term)
	100	(defvar eshell-preoutput-filter-functions)
	101
	102	;;; Options
	103
	104	(defgroup with-editor nil
	105	"Use the Emacsclient as $EDITOR."
	106	:group 'external
	107	:group 'server)
	108
	109	(defun with-editor-locate-emacsclient ()
	110	"Search for a suitable Emacsclient executable."
	111	(or (with-editor-locate-emacsclient-1
	112	(with-editor-emacsclient-path)
	113	(length (split-string emacs-version "\\.")))
	114	(prog1 nil (display-warning 'with-editor "\
	115	Cannot determine a suitable Emacsclient
	116
	117	Determining an Emacsclient executable suitable for the
	118	current Emacs instance failed. For more information
	119	please see https://github.com/magit/magit/wiki/Emacsclient."))))
	120
	121	(defun with-editor-locate-emacsclient-1 (path depth)
	122	(let* ((version-lst (cl-subseq (split-string emacs-version "\\.") 0 depth))
	123	(version-reg (concat "^" (mapconcat #'identity version-lst "\\."))))
	124	(or (locate-file-internal
	125	(if (equal (downcase invocation-name) "remacs")
	126	"remacsclient"
	127	"emacsclient")
	128	path
	129	(cl-mapcan
	130	(lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes))
	131	(nconc (and (boundp 'debian-emacs-flavor)
	132	(list (format ".%s" debian-emacs-flavor)))
	133	(cl-mapcon (lambda (v)
	134	(setq v (mapconcat #'identity (reverse v) "."))
	135	(list v (concat "-" v) (concat ".emacs" v)))
	136	(reverse version-lst))
	137	(list "" "-snapshot" ".emacs-snapshot")))
	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-match-p "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	echo \"WITH-EDITOR: $$ OPEN $0 IN $(pwd)\"; \
	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 \\\"WITH-EDITOR: $$ OPEN $0 IN $(pwd)\\\"; \\
	206	trap \\\"exit 0\\\" USR1; \\
	207	trap \\\"exit 1\" USR2; \\
	208	while true; do sleep 1; done'\"
	209
	210	Note that the unit seperator character () right after the file
	211	name ($0) is required.
	212
	213	Also note that using this alternative implementation leads to a
	214	delay of up to a second. The delay can be shortened by replacing
	215	\"sleep 1\" with \"sleep 0.01\", or if your implementation does
	216	not support floats, then by using \"nanosleep\" instead."
	217	:package-version '(with-editor . "2.8.0")
	218	:group 'with-editor
	219	:type 'string)
	220
	221	(defcustom with-editor-finish-query-functions nil
	222	"List of functions called to query before finishing session.
	223
	224	The buffer in question is current while the functions are called.
	225	If any of them returns nil, then the session is not finished and
	226	the buffer is not killed. The user should then fix the issue and
	227	try again. The functions are called with one argument. If it is
	228	non-nil then that indicates that the user used a prefix argument
	229	to force finishing the session despite issues. Functions should
	230	usually honor that and return non-nil."
	231	:group 'with-editor
	232	:type 'hook)
	233	(put 'with-editor-finish-query-functions 'permanent-local t)
	234
	235	(defcustom with-editor-cancel-query-functions nil
	236	"List of functions called to query before canceling session.
	237
	238	The buffer in question is current while the functions are called.
	239	If any of them returns nil, then the session is not canceled and
	240	the buffer is not killed. The user should then fix the issue and
	241	try again. The functions are called with one argument. If it is
	242	non-nil then that indicates that the user used a prefix argument
	243	to force canceling the session despite issues. Functions should
	244	usually honor that and return non-nil."
	245	:group 'with-editor
	246	:type 'hook)
	247	(put 'with-editor-cancel-query-functions 'permanent-local t)
	248
	249	(defcustom with-editor-mode-lighter " WE"
	250	"The mode-line lighter of the With-Editor mode."
	251	:group 'with-editor
	252	:type '(choice (const :tag "No lighter" "") string))
	253
	254	(defvar with-editor-server-window-alist nil
	255	"Alist of filename patterns vs corresponding `server-window'.
	256
	257	Each element looks like (REGEXP . FUNCTION). Files matching
	258	REGEXP are selected using FUNCTION instead of the default in
	259	`server-window'.
	260
	261	Note that when a package adds an entry here then it probably
	262	has a reason to disrespect `server-window' and it likely is
	263	not a good idea to change such entries.")
	264
	265	(defvar with-editor-file-name-history-exclude nil
	266	"List of regexps for filenames `server-visit' should not remember.
	267	When a filename matches any of the regexps, then `server-visit'
	268	does not add it to the variable `file-name-history', which is
	269	used when reading a filename in the minibuffer.")
	270
	271	(defcustom with-editor-shell-command-use-emacsclient t
	272	"Whether to use the emacsclient when running shell commands.
	273
	274	This affects `with-editor-shell-command-async' and, if the input
	275	ends with \"&\" `with-editor-shell-command' .
	276
	277	If `shell-command-with-editor-mode' is enabled, then it also
	278	affects `shell-command-async' and, if the input ends with \"&\"
	279	`shell-command'.
	280
	281	This is a temporary kludge that lets you choose between two
	282	possible defects, the ones described in the issues #23 and #40.
	283
	284	When t, then use the emacsclient. This has the disadvantage that
	285	`with-editor-mode' won't be enabled because we don't know whether
	286	this package was involved at all in the call to the emacsclient,
	287	and when it is not, then we really should. The problem is that
	288	the emacsclient doesn't pass a long any environment variables to
	289	the server. This will hopefully be fixed in Emacs eventually.
	290
	291	When nil, then use the sleeping editor. Because in this case we
	292	know that this package is involved, we can enable the mode. But
	293	this makes it necessary that you invoke $EDITOR in shell scripts
	294	like so:
	295
	296	eval \"$EDITOR\" file
	297
	298	And some tools that do not handle $EDITOR properly also break."
	299	:package-version '(with-editor . "2.7.1")
	300	:group 'with-editor
	301	:type 'boolean)
	302
	303	;;; Mode Commands
	304
	305	(defvar with-editor-pre-finish-hook nil)
	306	(defvar with-editor-pre-cancel-hook nil)
	307	(defvar with-editor-post-finish-hook nil)
	308	(defvar with-editor-post-finish-hook-1 nil)
	309	(defvar with-editor-post-cancel-hook nil)
	310	(defvar with-editor-post-cancel-hook-1 nil)
	311	(defvar with-editor-cancel-alist nil)
	312	(put 'with-editor-pre-finish-hook 'permanent-local t)
	313	(put 'with-editor-pre-cancel-hook 'permanent-local t)
	314	(put 'with-editor-post-finish-hook 'permanent-local t)
	315	(put 'with-editor-post-cancel-hook 'permanent-local t)
	316
	317	(defvar with-editor-show-usage t)
	318	(defvar with-editor-cancel-message nil)
	319	(defvar with-editor-previous-winconf nil)
	320	(make-variable-buffer-local 'with-editor-show-usage)
	321	(make-variable-buffer-local 'with-editor-cancel-message)
	322	(make-variable-buffer-local 'with-editor-previous-winconf)
	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 (bound-and-true-p git-commit-post-finish-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	(dolist (client clients)
	378	(ignore-errors
	379	(server-send-string client "-error Canceled by user"))
	380	(delete-process client))
	381	;; Fallback for when emacs was used as $EDITOR
	382	;; instead of emacsclient or the sleeping editor.
	383	;; See https://github.com/magit/magit/issues/2258.
	384	(ignore-errors (delete-file buffer-file-name))
	385	(kill-buffer)))
	386	(t
	387	(save-buffer)
	388	(if clients
	389	;; Don't use `server-edit' because we do not want to
	390	;; show another buffer belonging to another client.
	391	;; See https://github.com/magit/magit/issues/2197.
	392	(server-done)
	393	(kill-buffer))))
	394	(when pid
	395	(let ((default-directory dir))
	396	(process-file "kill" nil nil nil
	397	"-s" (if cancel "USR2" "USR1") pid)))
	398	(when (and winconf (eq (window-configuration-frame winconf)
	399	(selected-frame)))
	400	(set-window-configuration winconf))))
	401
	402	;;; Mode
	403
	404	(defvar with-editor-mode-map
	405	(let ((map (make-sparse-keymap)))
	406	(define-key map "\C-c\C-c" 'with-editor-finish)
	407	(define-key map [remap server-edit] 'with-editor-finish)
	408	(define-key map [remap evil-save-and-close] 'with-editor-finish)
	409	(define-key map [remap evil-save-modified-and-close] 'with-editor-finish)
	410	(define-key map "\C-c\C-k" 'with-editor-cancel)
	411	(define-key map [remap kill-buffer] 'with-editor-cancel)
	412	(define-key map [remap ido-kill-buffer] 'with-editor-cancel)
	413	(define-key map [remap iswitchb-kill-buffer] 'with-editor-cancel)
	414	(define-key map [remap evil-quit] 'with-editor-cancel)
	415	map))
	416
	417	(define-minor-mode with-editor-mode
	418	"Edit a file as the $EDITOR of an external process."
	419	:lighter with-editor-mode-lighter
	420	;; Protect the user from killing the buffer without using
	421	;; either `with-editor-finish' or `with-editor-cancel',
	422	;; and from removing the key bindings for these commands.
	423	(unless with-editor-mode
	424	(user-error "With-Editor mode cannot be turned off"))
	425	(add-hook 'kill-buffer-query-functions
	426	'with-editor-kill-buffer-noop nil t)
	427	;; `server-execute' displays a message which is not
	428	;; correct when using this mode.
	429	(when with-editor-show-usage
	430	(with-editor-usage-message)))
	431
	432	(put 'with-editor-mode 'permanent-local t)
	433
	434	(defun with-editor-kill-buffer-noop ()
	435	(user-error (substitute-command-keys "\
	436	Don't kill this buffer. Instead cancel using \\[with-editor-cancel]")))
	437
	438	(defun with-editor-usage-message ()
	439	;; Run after `server-execute', which is run using
	440	;; a timer which starts immediately.
	441	(run-with-timer
	442	0.01 nil `(lambda ()
	443	(with-current-buffer ,(current-buffer)
	444	(message (substitute-command-keys "\
	445	Type \\[with-editor-finish] to finish, \
	446	or \\[with-editor-cancel] to cancel"))))))
	447
	448	;;; Wrappers
	449
	450	(defvar with-editor--envvar nil "For internal use.")
	451
	452	(defmacro with-editor (&rest body)
	453	"Use the Emacsclient as $EDITOR while evaluating BODY.
	454	Modify the `process-environment' for processes started in BODY,
	455	instructing them to use the Emacsclient as $EDITOR. If optional
	456	ENVVAR is a literal string then bind that environment variable
	457	instead.
	458	\n(fn [ENVVAR] BODY...)"
	459	(declare (indent defun) (debug (body)))
	460	`(let ((with-editor--envvar ,(if (stringp (car body))
	461	(pop body)
	462	'(or with-editor--envvar "EDITOR")))
	463	(process-environment process-environment))
	464	(with-editor--setup)
	465	,@body))
	466
	467	(defmacro with-editor* (envvar &rest body)
	468	"Use the Emacsclient as the editor while evaluating BODY.
	469	Modify the `process-environment' for processes started in BODY,
	470	instructing them to use the Emacsclient as editor. ENVVAR is the
	471	environment variable that is exported to do so, it is evaluated
	472	at run-time.
	473	\n(fn [ENVVAR] BODY...)"
	474	(declare (indent defun) (debug (sexp body)))
	475	`(let ((with-editor--envvar ,envvar)
	476	(process-environment process-environment))
	477	(with-editor--setup)
	478	,@body))
	479
	480	(defun with-editor--setup ()
	481	(if (or (not with-editor-emacsclient-executable)
	482	(file-remote-p default-directory))
	483	(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
	484	process-environment)
	485	;; Make sure server-use-tcp's value is valid.
	486	(unless (featurep 'make-network-process '(:family local))
	487	(setq server-use-tcp t))
	488	;; Make sure the server is running.
	489	(unless (process-live-p server-process)
	490	(when (server-running-p server-name)
	491	(setq server-name (format "server%s" (emacs-pid)))
	492	(when (server-running-p server-name)
	493	(server-force-delete server-name)))
	494	(server-start))
	495	;; Tell $EDITOR to use the Emacsclient.
	496	(push (concat with-editor--envvar "="
	497	(shell-quote-argument with-editor-emacsclient-executable)
	498	;; Tell the process where the server file is.
	499	(and (not server-use-tcp)
	500	(concat " --socket-name="
	501	(shell-quote-argument
	502	(expand-file-name server-name
	503	server-socket-dir)))))
	504	process-environment)
	505	(when server-use-tcp
	506	(push (concat "EMACS_SERVER_FILE="
	507	(expand-file-name server-name server-auth-dir))
	508	process-environment))
	509	;; As last resort fallback to the sleeping editor.
	510	(push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor)
	511	process-environment)))
	512
	513	(defun with-editor-server-window ()
	514	(or (and buffer-file-name
	515	(cdr (cl-find-if (lambda (cons)
	516	(string-match-p (car cons) buffer-file-name))
	517	with-editor-server-window-alist)))
	518	server-window))
	519
	520	(defun server-switch-buffer--with-editor-server-window-alist
	521	(fn &optional next-buffer killed-one filepos)
	522	"Honor `with-editor-server-window-alist' (which see)."
	523	(let ((server-window (with-current-buffer
	524	(or next-buffer (current-buffer))
	525	(when with-editor-mode
	526	(setq with-editor-previous-winconf
	527	(current-window-configuration)))
	528	(with-editor-server-window))))
	529	(funcall fn next-buffer killed-one filepos)))
	530
	531	(advice-add 'server-switch-buffer :around
	532	'server-switch-buffer--with-editor-server-window-alist)
	533
	534	(defun start-file-process--with-editor-process-filter
	535	(fn name buffer program &rest program-args)
	536	"When called inside a `with-editor' form and the Emacsclient
	537	cannot be used, then give the process the filter function
	538	`with-editor-process-filter'. To avoid overriding the filter
	539	being added here you should use `with-editor-set-process-filter'
	540	instead of `set-process-filter' inside `with-editor' forms.
	541
	542	When the `default-directory' is located on a remote machine,
	543	then also manipulate PROGRAM and PROGRAM-ARGS in order to set
	544	the appropriate editor environment variable."
	545	(if (not with-editor--envvar)
	546	(apply fn name buffer program program-args)
	547	(when (file-remote-p default-directory)
	548	(unless (equal program "env")
	549	(push program program-args)
	550	(setq program "env"))
	551	(push (concat with-editor--envvar "=" with-editor-sleeping-editor)
	552	program-args))
	553	(let ((process (apply fn name buffer program program-args)))
	554	(set-process-filter process 'with-editor-process-filter)
	555	(process-put process 'default-dir default-directory)
	556	process)))
	557
	558	(advice-add 'start-file-process :around
	559	'start-file-process--with-editor-process-filter)
	560
	561	(defun with-editor-set-process-filter (process filter)
	562	"Like `set-process-filter' but keep `with-editor-process-filter'.
	563	Give PROCESS the new FILTER but keep `with-editor-process-filter'
	564	if that was added earlier by the adviced `start-file-process'.
	565
	566	Do so by wrapping the two filter functions using a lambda, which
	567	becomes the actual filter. It calls `with-editor-process-filter'
	568	first, passing t as NO-STANDARD-FILTER. Then it calls FILTER,
	569	which may or may not insert the text into the PROCESS' buffer."
	570	(set-process-filter
	571	process
	572	(if (eq (process-filter process) 'with-editor-process-filter)
	573	`(lambda (proc str)
	574	(,filter proc str)
	575	(with-editor-process-filter proc str t))
	576	filter)))
	577
	578	(defvar with-editor-filter-visit-hook nil)
	579
	580	(defun with-editor-output-filter (string)
	581	(save-match-data
	582	(if (string-match "^WITH-EDITOR: \
	583	\$[0-9]+\$ OPEN \$[^]+?\$\
	584	\$?: IN \\([^\r]+?\$\\)?\r?$" string)
	585	(let ((pid (match-string 1 string))
	586	(file (match-string 2 string))
	587	(dir (match-string 3 string)))
	588	(unless (file-name-absolute-p file)
	589	(setq file (expand-file-name file dir)))
	590	(when default-directory
	591	(setq file (concat (file-remote-p default-directory) file)))
	592	(with-current-buffer (find-file-noselect file)
	593	(with-editor-mode 1)
	594	(setq with-editor--pid pid)
	595	(run-hooks 'with-editor-filter-visit-hook)
	596	(funcall (or (with-editor-server-window) 'switch-to-buffer)
	597	(current-buffer))
	598	(kill-local-variable 'server-window))
	599	nil)
	600	string)))
	601
	602	(defun with-editor-process-filter
	603	(process string &optional no-default-filter)
	604	"Listen for edit requests by child processes."
	605	(let ((default-directory (process-get process 'default-dir)))
	606	(with-editor-output-filter string))
	607	(unless no-default-filter
	608	(internal-default-process-filter process string)))
	609
	610	(advice-add 'server-visit-files :after
	611	'server-visit-files--with-editor-file-name-history-exclude)
	612
	613	(defun server-visit-files--with-editor-file-name-history-exclude
	614	(files _proc &optional _nowait)
	615	(pcase-dolist (`(,file . ,_) files)
	616	(when (cl-find-if (lambda (regexp)
	617	(string-match-p regexp file))
	618	with-editor-file-name-history-exclude)
	619	(setq file-name-history (delete file file-name-history)))))
	620
	621	;;; Augmentations
	622
	623	;;;###autoload
	624	(cl-defun with-editor-export-editor (&optional (envvar "EDITOR"))
	625	"Teach subsequent commands to use current Emacs instance as editor.
	626
	627	Set and export the environment variable ENVVAR, by default
	628	\"EDITOR\". The value is automatically generated to teach
	629	commands to use the current Emacs instance as \"the editor\".
	630
	631	This works in `shell-mode', `term-mode' and `eshell-mode'."
	632	(interactive (list (with-editor-read-envvar)))
	633	(cond
	634	((derived-mode-p 'comint-mode 'term-mode)
	635	(let ((process (get-buffer-process (current-buffer))))
	636	(goto-char (process-mark process))
	637	(process-send-string
	638	process (format " export %s=%s\n" envvar
	639	(shell-quote-argument with-editor-sleeping-editor)))
	640	(while (accept-process-output process 0.1))
	641	(if (derived-mode-p 'term-mode)
	642	(with-editor-set-process-filter process 'with-editor-emulate-terminal)
	643	(add-hook 'comint-output-filter-functions 'with-editor-output-filter
	644	nil t))))
	645	((derived-mode-p 'eshell-mode)
	646	(add-to-list 'eshell-preoutput-filter-functions
	647	'with-editor-output-filter)
	648	(setenv envvar with-editor-sleeping-editor))
	649	(t
	650	(error "Cannot export environment variables in this buffer")))
	651	(message "Successfully exported %s" envvar))
	652
	653	;;;###autoload
	654	(defun with-editor-export-git-editor ()
	655	"Like `with-editor-export-editor' but always set `$GIT_EDITOR'."
	656	(interactive)
	657	(with-editor-export-editor "GIT_EDITOR"))
	658
	659	;;;###autoload
	660	(defun with-editor-export-hg-editor ()
	661	"Like `with-editor-export-editor' but always set `$HG_EDITOR'."
	662	(interactive)
	663	(with-editor-export-editor "HG_EDITOR"))
	664
	665	(defun with-editor-emulate-terminal (process string)
	666	"Like `term-emulate-terminal' but also handle edit requests."
	667	(when (with-editor-output-filter string)
	668	(term-emulate-terminal process string)))
	669
	670	(defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR"))
	671
	672	(cl-defun with-editor-read-envvar
	673	(&optional (prompt "Set environment variable")
	674	(default "EDITOR"))
	675	(let ((reply (completing-read (if default
	676	(format "%s (%s): " prompt default)
	677	(concat prompt ": "))
	678	with-editor-envvars nil nil nil nil default)))
	679	(if (string= reply "") (user-error "Nothing selected") reply)))
	680
	681	;;;###autoload
	682	(define-minor-mode shell-command-with-editor-mode
	683	"Teach `shell-command' to use current Emacs instance as editor.
	684
	685	Teach `shell-command', and all commands that ultimately call that
	686	command, to use the current Emacs instance as editor by executing
	687	\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\".
	688
	689	CLIENT is automatically generated; EDITOR=CLIENT instructs
	690	COMMAND to use to the current Emacs instance as \"the editor\",
	691	assuming no other variable overrides the effect of \"$EDITOR\".
	692	CLIENT may be the path to an appropriate emacsclient executable
	693	with arguments, or a script which also works over Tramp.
	694
	695	Alternatively you can use the `with-editor-async-shell-command',
	696	which also allows the use of another variable instead of
	697	\"EDITOR\"."
	698	:global t)
	699
	700	;;;###autoload
	701	(defun with-editor-async-shell-command
	702	(command &optional output-buffer error-buffer envvar)
	703	"Like `async-shell-command' but with `$EDITOR' set.
	704
	705	Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell;
	706	display output, if any. With a prefix argument prompt for an
	707	environment variable, otherwise the default \"EDITOR\" variable
	708	is used. With a negative prefix argument additionally insert
	709	the COMMAND's output at point.
	710
	711	CLIENT is automatically generated; ENVVAR=CLIENT instructs
	712	COMMAND to use to the current Emacs instance as \"the editor\",
	713	assuming it respects ENVVAR as an \"EDITOR\"-like variable.
	714	CLIENT may be the path to an appropriate emacsclient executable
	715	with arguments, or a script which also works over Tramp.
	716
	717	Also see `async-shell-command' and `shell-command'."
	718	(interactive (with-editor-shell-command-read-args "Async shell command: " t))
	719	(let ((with-editor--envvar envvar))
	720	(with-editor
	721	(async-shell-command command output-buffer error-buffer))))
	722
	723	;;;###autoload
	724	(defun with-editor-shell-command
	725	(command &optional output-buffer error-buffer envvar)
	726	"Like `shell-command' or `with-editor-async-shell-command'.
	727	If COMMAND ends with \"&\" behave like the latter,
	728	else like the former."
	729	(interactive (with-editor-shell-command-read-args "Shell command: "))
	730	(if (string-match "&[ \t]*\\'" command)
	731	(with-editor-async-shell-command
	732	command output-buffer error-buffer envvar)
	733	(shell-command command output-buffer error-buffer)))
	734
	735	(defun with-editor-shell-command-read-args (prompt &optional async)
	736	(let ((command (read-shell-command
	737	prompt nil nil
	738	(let ((filename (or buffer-file-name
	739	(and (eq major-mode 'dired-mode)
	740	(dired-get-filename nil t)))))
	741	(and filename (file-relative-name filename))))))
	742	(list command
	743	(if (or async (setq async (string-match-p "&[ \t]*\\'" command)))
	744	(< (prefix-numeric-value current-prefix-arg) 0)
	745	current-prefix-arg)
	746	shell-command-default-error-buffer
	747	(and async current-prefix-arg (with-editor-read-envvar)))))
	748
	749	(defun shell-command--shell-command-with-editor-mode
	750	(fn command &optional output-buffer error-buffer)
	751	;; `shell-mode' and its hook are intended for buffers in which an
	752	;; interactive shell is running, but `shell-command' also turns on
	753	;; that mode, even though it only runs the shell to run a single
	754	;; command. The `with-editor-export-editor' hook function is only
	755	;; intended to be used in buffers in which an interactive shell is
	756	;; running, so it has to be remove here.
	757	(let ((shell-mode-hook (remove 'with-editor-export-editor shell-mode-hook)))
	758	(cond ((or (not (or with-editor--envvar shell-command-with-editor-mode))
	759	(not (string-match-p "&\\'" command)))
	760	(funcall fn command output-buffer error-buffer))
	761	((and with-editor-shell-command-use-emacsclient
	762	with-editor-emacsclient-executable
	763	(not (file-remote-p default-directory)))
	764	(with-editor (funcall fn command output-buffer error-buffer)))
	765	(t
	766	(apply fn (format "%s=%s %s"
	767	(or with-editor--envvar "EDITOR")
	768	(shell-quote-argument with-editor-sleeping-editor)
	769	command)
	770	output-buffer error-buffer)
	771	(ignore-errors
	772	(let ((process (get-buffer-process
	773	(or output-buffer
	774	(get-buffer "Async Shell Command")))))
	775	(set-process-filter
	776	process (lambda (proc str)
	777	(comint-output-filter proc str)
	778	(with-editor-process-filter proc str t)))
	779	process))))))
	780
	781	(advice-add 'shell-command :around
	782	'shell-command--shell-command-with-editor-mode)
	783
	784	;;; _
	785
	786	(defun with-editor-debug ()
	787	"Debug configuration issues.
	788	See info node `(with-editor)Debugging' for instructions."
	789	(interactive)
	790	(with-current-buffer (get-buffer-create "with-editor-debug")
	791	(pop-to-buffer (current-buffer))
	792	(erase-buffer)
	793	(ignore-errors (with-editor))
	794	(insert
	795	(format "with-editor: %s\n" (locate-library "with-editor.el"))
	796	(format "emacs: %s (%s)\n"
	797	(expand-file-name invocation-name invocation-directory)
	798	emacs-version)
	799	"system:\n"
	800	(format " system-type: %s\n" system-type)
	801	(format " system-configuration: %s\n" system-configuration)
	802	(format " system-configuration-options: %s\n" system-configuration-options)
	803	"server:\n"
	804	(format " server-running-p: %s\n" (server-running-p))
	805	(format " server-process: %S\n" server-process)
	806	(format " server-use-tcp: %s\n" server-use-tcp)
	807	(format " server-name: %s\n" server-name)
	808	(format " server-socket-dir: %s\n" server-socket-dir))
	809	(if (and server-socket-dir (file-accessible-directory-p server-socket-dir))
	810	(dolist (file (directory-files server-socket-dir nil "^[^.]"))
	811	(insert (format " %s\n" file)))
	812	(insert (format " %s: not an accessible directory\n"
	813	(if server-use-tcp "WARNING" "ERROR"))))
	814	(insert (format " server-auth-dir: %s\n" server-auth-dir))
	815	(if (file-accessible-directory-p server-auth-dir)
	816	(dolist (file (directory-files server-auth-dir nil "^[^.]"))
	817	(insert (format " %s\n" file)))
	818	(insert (format " %s: not an accessible directory\n"
	819	(if server-use-tcp "ERROR" "WARNING"))))
	820	(let ((val with-editor-emacsclient-executable)
	821	(def (default-value 'with-editor-emacsclient-executable))
	822	(fun (let ((warning-minimum-level :error)
	823	(warning-minimum-log-level :error))
	824	(with-editor-locate-emacsclient))))
	825	(insert "with-editor-emacsclient-executable:\n"
	826	(format " value: %s (%s)\n" val
	827	(and val (with-editor-emacsclient-version val)))
	828	(format " default: %s (%s)\n" def
	829	(and def (with-editor-emacsclient-version def)))
	830	(format " funcall: %s (%s)\n" fun
	831	(and fun (with-editor-emacsclient-version fun)))))
	832	(insert "path:\n"
	833	(format " $PATH: %S\n" (getenv "PATH"))
	834	(format " exec-path: %s\n" exec-path))
	835	(insert (format " with-editor-emacsclient-path:\n"))
	836	(dolist (dir (with-editor-emacsclient-path))
	837	(insert (format " %s (%s)\n" dir (car (file-attributes dir))))
	838	(when (file-directory-p dir)
	839	;; Don't match emacsclientw.exe, it makes popup windows.
	840	(dolist (exec (directory-files dir t "emacsclient\$?:[^w]\\\|\\'\$"))
	841	(insert (format " %s (%s)\n" exec
	842	(with-editor-emacsclient-version exec))))))))
	843
	844	(defconst with-editor-font-lock-keywords
	845	'(("(\$with-\\(?:git-\$?editor\\)\\_>" (1 'font-lock-keyword-face))))
	846	(font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords)
	847
	848	(provide 'with-editor)
	849	;; Local Variables:
	850	;; indent-tabs-mode: nil
	851	;; End:
	852	;;; with-editor.el ends here