├── README.creole ├── pipe-tests.el └── pipe.el /README.creole: -------------------------------------------------------------------------------- 1 | = Pipes = 2 | 3 | Unix pipes are a powerful tool. In Emacs we don't have much support 4 | for them so this package aims to add such support. 5 | 6 | == API == 7 | 8 | The Pipe API consists of a few functions and macros to spawn 9 | processes and communicate with them in the Pipe style. 10 | 11 | === pipe === 12 | 13 | A macro allowing piping to be represented simply: 14 | 15 | {{{ 16 | (pipe "ls -la" 17 | (catch :eof 18 | (with-current-buffer somebuf 19 | (-each 20 | (->> (pipe-read) 21 | (-keep (lambda (a) a))) 22 | (lambda (x) (print x))) 23 | }}} 24 | 25 | {{{pipe}}} takes a command as a string and a body of code which is 26 | executed with {{{(pipe-read)}}} providing a line from the command. 27 | 28 | === pipe-eof proc === 29 | 30 | Has //proc// been marked EOF? 31 | 32 | 33 | === pipe-shell-command command thunk &optional name === 34 | 35 | Pipe the shell //command// to the //thunk// function. 36 | 37 | Within //thunk// the function {{{pipe-read}}} is bound to deliver 38 | whatever came over the pipe. 39 | 40 | -------------------------------------------------------------------------------- /pipe-tests.el: -------------------------------------------------------------------------------- 1 | ;;; pipe-tests.el -- tests for pipe stuff 2 | 3 | (require 'pipe) 4 | 5 | (ert-deftest pipe/thunk-bind () 6 | (should 7 | (let ((lines '("line1" "line2" "line3")) 8 | collect) 9 | (-each 10 | lines (pipe/thunk-bind 11 | (lambda () 12 | (-each (thuncall) 13 | (lambda (item) 14 | (push item collect)))))) 15 | (equal collect (reverse lines))))) 16 | 17 | (ert-deftest pipe/buffer-lines () 18 | (should 19 | (with-temp-buffer 20 | (insert "a full line\r 21 | another full line\r 22 | a part of a line") 23 | (equal 24 | (list 25 | (pipe/buffer-lines (current-buffer) :line-ending "\r\n" :delete t) 26 | (buffer-string) 27 | (progn 28 | (insert " that's filled in\r\n") 29 | (pipe/buffer-lines (current-buffer) :line-ending "\r\n" :delete t)) 30 | (pipe/buffer-lines (current-buffer) :line-ending "\r\n" :delete t)) 31 | (list '("a full line" "another full line") 32 | "a part of a line" 33 | '("a part of a line that's filled in") 34 | nil))))) 35 | 36 | ;;; pipe-tests.el ends here 37 | -------------------------------------------------------------------------------- /pipe.el: -------------------------------------------------------------------------------- 1 | ;;; pipe.el --- pipes with emacslisp --- -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2014 Nic Ferrier 4 | 5 | ;; Author: Nic Ferrier 6 | ;; Keywords: processes, comm 7 | ;; Version: 0.0.1 8 | ;; Url: https://github.com/nicferrier/emacs-pipe 9 | ;; Package-requires: ((noflet "0.0.11")) 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | 26 | ;; Pipe functions to help you have processes communicate with 27 | ;; EmacsLisp more easily. 28 | 29 | ;;; Code: 30 | 31 | (require 'noflet) 32 | 33 | (defun pipe/thunk-bind (thunk &optional sym) 34 | "Return a function (&rest args) which calls THUNK. 35 | 36 | When THUNK executes a function SYM (or `thuncall') is bound which 37 | returns `args'. 38 | 39 | Eg: 40 | 41 | (funcall 42 | (pipe/thunk-bind (lambda () 43 | (apply 'print (thuncall)))) 44 | \"one two three\") 45 | 46 | prints the string \"one two three\"." 47 | (let* ((fnsym (or sym 'thuncall)) 48 | (old-func (condition-case err 49 | (symbol-function fnsym) 50 | (void-function nil)))) 51 | (lambda (&rest args) 52 | (unwind-protect ; we have to make our own flet 53 | (progn 54 | (fset fnsym (lambda (&rest any) args)) 55 | (funcall thunk)) 56 | (if old-func 57 | (fset fnsym old-func) 58 | (fmakunbound fnsym)))))) 59 | 60 | (defun* pipe/buffer-lines (buffer &key (line-ending "\n") (delete t)) 61 | "Return a list of lines from BUFFER or `nil' if there are none. 62 | 63 | `:line-ending' may be specified but it \"\n\" by default. 64 | 65 | If `:delete' is specified then the region defining the lines is 66 | deleted. `:delete' defaults to `t'" 67 | (catch :escape 68 | (with-current-buffer buffer 69 | (let* ((last (save-excursion 70 | (save-match-data 71 | (goto-char (point-max)) 72 | (+ (length line-ending) 73 | (or 74 | (re-search-backward line-ending nil t) 75 | (throw :escape nil))))))) 76 | (split-string 77 | (prog1 78 | (buffer-substring (point-min) last) 79 | (when delete (delete-region (point-min) last))) 80 | line-ending t))))) 81 | 82 | (defun pipe-shell-command (command thunk &optional name) 83 | "Pipe the shell COMMAND to the THUNK function. 84 | 85 | Within THUNK the function `pipe-read' can be called to return the 86 | next value from the pipe." 87 | (let* ((prcname (or name (format "*%s*" "proc-receive"))) ; FIXME -uniqufy 88 | (proc (start-process-shell-command prcname (concat " " prcname) command)) 89 | eof) 90 | (nolexflet ((thunk-bind (proc) ; bind the proc to the thunk to allow eof handling 91 | (pipe/thunk-bind 92 | (lambda () 93 | (noflet ((pipe-read () 94 | (if (not eof) 95 | (funcall this-fn) 96 | ;; Else it's eof - mark the process and throw 97 | (process-put proc :eof :eof) 98 | (throw :eof :eof)))) 99 | (funcall thunk))) 100 | 'pipe-read))) 101 | (set-process-filter 102 | proc (lambda (fproc data) 103 | (with-current-buffer (process-buffer fproc) 104 | (save-excursion 105 | (goto-char (point-max)) 106 | (insert data))) 107 | (let ((lines (pipe/buffer-lines (process-buffer fproc)))) 108 | (when lines (-each lines (thunk-bind fproc)))))) 109 | (set-process-sentinel 110 | proc (lambda (sproc status) 111 | (case (intern (car (split-string status))) 112 | ((exited finished) 113 | (setq eof t) 114 | (funcall (thunk-bind sproc)))))) 115 | proc))) 116 | 117 | (defun pipe-eof (proc) 118 | "Has PROC been marked EOF?" 119 | (eq :eof (process-get proc :eof))) 120 | 121 | (defvar pipe-eof-wait-time 0.1 122 | "The time that `wait-for-pipe-eof' delays while waiting.") 123 | 124 | (defmacro* wait-for-pipe-eof (proc &rest body) 125 | "Wait for EOF on the PROC and then execute BODY." 126 | (declare (indent 1)) 127 | (let ((procv (make-symbol "procv"))) 128 | `(let ((,procv ,proc)) 129 | (while (not (pipe-eof ,procv)) (sleep-for pipe-eof-wait-time)) 130 | (progn ,@body)))) 131 | 132 | (defmacro pipe (command &rest body) 133 | "Pipe COMMAND through BODY. 134 | 135 | Inside BODY the function `pipe-read' takes a function argument 136 | which will be called with a data from COMMAND or `:eof' will be 137 | thrown." 138 | (declare (indent 1)) 139 | (let ((cmdvar (make-symbol "cmdvar"))) 140 | `(let ((,cmdvar ,command)) 141 | (if (stringp ,cmdvar) 142 | (pipe-shell-command ,cmdvar (lambda () ,@body)))))) 143 | 144 | (defun pipe-demo () 145 | "Demonstrate the `pipe' macro." 146 | (let* (lst) 147 | (wait-for-pipe-eof 148 | (pipe "ls -la ~/" 149 | (catch :eof 150 | (push (car (pipe-read)) lst))) 151 | lst))) 152 | 153 | (defun pipe-imaginary-demo () 154 | ;; This WILL NOT WORK YET 155 | (pipe 156 | (progn 157 | (maildir/imap-check-connect) 158 | (let ((maildir/imap-log (get-buffer-create "*maildir-imap-log*")) 159 | (maildir/imap-message-doit doit)) 160 | ;; pipe-send would automatically send back to this pipe 161 | (pipe-send (mapcar 'maildir/imap-message (maildir/imap-search))))) 162 | (catch :eof 163 | (apply 'maildir/update (pipe-read))))) 164 | 165 | 166 | 167 | (provide 'pipe) 168 | 169 | ;;; pipe.el ends here 170 | --------------------------------------------------------------------------------