[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Teaching emacsclient to act as a pager, and more
|
From: |
sbaugh |
|
Subject: |
Re: Teaching emacsclient to act as a pager, and more |
|
Date: |
Fri, 09 Sep 2016 10:14:33 -0400 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
Noam Postavsky <address@hidden> writes:
> I don't think you ever attached your patches, at least I don't see them.
I previously sent them as mail, here they are again as attachments (in
the order they should be applied):
>From c2ff58ce764801101fb4c37fd3963f99cb8652a2 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <address@hidden>
Date: Sun, 5 Jun 2016 00:40:28 -0400
Subject: [PATCH 1/5] process: add features for direct use of FDs
- A new keyword argument for make-network-process, :ancillary. When
non-nil, Emacs will check for ancillary data when reading from the
network process. If any is found, it is passed as an additional argument
to the process filter function. At the moment, this only supports
reading passed file descriptors out of ancillary data.
This is inherited by the children of server processes.
- A new Lisp function make-fd-process, which accepts keyword arguments
exactly like make-pipe-process, but also accepts :infd and :outfd, which
take Lisp integers which should be file descriptors that can be read
from and written to, respectively.
---
src/process.c | 215 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
src/process.h | 2 +
2 files changed, 212 insertions(+), 5 deletions(-)
diff --git a/src/process.c b/src/process.c
index 9ca3e594..dc96166 100644
--- a/src/process.c
+++ b/src/process.c
@@ -21,6 +21,7 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <sys/socket.h>
#include <stdio.h>
#include <errno.h>
#include <sys/types.h> /* Some typedefs are used in sys/file.h. */
@@ -2085,6 +2086,157 @@ create_pty (Lisp_Object process)
p->pid = -2;
}
+DEFUN ("make-fd-process", Fmake_fd_process, Smake_fd_process,
+ 0, MANY, 0,
+ doc: /* Create a process from passed file descriptors.
+
+:infd FD
+
+:outfd FD
+
+usage: (make-fd-process &rest ARGS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ Lisp_Object proc, contact;
+ struct Lisp_Process *p;
+ Lisp_Object name, buffer;
+ Lisp_Object tem;
+ int infd, outfd;
+ ptrdiff_t specpdl_count;
+ int inchannel, outchannel;
+
+ if (nargs == 0)
+ return Qnil;
+
+ contact = Flist (nargs, args);
+
+ infd = XINT (Fplist_get (contact, QCinfd));
+ outfd = XINT (Fplist_get (contact, QCoutfd));
+
+ name = Fplist_get (contact, QCname);
+ CHECK_STRING (name);
+ proc = make_process (name);
+ specpdl_count = SPECPDL_INDEX ();
+ record_unwind_protect (remove_process, proc);
+ p = XPROCESS (proc);
+
+ outchannel = outfd;
+ inchannel = infd;
+ p->open_fd[WRITE_TO_SUBPROCESS] = outfd;
+ p->open_fd[READ_FROM_SUBPROCESS] = infd;
+
+ fcntl (inchannel, F_SETFL, O_NONBLOCK);
+ fcntl (outchannel, F_SETFL, O_NONBLOCK);
+
+#ifdef WINDOWSNT
+ register_aux_fd (inchannel);
+#endif
+
+ /* Record this as an active process, with its channels. */
+ chan_process[inchannel] = proc;
+ p->infd = inchannel;
+ p->outfd = outchannel;
+
+ if (inchannel > max_process_desc)
+ max_process_desc = inchannel;
+
+ buffer = Fplist_get (contact, QCbuffer);
+ if (NILP (buffer))
+ buffer = name;
+ buffer = Fget_buffer_create (buffer);
+ pset_buffer (p, buffer);
+
+ pset_childp (p, contact);
+ pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
+ pset_type (p, Qpipe);
+ pset_sentinel (p, Fplist_get (contact, QCsentinel));
+ pset_filter (p, Fplist_get (contact, QCfilter));
+ pset_log (p, Qnil);
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ p->kill_without_query = 1;
+ if (tem = Fplist_get (contact, QCstop), !NILP (tem))
+ pset_command (p, Qt);
+ eassert (! p->pty_flag);
+
+ if (!EQ (p->command, Qt))
+ {
+ FD_SET (inchannel, &input_wait_mask);
+ FD_SET (inchannel, &non_keyboard_wait_mask);
+ }
+ p->adaptive_read_buffering
+ = (NILP (Vprocess_adaptive_read_buffering) ? 0
+ : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
+
+ /* Make the process marker point into the process buffer (if any). */
+ if (BUFFERP (buffer))
+ set_marker_both (p->mark, buffer,
+ BUF_ZV (XBUFFER (buffer)),
+ BUF_ZV_BYTE (XBUFFER (buffer)));
+
+ {
+ /* Setup coding systems for communicating with the network stream. */
+
+ /* Qt denotes we have not yet called Ffind_operation_coding_system. */
+ Lisp_Object coding_systems = Qt;
+ Lisp_Object val;
+
+ tem = Fplist_get (contact, QCcoding);
+ val = Qnil;
+ if (!NILP (tem))
+ {
+ val = tem;
+ if (CONSP (val))
+ val = XCAR (val);
+ }
+ else if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer),
enable_multibyte_characters)))
+ || (NILP (buffer) && NILP (BVAR (&buffer_defaults,
enable_multibyte_characters))))
+ /* We dare not decode end-of-line format by setting VAL to
+ Qraw_text, because the existing Emacs Lisp libraries
+ assume that they receive bare code including a sequence of
+ CR LF. */
+ val = Qnil;
+ else
+ {
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_decode_coding_system (p, val);
+
+ if (!NILP (tem))
+ {
+ val = tem;
+ if (CONSP (val))
+ val = XCDR (val);
+ }
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ val = Qnil;
+ else
+ {
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_encode_coding_system (p, val);
+ }
+ /* This may signal an error. */
+ setup_process_coding_systems (proc);
+
+ specpdl_ptr = specpdl + specpdl_count;
+
+ return proc;
+}
+
DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
0, MANY, 0,
doc: /* Create and return a bidirectional pipe process.
@@ -3919,6 +4071,7 @@ usage: (make-network-process &rest ARGS) */)
p->kill_without_query = 1;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
pset_command (p, Qt);
+ p->ancillary_data = !NILP (Fplist_get (contact, QCancillary_data));
p->pid = 0;
p->backlog = 5;
p->is_non_blocking_client = false;
@@ -4574,6 +4727,11 @@ server_accept_connection (Lisp_Object server, int
channel)
p = XPROCESS (proc);
+ /* TODO: I think this is supposed to be done by checking for a
+ property in contact, not by just copying the field from the
+ server process, but I'm not sure exactly what is correct */
+ p->ancillary_data = ps->ancillary_data;
+
/* Build new contact information for this setup. */
contact = Fcopy_sequence (ps->childp);
contact = Fplist_put (contact, QCserver, Qnil);
@@ -5587,6 +5745,7 @@ read_process_output_error_handler (Lisp_Object error_val)
static void
read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
ssize_t nbytes,
+ Lisp_Object *fds, size_t nfds,
struct coding_system *coding);
/* Read pending output from the process channel,
@@ -5611,6 +5770,9 @@ read_process_output (Lisp_Object proc, int channel)
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object odeactivate;
char chars[sizeof coding->carryover + readmax];
+ char cbuf[512] = {};
+ int nfds = 0;
+ int *fd_data = NULL;
if (carryover)
/* See the comment above. */
@@ -5639,8 +5801,34 @@ read_process_output (Lisp_Object proc, int channel)
readmax - buffered);
else
#endif
- nbytes = emacs_read (channel, chars + carryover + buffered,
- readmax - buffered);
+ {
+ struct stat statbuf;
+ fstat(channel, &statbuf);
+ if (S_ISSOCK(statbuf.st_mode) && p->ancillary_data) {
+ /* we declare cbuf outside of here since it is the backing
+ storage for the fd_data array */
+ struct iovec iov = { .iov_base = chars + carryover + buffered,
+ .iov_len = readmax - buffered, };
+ struct msghdr msgh = { .msg_iov = &iov,
+ .msg_iovlen = 1,
+ .msg_control = cbuf,
+ .msg_controllen = sizeof cbuf, };
+ nbytes = recvmsg(channel, &msgh, MSG_CMSG_CLOEXEC);
+ /* check for control messages */
+ for (struct cmsghdr *cmsg = CMSG_FIRSTHDR(&msgh); cmsg != NULL;
+ cmsg = CMSG_NXTHDR(&msgh, cmsg)) {
+ if (cmsg->cmsg_level == SOL_SOCKET
+ && cmsg->cmsg_type == SCM_RIGHTS) {
+ nfds = cmsg->cmsg_len / (sizeof(int));
+ fd_data = (int *) CMSG_DATA(cmsg);
+ }
+ }
+ } else {
+ nbytes = emacs_read (channel, chars + carryover + buffered,
+ readmax - buffered);
+ }
+ }
+
if (nbytes > 0 && p->adaptive_read_buffering)
{
int delay = p->read_output_delay;
@@ -5669,6 +5857,12 @@ read_process_output (Lisp_Object proc, int channel)
nbytes += buffered;
nbytes += buffered && nbytes <= 0;
}
+ /* if we saw any fds, put them in an array of Lisp_Objects; this is
+ a no-op if we saw no fds */
+ Lisp_Object fds[nfds];
+ for (int i = 0; i < nfds; i++) {
+ fds[i] = make_number(fd_data[i]);
+ }
p->decoding_carryover = 0;
@@ -5690,7 +5884,7 @@ read_process_output (Lisp_Object proc, int channel)
friends don't expect current-buffer to be changed from under them. */
record_unwind_current_buffer ();
- read_and_dispose_of_process_output (p, chars, nbytes, coding);
+ read_and_dispose_of_process_output (p, chars, nbytes, fds, nfds, coding);
/* Handling the process output should not deactivate the mark. */
Vdeactivate_mark = odeactivate;
@@ -5702,6 +5896,7 @@ read_process_output (Lisp_Object proc, int channel)
static void
read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
ssize_t nbytes,
+ Lisp_Object *fds, size_t nfds,
struct coding_system *coding)
{
Lisp_Object outstream = p->filter;
@@ -5775,14 +5970,20 @@ read_and_dispose_of_process_output (struct Lisp_Process
*p, char *chars,
coding->carryover_bytes);
p->decoding_carryover = coding->carryover_bytes;
}
- if (SBYTES (text) > 0)
+ if (SBYTES (text) > 0) {
/* FIXME: It's wrong to wrap or not based on debug-on-error, and
sometimes it's simply wrong to wrap (e.g. when called from
accept-process-output). */
+ Lisp_Object form;
+ if (p->ancillary_data)
+ form = list4 (outstream, make_lisp_proc (p), text, Flist(nfds, fds));
+ else
+ form = list3 (outstream, make_lisp_proc (p), text);
internal_condition_case_1 (read_process_output_call,
- list3 (outstream, make_lisp_proc (p), text),
+ form,
!NILP (Vdebug_on_error) ? Qnil : Qerror,
read_process_output_error_handler);
+ }
/* If we saved the match data nonrecursively, restore it now. */
restore_search_regs ();
@@ -7866,6 +8067,7 @@ syms_of_process (void)
DEFSYM (QCnowait, ":nowait");
DEFSYM (QCsentinel, ":sentinel");
DEFSYM (QCuse_external_socket, ":use-external-socket");
+ DEFSYM (QCancillary_data, ":ancillary-data");
DEFSYM (QCtls_parameters, ":tls-parameters");
DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
DEFSYM (QClog, ":log");
@@ -7877,6 +8079,8 @@ syms_of_process (void)
DEFSYM (QCstderr, ":stderr");
DEFSYM (Qpty, "pty");
DEFSYM (Qpipe, "pipe");
+ DEFSYM (QCinfd, ":infd");
+ DEFSYM (QCoutfd, ":outfd");
DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
@@ -7979,6 +8183,7 @@ The variable takes effect when `start-process' is called.
*/);
defsubr (&Sprocess_list);
defsubr (&Smake_process);
defsubr (&Smake_pipe_process);
+ defsubr (&Smake_fd_process);
defsubr (&Sserial_process_configure);
defsubr (&Smake_serial_process);
defsubr (&Sset_network_process_option);
diff --git a/src/process.h b/src/process.h
index a5f690d..72ba204 100644
--- a/src/process.h
+++ b/src/process.h
@@ -166,6 +166,8 @@ struct Lisp_Process
bool_bf is_non_blocking_client : 1;
/* Whether this is a server or a client socket. */
bool_bf is_server : 1;
+ /* Whether the filter should have ancillary data passed to it */
+ bool_bf ancillary_data : 1;
int raw_status;
/* The length of the socket backlog. */
int backlog;
--
2.9.3
>From 9c3ce51b19c0a6fb34fc597aa08e5140b6d6274e Mon Sep 17 00:00:00 2001
From: Spencer Baugh <address@hidden>
Date: Sun, 5 Jun 2016 00:40:11 -0400
Subject: [PATCH 2/5] server.el: accept FDs from emacsclient
The emacs server passes :ancillary t to make-network-process, and stores
any file descriptors it receives from a client.
---
lisp/server.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 55 insertions(+), 3 deletions(-)
diff --git a/lisp/server.el b/lisp/server.el
index e4cf431..894f8ac 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -352,6 +352,9 @@ server-delete-client
(when (and terminal (eq (terminal-live-p terminal) t))
(delete-terminal terminal))))
+ ;; Delete associated processes using this client's fds
+ (mapc #'delete-process (process-get proc :pipelines))
+
;; Delete the client's process.
(if (eq (process-status proc) 'open)
(delete-process proc))
@@ -670,6 +673,7 @@ server-start
:plist '(:authenticated nil))
(list :family 'local
:service server-file
+ :ancillary-data t
:plist '(:authenticated t)))))
(unless server-process (error "Could not start server process"))
(process-put server-process :server-file server-file)
@@ -915,7 +919,7 @@ server-execute-continuation
(process-put proc 'continuation nil)
(if continuation (ignore-errors (funcall continuation)))))
-(cl-defun server-process-filter (proc string)
+(cl-defun server-process-filter (proc string &optional ancillary)
"Process a request from the server to edit some files.
PROC is the server process. STRING consists of a sequence of
commands prefixed by a dash. Some commands have arguments;
@@ -1015,6 +1019,9 @@ server-execute-continuation
Suspend this terminal, i.e., stop the client process.
Sent when the user presses C-z."
(server-log (concat "Received " string) proc)
+ (when ancillary
+ (server-log (format "Received fds %s" ancillary) proc)
+ (process-put proc :fds ancillary))
;; First things first: let's check the authentication
(unless (process-get proc :authenticated)
(if (and (string-match "-auth \\([!-~]+\\)\n?" string)
@@ -1262,6 +1269,50 @@ server-execute-continuation
;; condition-case
(error (server-return-error proc err))))
+(defvar server-emacsclient-proc nil
+ "Non-nil if running commands for a client of our server.
+If we are currently evaluating Lisp in response to client commands,
+this variable contains the process for communicating with that
+client.")
+
+(defun server-pager-sentinel (proc event)
+ (internal-default-process-sentinel proc event)
+ (when (equal event "finished\n")
+ (let ((emacsclient (process-get proc :emacsclient)))
+ (setf (process-get emacsclient :pipelines)
+ (delq proc (process-get emacsclient :pipelines)))
+ (server-delete-client emacsclient))))
+
+(defun server-pager ()
+ "Start a process reading from FDs passed in by the current client.
+This function will start a process which will begin reading from the
+FDs passed in by the current client and copying their input to a
+*pager* buffer.
+
+This function should only be run by passing --eval to an emacsclient
+that also has the -l or --pipeline option, like so:
+ echo some data | emacsclient -l --eval '(server-pager)'"
+ ;; we remove two fds from the emacsclient process, and add ourselves
+ ;; in for later deletion when the emacsclient quits
+ (if (null server-emacsclient-proc)
+ (error "Cannot be run out of emacsclient --eval context")
+ (let ((buf (get-buffer "*pager*")))
+ (when buf (kill-buffer buf)))
+ (let* ((infd (pop (process-get server-emacsclient-proc :fds)))
+ (outfd (pop (process-get server-emacsclient-proc :fds)))
+ (buffer (generate-new-buffer "*pager*"))
+ (proc (make-fd-process :name "pager-proc"
+ :buffer buffer
+ :noquery t
+ :sentinel #'server-pager-sentinel
+ :infd infd
+ :outfd outfd
+ :plist (list :emacsclient
server-emacsclient-proc))))
+ (push proc (process-get server-emacsclient-proc :pipelines))
+ (pop-to-buffer buffer)
+ proc)))
+
+
(defun server-execute (proc files nowait commands dontkill frame tty-name)
;; This is run from timers and process-filters, i.e. "asynchronously".
;; But w.r.t the user, this is not really asynchronous since the timer
@@ -1272,7 +1323,8 @@ server-execute
;; including code that needs to wait.
(with-local-quit
(condition-case err
- (let ((buffers (server-visit-files files proc nowait)))
+ (let ((buffers (server-visit-files files proc nowait))
+ (server-emacsclient-proc proc))
(mapc 'funcall (nreverse commands))
;; If we were told only to open a new client, obey
@@ -1294,7 +1346,7 @@ server-execute
;; Client requested nowait; return immediately.
(server-log "Close nowait client" proc)
(server-delete-client proc))
- ((and (not dontkill) (null buffers))
+ ((and (not dontkill) (null buffers) (null (process-get proc
:pipelines)))
;; This client is empty; get rid of it immediately.
(server-log "Close empty client" proc)
(server-delete-client proc)))
--
2.9.3
>From 4c2b02dabd72920c28008f73ca305d0bfe4f32c9 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <address@hidden>
Date: Sun, 5 Jun 2016 00:40:00 -0400
Subject: [PATCH 3/5] emacsclient: support passing stdin/out/err to emacs
To make this more useful, the terminal name is now also determined by
looking at stderr, not stdout. If stderr is redirected, we'll still have
trouble, though...
---
lib-src/emacsclient.c | 45 ++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 42 insertions(+), 3 deletions(-)
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index aab9c4b..1b1f75a 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -76,6 +76,7 @@ char *w32_getenv (const char *);
#include <stdio.h>
#include <getopt.h>
#include <unistd.h>
+#include <fcntl.h>
#include <pwd.h>
#include <sys/stat.h>
@@ -119,6 +120,12 @@ int quiet = 0;
/* Nonzero means args are expressions to be evaluated. --eval. */
int eval = 0;
+/* Nonzero means we will pass stdin/stdout/stderr to Emacs. --pipeline. */
+int pipeline = 0;
+
+/* Nonzero means pass stdin/stdout/stderr to Emacs on next write. */
+int send_fds_once = 0;
+
/* Nonzero means don't open a new frame. Inverse of --create-frame. */
int current_frame = 1;
@@ -163,6 +170,7 @@ struct option longopts[] =
{ "version", no_argument, NULL, 'V' },
{ "tty", no_argument, NULL, 't' },
{ "nw", no_argument, NULL, 't' },
+ { "pipeline", no_argument, NULL, 'l' },
{ "create-frame", no_argument, NULL, 'c' },
{ "alternate-editor", required_argument, NULL, 'a' },
{ "frame-parameters", required_argument, NULL, 'F' },
@@ -468,7 +476,7 @@ decode_options (int argc, char **argv)
{
int opt = getopt_long_only (argc, argv,
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
- "VHneqa:s:f:d:F:tc",
+ "VHneqla:s:f:d:F:tc",
#else
"VHneqa:f:d:F:tc",
#endif
@@ -492,6 +500,11 @@ decode_options (int argc, char **argv)
case 's':
socket_name = optarg;
break;
+
+ case 'l':
+ pipeline = 1;
+ send_fds_once = 1;
+ break;
#endif
case 'f':
@@ -738,7 +751,33 @@ send_to_emacs (HSOCKET s, const char *data)
if (sblen == SEND_BUFFER_SIZE
|| (sblen > 0 && send_buffer[sblen-1] == '\n'))
{
- int sent = send (s, send_buffer, sblen, 0);
+ int sent;
+ if (send_fds_once) {
+ struct iovec iov;
+ struct msghdr msgh;
+ char cbuf[512] = {};
+ iov = (struct iovec) { .iov_base = send_buffer,
+ .iov_len = sblen, };
+ msgh = (struct msghdr) { .msg_iov = &iov,
+ .msg_iovlen = 1,
+ .msg_control = cbuf,
+ .msg_controllen = sizeof cbuf, };
+ struct cmsghdr *cmsg;
+ int myfds[3] = { 0, 1, 2 };
+ cmsg = CMSG_FIRSTHDR(&msgh);
+ cmsg->cmsg_level = SOL_SOCKET;
+ cmsg->cmsg_type = SCM_RIGHTS;
+ cmsg->cmsg_len = CMSG_LEN(sizeof (myfds));
+ /* Initialize the payload: */
+ memcpy(CMSG_DATA(cmsg), myfds, sizeof (myfds));
+ /* Sum of the length of all control messages in the buffer: */
+ msgh.msg_controllen = cmsg->cmsg_len;
+
+ sent = sendmsg (s, &msgh, 0);
+ send_fds_once = 0;
+ } else {
+ sent = send (s, send_buffer, sblen, 0);
+ }
if (sent < 0)
{
message (true, "%s: failed to send %d bytes to socket: %s\n",
@@ -1019,7 +1058,7 @@ static int
find_tty (const char **tty_type, const char **tty_name, int noabort)
{
const char *type = egetenv ("TERM");
- const char *name = ttyname (fileno (stdout));
+ const char *name = ttyname (fileno (stderr));
if (!name)
{
--
2.9.3
>From ce21d4c9e0585adbec28020e25a227bbcba7a59f Mon Sep 17 00:00:00 2001
From: Spencer Baugh <address@hidden>
Date: Sun, 5 Jun 2016 16:35:18 -0400
Subject: [PATCH 4/5] server: add pager tapping and show-active
Add some extra features:
- The tap argument to server-pager; if non-nil, any input received is
sent right back out. This allows inserting emacsclient pagers in the
middle of a pipeline.
- server-pager-show-active will display the buffers of all active
emacsclients.
---
lisp/server.el | 90 +++++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 67 insertions(+), 23 deletions(-)
diff --git a/lisp/server.el b/lisp/server.el
index 894f8ac..446b475 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1275,42 +1275,86 @@ server-emacsclient-proc
this variable contains the process for communicating with that
client.")
+(defvar server-pager-active-list nil
+ "List of all active pager processes in order of creation.")
+
+;; TODO make a function that is basically "server-delete-client-maybe"
+;; which will delete the client iff there are no more resources
+;; (buffers, frames, pipelines) associated with it
(defun server-pager-sentinel (proc event)
(internal-default-process-sentinel proc event)
- (when (equal event "finished\n")
- (let ((emacsclient (process-get proc :emacsclient)))
- (setf (process-get emacsclient :pipelines)
- (delq proc (process-get emacsclient :pipelines)))
+ (let ((emacsclient (process-get proc :emacsclient)))
+ (setf (process-get emacsclient :pipelines)
+ (delq proc (process-get emacsclient :pipelines)))
+ (setf server-pager-active-list
+ (delq proc server-pager-active-list))
+ (when (= 0 (let ((frame-num 0))
+ (dolist (f (frame-list))
+ (when (eq emacsclient (frame-parameter f 'client))
+ (setq frame-num (1+ frame-num))))
+ frame-num))
(server-delete-client emacsclient))))
-(defun server-pager ()
+(defun server-pager-tap-filter (proc text)
+ (internal-default-process-filter proc text)
+ (process-send-string proc text))
+
+(defun server-pager (&optional name tap)
"Start a process reading from FDs passed in by the current client.
This function will start a process which will begin reading from the
FDs passed in by the current client and copying their input to a
-*pager* buffer.
+buffer.
+
+NAME is the name of the buffer to copy input to; if nil, *pager* is
+used. If NAME is an empty string, that is treated as equivalent to
+nil, for ease of use from the command line.
+
+If TAP is non-nil, all input to the stdin of the client will be copied
+also to the stdout of the client, allowing a client invoking
+server-pager to be inserted in the middle of a pipeline.
This function should only be run by passing --eval to an emacsclient
that also has the -l or --pipeline option, like so:
echo some data | emacsclient -l --eval '(server-pager)'"
;; we remove two fds from the emacsclient process, and add ourselves
;; in for later deletion when the emacsclient quits
- (if (null server-emacsclient-proc)
- (error "Cannot be run out of emacsclient --eval context")
- (let ((buf (get-buffer "*pager*")))
- (when buf (kill-buffer buf)))
- (let* ((infd (pop (process-get server-emacsclient-proc :fds)))
- (outfd (pop (process-get server-emacsclient-proc :fds)))
- (buffer (generate-new-buffer "*pager*"))
- (proc (make-fd-process :name "pager-proc"
- :buffer buffer
- :noquery t
- :sentinel #'server-pager-sentinel
- :infd infd
- :outfd outfd
- :plist (list :emacsclient
server-emacsclient-proc))))
- (push proc (process-get server-emacsclient-proc :pipelines))
- (pop-to-buffer buffer)
- proc)))
+ (when (equal "" name) (setq name nil))
+ (with-current-buffer (or (and name (get-buffer-create name))
+ (generate-new-buffer "*pager*"))
+ (if (null server-emacsclient-proc)
+ (error "Cannot be run out of emacsclient --eval context")
+ (let* ((infd (pop (process-get server-emacsclient-proc :fds)))
+ (outfd (pop (process-get server-emacsclient-proc :fds)))
+ (proc (make-fd-process :name (if name (concat name "-proc")
"pager-proc")
+ :buffer (current-buffer)
+ :noquery t
+ :sentinel #'server-pager-sentinel
+ :filter (if tap #'server-pager-tap-filter
+
#'internal-default-process-filter)
+ :infd infd
+ :outfd outfd
+ :plist (list :emacsclient
server-emacsclient-proc))))
+ (push proc (process-get server-emacsclient-proc :pipelines))
+ (add-to-list 'server-pager-active-list proc 'append)
+ (pop-to-buffer (current-buffer) '(display-buffer-same-window . nil))
+ proc))))
+
+(defun server-pager-show-active (&optional _ frame)
+ "Displays all active pagers in windows on the current frame."
+ (interactive)
+ (delete-other-windows)
+ (let ((buffers (mapcar #'process-buffer server-pager-active-list))
+ (window (frame-selected-window frame))
+ (windows (list (selected-window))))
+ (dotimes (_ (- (length buffers) 1))
+ (setq window (split-window window nil 'right))
+ (message "window: %s, windows: %s" window windows)
+ (push window windows)
+ (balance-windows))
+ (setq windows (nreverse windows))
+ (message "%s %s" windows buffers)
+ (cl-mapcar #'set-window-buffer windows buffers)
+ (redisplay)))
(defun server-execute (proc files nowait commands dontkill frame tty-name)
--
2.9.3
>From ac7b10cedf8f41dc94f2cfc8d213da06edaa8836 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <address@hidden>
Date: Mon, 6 Jun 2016 14:21:37 -0400
Subject: [PATCH 5/5] emacsclient: add extra-quiet mode
For emacsclient to write any output at all while acting as a pipeline
can be very disruptive. As a quick hack, passing -qq or -l will now
silence absolutely all output from emacsclient.
Eventually we should probably just write to /dev/tty instead of to
stdout, since POSIX 10.1 says about /dev/tty:
It is useful for programs or shell procedures that wish to be sure of
writing messages to or reading data from the terminal no matter how
output has been redirected.
---
lib-src/emacsclient.c | 14 +++++++++++---
1 file changed, 11 insertions(+), 3 deletions(-)
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 1b1f75a..e1f35cb 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -436,6 +436,7 @@ static void message (bool, const char *, ...)
ATTRIBUTE_FORMAT_PRINTF (2, 3);
static void
message (bool is_error, const char *format, ...)
{
+ if (quiet > 1) return;
va_list args;
va_start (args, format);
@@ -503,6 +504,7 @@ decode_options (int argc, char **argv)
case 'l':
pipeline = 1;
+ quiet = 2;
send_fds_once = 1;
break;
#endif
@@ -528,7 +530,7 @@ decode_options (int argc, char **argv)
break;
case 'q':
- quiet = 1;
+ quiet++;
break;
case 'V':
@@ -643,6 +645,7 @@ The following OPTIONS are accepted:\n\
-e, --eval Evaluate the FILE arguments as ELisp expressions\n\
-n, --no-wait Don't wait for the server to return\n\
-q, --quiet Don't display messages on success\n\
+ Pass twice to suppress absolutely all output\n\
-d DISPLAY, --display=DISPLAY\n\
Visit the file in the given display\n\
", "\
@@ -1542,7 +1545,8 @@ start_daemon_and_retry_set_socket (void)
}
else if (dpid < 0)
{
- fprintf (stderr, "Error: Cannot fork!\n");
+ if (quiet <= 1)
+ fprintf (stderr, "Error: Cannot fork!\n");
exit (EXIT_FAILURE);
}
else
@@ -1899,6 +1903,7 @@ main (int argc, char **argv)
}
else if (strprefix ("-print ", p))
{
+ if (quiet > 1) continue;
/* -print STRING: Print STRING on the terminal. */
str = unquote_argument (p + strlen ("-print "));
if (needlf)
@@ -1908,6 +1913,7 @@ main (int argc, char **argv)
}
else if (strprefix ("-print-nonl ", p))
{
+ if (quiet > 1) continue;
/* -print-nonl STRING: Print STRING on the terminal.
Used to continue a preceding -print command. */
str = unquote_argument (p + strlen ("-print-nonl "));
@@ -1916,6 +1922,7 @@ main (int argc, char **argv)
}
else if (strprefix ("-error ", p))
{
+ if (quiet > 1) continue;
/* -error DESCRIPTION: Signal an error on the terminal. */
str = unquote_argument (p + strlen ("-error "));
if (needlf)
@@ -1947,7 +1954,8 @@ main (int argc, char **argv)
if (needlf)
printf ("\n");
- fflush (stdout);
+ if (quiet <= 1)
+ fflush (stdout);
while (fdatasync (1) != 0 && errno == EINTR)
continue;
--
2.9.3
- Re: Teaching emacsclient to act as a pager, and more, sbaugh, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more, Noam Postavsky, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more,
sbaugh <=
- Re: Teaching emacsclient to act as a pager, and more, Stefan Monnier, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more, sbaugh, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more, Stefan Monnier, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more, Eli Zaretskii, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more, sbaugh, 2016/09/09
- Re: Using file descriptors in Emacs (was: Teaching emacsclient to act as a pager, and more), Eli Zaretskii, 2016/09/10
- Re: Teaching emacsclient to act as a pager, and more, sbaugh, 2016/09/10
- Re: Teaching emacsclient to act as a pager, and more, Leo Liu, 2016/09/10
- Re: Teaching emacsclient to act as a pager, and more, Eli Zaretskii, 2016/09/09
- Re: Teaching emacsclient to act as a pager, and more, sbaugh, 2016/09/09