├── README.creole └── mp.el /README.creole: -------------------------------------------------------------------------------- 1 | = MP - multiprocessing with daemons = 2 | 3 | Emacs can't fork and it doesn't have threads (though threads are 4 | coming). 5 | 6 | Various attempts have been made to add concurrency to Emacs but this 7 | is mine. 8 | 9 | It uses let's you create daemons from Emacs with a single call. 10 | 11 | The daemon may then have Lisp forms sent to it, the Lisp forms are 12 | executed asynchronously. This is in contrast to Emacs' builtin 13 | {{{server-eval-at}}}, which is synchronous. 14 | 15 | The asynchrony is achieved through callbacks, though there's also a 16 | lexical macro interface: 17 | 18 | {{{ 19 | (with-mp channel 20 | (mp> channel remote 21 | (progn (sleep-for 2) (* 10 15)) 22 | (message "hurrah! %s" (remote))) 23 | (sleep-for 10)) 24 | }}} 25 | 26 | I'm currently working on a better synchronization solution than 27 | {{{sleep-for}}}. 28 | 29 | 30 | The protocol used is Emacs' client protocol, so no special 31 | bootstrapping is needed to bring the daemon up to a point where it 32 | will serve. 33 | 34 | === Todo === 35 | 36 | //Add bootstrapping// - particularly I would like to be able to create a 37 | daemon that has the same packages as my existing Emacs instance. This 38 | seems doable like this: 39 | 40 | * boot the new daemon 41 | * symlink all packages from the existing ELPA to the new daemon 42 | * send package-initialize to the new daemon 43 | 44 | it //might// be necessary to create the ELPA directory before booting 45 | the daemon so that the initialization works first time when the daemon 46 | boots. 47 | 48 | -------------------------------------------------------------------------------- /mp.el: -------------------------------------------------------------------------------- 1 | ;;; mp.el --- multiprocess emacs -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2013 Nic Ferrier 4 | 5 | ;; Author: Nic Ferrier 6 | ;; Keywords: lisp 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This is code to help you start anonymous daemon processes and talk 24 | ;; to them asynchronously. 25 | 26 | ;; Right now we are only capable of using UNIX daemon sockets (as used 27 | ;; by the emacsclient protocol) to start the server. In the future it 28 | ;; may be possible to use TCP/IP sockets. 29 | 30 | ;;; Code: 31 | 32 | (require 'server) ;; for sending data to the daemon 33 | (require 'noflet) 34 | 35 | (defun mp/parse-response (mp receiver proc data) 36 | (funcall mp :debug "mp/send %s < [%s]" data proc) 37 | (if (string-match "[\n]*\\(-[a-z]+\\) \\(.*\\)" data) 38 | (case (intern (concat ":" (match-string 1 data))) 39 | (:-emacs-pid t) ; no need to do anything - just an ack 40 | (:-print 41 | (let ((response 42 | (read 43 | (decode-coding-string 44 | (server-unquote-arg (match-string 2 data)) 45 | 'emacs-internal)))) 46 | (funcall mp :debug "mp/send response %s" response) 47 | (if (eq :success (car response)) 48 | (funcall receiver (cadr response) nil) 49 | ;; Else it's a failure 50 | (funcall receiver nil (car response)))))))) 51 | 52 | (defun mp/send (mp form receiver) 53 | "Async send FORM to daemon MP. 54 | 55 | When the call completes call RECEIVER with the result. RECEIVER 56 | should take two arguments, RESULT and ERROR. `nil' is passed for 57 | the argument that is not relevant." 58 | ;; More error handling here? FIXME - We need an error PROCESS DIED 59 | (let ((proc 60 | (make-network-process 61 | :name "mp/sender" 62 | :family 'local 63 | :service 0 64 | :remote (funcall mp :getsocket) 65 | :filter 66 | (lambda (proc data) 67 | (mp/parse-response mp receiver proc data)))) 68 | (to-send 69 | (format 70 | "-eval %s\n" 71 | (server-quote-arg 72 | (format "%S" `(condition-case err 73 | (list :success ,form) 74 | (error err))))))) 75 | (when proc 76 | (funcall mp :debug "mp/send sending [%s] to {%s}" to-send proc) 77 | (process-send-string proc to-send)))) 78 | 79 | (defun mp/start-daemon () 80 | "Start an Emacs server process." 81 | (let* ((unique (make-temp-name "mp-emacsd")) 82 | (emacs-dir (concat "/tmp/" unique)) 83 | (emacs-bin (concat invocation-directory invocation-name)) 84 | (args (list (concat "--daemon=" unique))) 85 | (saved-home (getenv "HOME"))) 86 | (unwind-protect 87 | (progn 88 | (setenv "HOME" emacs-dir) 89 | (make-directory emacs-dir t) 90 | (let ((this-proc 91 | (apply 'start-process 92 | unique (format "*%s*" unique) 93 | emacs-bin args)) 94 | (state :starting) 95 | (debug t) 96 | this-func) 97 | (set-process-sentinel 98 | this-proc (lambda (process state) 99 | (cond 100 | ((equal state "finished\n") 101 | (setq state :live)) 102 | (t 103 | (message "daemon state %s" state))))) 104 | (setq this-func 105 | (lambda (msg &rest other) 106 | (case msg 107 | (:getdir emacs-dir) 108 | (:getdebug debug) 109 | (:debug 110 | (when debug 111 | (message 112 | (replace-regexp-in-string 113 | "\n" "\\\\n" 114 | (apply 'format other))))) 115 | (:getsocket 116 | (format "/tmp/emacs%d/%s" 117 | (user-uid) unique)) 118 | (:kill (mp/send 119 | this-func 120 | '(kill-emacs) 121 | (lambda (data error) 122 | (list data error)))) 123 | (:send 124 | (destructuring-bind (form receiver) other 125 | (mp/send this-func form receiver)))))))) 126 | (setenv "HOME" saved-home)))) 127 | 128 | 129 | (progn 130 | ;; Sets up the mp remote error signal 131 | (put :mp-remote-error 132 | 'error-conditions 133 | '(error :mp :mp-remote-error :remote-error)) 134 | (put :mp-remote-error 135 | 'error-message 136 | "a remote error occurred")) 137 | 138 | (defmacro mp> (channel result-procname bodyform &rest nextform) 139 | "Execute BODYFORM on CHANNEL's process then execute NEXTFORM. 140 | 141 | The BODYFORM is executed in another Emacs process. When it 142 | completes NEXTFORM is executed. Within NEXTFORM a call to 143 | RESULT-PROCNAME will return either the data resulting from 144 | BODYFORM or raise a `:mp-remote-error'. In this way NEXTFORM can 145 | capture errors raised from the remote naturally. 146 | 147 | NEXTFORM is wrapped in an implicit `condition-case' to respond to 148 | `:mp-remote-error' whenever it is thrown, so a handler can defer to 149 | the default handling of `:mp-remote-error'." 150 | (declare 151 | (debug (sexp sexp form &rest form)) 152 | (indent 3)) 153 | (let ((datav (make-symbol "data")) 154 | (errv (make-symbol "err")) 155 | (default-errv (make-symbol "defaulterrv"))) 156 | `(funcall 157 | channel :send (quote ,bodyform) 158 | (lambda (,datav ,errv) 159 | (condition-case ,default-errv 160 | (nolexflet ((,result-procname () 161 | (if ,errv 162 | (signal :mp-remote-error (list ,errv)) 163 | ,datav))) 164 | ,@nextform) 165 | (:mp-remote-error 166 | (funcall 167 | channel :debug 168 | "there was a remote error %s" ,default-errv))))))) 169 | 170 | (defmacro with-mp (var &rest form) 171 | "Bind VAR a handle to another process and then eval FORM. 172 | 173 | When FORM completes or exits, kill the process bound to VAR." 174 | (declare 175 | (debug (sexp &rest form)) 176 | (indent 1)) 177 | `(let ((,var (mp/start-daemon))) 178 | (unwind-protect 179 | (progn 180 | (sleep-for 5) 181 | ,@form) 182 | (funcall ,var :kill)))) 183 | 184 | (defun mp/testit () 185 | "Crude test of the macros." 186 | (with-mp channel 187 | (mp> channel remote 188 | (progn (sleep-for 2) (* 10 15)) 189 | (message "hurrah! %s" (remote))) 190 | (sleep-for 10))) 191 | 192 | (defun mp/test-divide-by-zero () 193 | (with-mp channel 194 | (mp> channel remote 195 | (progn (sleep-for 2) (/ 1 0)) 196 | (condition-case err 197 | (message "hurrah! %s" (remote)) 198 | (:mp-remote-error (message "whoops! divide by 0")))) 199 | (sleep-for 10))) 200 | 201 | (provide 'mp) 202 | 203 | ;;; mp.el ends here 204 | --------------------------------------------------------------------------------