From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Spencer Baugh Newsgroups: gmane.emacs.devel Subject: [PATCH 4/5] server: add pager tapping and show-active Date: Mon, 6 Jun 2016 21:25:05 -0400 Message-ID: <1465262706-5229-5-git-send-email-sbaugh@catern.com> References: <1465262706-5229-1-git-send-email-sbaugh@catern.com> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1465262946 14767 80.91.229.3 (7 Jun 2016 01:29:06 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 7 Jun 2016 01:29:06 +0000 (UTC) Cc: Spencer Baugh To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Jun 07 03:29:06 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1bA5pJ-0004wL-7W for ged-emacs-devel@m.gmane.org; Tue, 07 Jun 2016 03:29:05 +0200 Original-Received: from localhost ([::1]:46348 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bA5pI-0007SH-Fm for ged-emacs-devel@m.gmane.org; Mon, 06 Jun 2016 21:29:04 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51498) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bA5m4-0005ZX-4N for emacs-devel@gnu.org; Mon, 06 Jun 2016 21:25:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1bA5m1-00024F-Ql for emacs-devel@gnu.org; Mon, 06 Jun 2016 21:25:43 -0400 Original-Received: from catern.com ([104.131.201.120]:38415 helo=mail.catern.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1bA5m1-00022u-Hi for emacs-devel@gnu.org; Mon, 06 Jun 2016 21:25:41 -0400 Original-Received: from [127.0.0.1] (localhost [127.0.0.1]) (using TLSv1.2 with cipher ECDHE-RSA-AES128-GCM-SHA256 (128/128 bits)) (No client certificate requested) by mail.catern.com (Postfix) with ESMTPSA id C1ED44F578; Tue, 7 Jun 2016 01:25:33 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=catern.com; s=default; t=1465262733; bh=p4v1Tu7XMKO7a4ViIcJfGlGS0gM2Y/DNy4ktCh1yhX8=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=oPb+hkDciCYDQExzFwY0P6hacV5fqUxL48FgqXevZOuistMsP/XHJgj9Xrwp2+TEe Z79qtQt5DGiB9EsGAzk/MB14VX4IZuw5nYE+Bk3g6dEeStyfnBgk1rzkRZJFmkcMsG z06W3p4VR9UeRm2v/VMZVqP5SmXq1uNuW1Ukcx+w= In-Reply-To: <1465262706-5229-1-git-send-email-sbaugh@catern.com> X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [generic] X-Received-From: 104.131.201.120 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:204220 Archived-At: 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.8.2