+++ /dev/null
-* Emacs Parallel
-
- Emacs Parallel is yet another library to simulate parallel
- computations in Emacs (because it lacks threads support in Elisp).
-
-* STARTED HowTo
-
- You can execute a simple function a retrive the result like this:
- #+BEGIN_SRC emacs-lisp
- (parallel-get-result (parallel-start (lambda () (* 42 42))))
- ⇒ 1764
- #+END_SRC
-
- Though you won't benefit from the parallelism because
- ~parallel-get-result~ is blocking, that is it waits for the function
- to be executed.
-
- So you can use define a callback to be called when the function is
- finished:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda () (sleep-for 4.2) "Hello World")
- :post-exec (lambda (results _status)
- (message (first results))))
- ⊣ Hello World
- #+END_SRC
-
- Here, why ~(first results)~ and not ~result~? Because you can send
- data from the remote instance while it's running with
- ~parallel-remote-send~:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda ()
- (parallel-remote-send "Hello")
- (sleep-for 4.2)
- "World")
- :post-exec (lambda (results _status)
- (message "%s"
- (mapconcat #'identity (reverse results) " "))))
- ⊣ Hello World
- #+END_SRC
- As you may have noticed the results are pushed in a list, so the
- first element is the result returned by the function called, the
- second is the last piece of data send, and so on...
-
- And of course you can execute some code when you receive data from
- the remote instance:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda ()
- (parallel-remote-send 42)
- (sleep-for 4.2) ; heavy computation to compute PI
- pi)
- :on-event (lambda (data)
- (message "Received %S" data)))
- ⊣ Received 42
- ⊣ Received 3.141592653589793
- #+END_SRC
-
- Because the function is executed in another Emacs instance (in Batch
- Mode by default), the environment isn't the same. However you can
- send some data with the ~env~ parameter:
- #+BEGIN_SRC emacs-lisp
- (let ((a 42)
- (b 12))
- (parallel-get-result (parallel-start (lambda (a b) (+ a b))
- :env (list a b))))
- ⇒ 54
- #+END_SRC
-
- By default, the remote Emacs instance is exited when the function is
- executed, but you can keep it running with the
- ~:continue-when-executed~ option and send new code to be executed
- with ~parellel-send~.
- #+BEGIN_SRC emacs-lisp
- (let ((task (parallel-start (lambda () 42)
- :continue-when-executed t)))
- (sleep-for 4.2)
- (parallel-send task (lambda () (setq parallel-continue-when-executed nil) 12))
- (parallel-get-results task))
- ⇒ (12 42)
- #+END_SRC
-
- As you can see, to stop the remote instance you have to set the
- variable ~parallel-continue-when-executed~ to nil.
-
-* Modules
-
-** Parallel XWidget
-
- [[http://www.emacswiki.org/emacs/EmacsXWidgets][Emacs XWidget]] is an experimental branch which permits to embed GTK+
- widget inside Emacs buffers. For instance, it is possible to use it
- to render an HTML page using the webkit engine within an Emacs
- buffer.
-
- With this module, you can configure your "main" Emacs to use
- another one to render web pages.
-
- Let's assume that you've cloned [[https://github.com/jave/xwidget-emacs][the Emacs XWidget repository]] in
- ~$HOME/src/emacs-xwidget/~. Once you've compiled it, an Emacs
- executable is available ~$HOME/src/emacs-xwidget/src/emacs~.
-
- Configure ~parallel-xwidget~ to use it:
- #+BEGIN_SRC emacs-lisp
- (setq parallel-xwidget-config (list :emacs-path
- (concat (getenv "HOME")
- "/src/emacs-xwidget/src/emacs")))
- #+END_SRC
-
- Then configure your current Emacs to use it:
- #+BEGIN_SRC emacs-lisp
- (setq browse-url-browser-function 'parallel-xwidget-browse-url)
- #+END_SRC
-
- You can check it out with M-x browse-url RET google.com RET.
-
-* Tips & Tricks
-
- If your windows manager is smart enough (like StumpwWM) you can use
- it to move graphical windows (Emacs frames) in another desktop.
-
- For example, I use this to move Emacs frames (with the title
- "emacs-debug") to the group (aka desktop) 9:
- #+BEGIN_SRC lisp
- (define-frame-preference "9"
- (0 nil t :title "emacs-debug"))
- #+END_SRC
-
- And this to specify the title of the frame:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda () 42)
- :no-batch t
- :emacs-args '("-T" "emacs-debug"))
- #+END_SRC
-
-* TODO How does it work?
-
-* Known limitations
-
- You can only send data to the remote (with the ~env~ parameter) or
- from the remote (with ~parallel-send~ and ~parallel-remote-send~)
- that have a printed representation (see [[info:elisp#Printed%20Representation][info:elisp#Printed
- Representation]]).
-
- So you can pass around numbers, symbols, strings, lists, vectors,
- hash-table but you can't pass buffers, windows, frames...
-
-
- It lacks documentation, tests and probably a clean API, but I'm
- working on it!
+++ /dev/null
-;; -*- mode: emacs-lisp; lexical-binding: t; -*-
-;;; parallel-remote.el ---
-
-;; Copyright (C) 2013 Grégoire Jadi
-
-;; Author: Grégoire Jadi <gregoire.jadi@gmail.com>
-
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of
-;; the License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'cl)
-
-(defvar parallel-service nil)
-(defvar parallel-task-id nil)
-(defvar parallel-client nil)
-(defvar parallel--executed nil)
-(defvar parallel-continue-when-executed nil)
-
-(defun parallel-remote-send (data)
- (process-send-string parallel-client
- (format "%S " (cons parallel-task-id data))))
-
-(defun parallel-remote--init ()
- (setq parallel-client (make-network-process :name "emacs-parallel"
- :buffer nil
- :server nil
- :service parallel-service
- :host "localhost"
- :family 'ipv4))
- (set-process-filter parallel-client #'parallel-remote--filter)
- (parallel-remote-send 'code)
- (when noninteractive ; Batch Mode
- ;; The evaluation is done in the `parallel--filter' but in Batch
- ;; Mode, Emacs doesn't wait for the input, it stops as soon as
- ;; `parallel--init' has been executed.
- (while (null parallel--executed)
- (sleep-for 10)))) ; arbitrary chosen
-
-(defun parallel-remote--filter (_proc output)
- (dolist (code (parallel--read-output output))
- (parallel-remote-send
- (if (or noninteractive
- (not debug-on-error))
- (condition-case err
- (eval code)
- (error err))
- (eval code))))
- (unless parallel-continue-when-executed
- (setq parallel--executed t)
- (kill-emacs)))
-
-(defun parallel--read-output (output)
- "Read lisp forms from output and return them as a list."
- (loop with output = (replace-regexp-in-string
- "\\`[ \t\n]*" ""
- (replace-regexp-in-string "[ \t\n]*\\'" "" output)) ; trim string
- with start = 0
- with end = (length output)
- for ret = (read-from-string output start end)
- for data = (first ret)
- do (setq start (rest ret))
- collect data
- until (= start end)))
-
-(provide 'parallel-remote)
-
-;;; parallel-remote.el ends here
+++ /dev/null
-;;; parallel-xwidget.el ---
-
-;; Copyright (C) 2013 Grégoire Jadi
-
-;; Author: Grégoire Jadi <gregoire.jadi@gmail.com>
-
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of
-;; the License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'parallel)
-(require 'browse-url)
-
-(defgroup parallel-xwidget nil
- "Browse the web in another emacs instance with XWidget."
- :group 'emacs)
-
-(defvar parallel-xwidget--task nil)
-
-(defcustom parallel-xwidget-config nil
- "Parallel configuration."
- :type 'alist
- :group 'parallel-xwidget)
-
-(defun parallel-xwidget--init ()
- (setq parallel-xwidget--task
- (parallel-start (lambda ()
- (require 'xwidget))
- :graphical t
- :continue-when-executed t
- :config parallel-xwidget-config)))
-
-(defun parallel-xwidget-browse-url (url &optional new-session)
- "Browse URL in another Emacs instance."
- (interactive (browse-url-interactive-arg "xwidget-webkit URL: "))
- (unless (and parallel-xwidget--task
- (eq 'run (parallel-status parallel-xwidget--task)))
- (parallel-xwidget--init))
- (parallel-send parallel-xwidget--task
- (lambda (url new-session)
- (xwidget-webkit-browse-url url new-session))
- (url-tidy url) new-session))
-
-(provide 'parallel-xwidget)
-
-;;; parallel-xwidget.el ends here
+++ /dev/null
-;; -*- lexical-binding: t; -*-
-;;; parallel.el ---
-
-;; Copyright (C) 2013 Grégoire Jadi
-
-;; Author: Grégoire Jadi <gregoire.jadi@gmail.com>
-
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of
-;; the License, or (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'cl)
-(require 'parallel-remote)
-
-(defgroup parallel nil
- "Execute stuff in parallel"
- :group 'emacs)
-
-(defcustom parallel-sleep 0.05
- "How many sec should we wait while polling."
- :type 'number
- :group 'parallel)
-
-(defcustom parallel-config nil
- "Global config setting to use."
- :type 'plist
- :group 'parallel)
-
-(defvar parallel--server nil)
-(defvar parallel--tasks nil)
-(defvar parallel--tunnels nil)
-
-;; Declare external function
-(declare-function parallel-send "parallel-remote")
-
-(defun parallel-make-tunnel (username hostname)
- (parallel--init-server)
- (let ((tunnel (find-if (lambda (tun)
- (and (string= username
- (process-get tun 'username))
- (string= hostname
- (process-get tun 'hostname))))
- parallel--tunnels)))
- (unless tunnel
- (setq tunnel (start-process "parallel-ssh" nil "ssh"
- "-N" "-R" (format "0:localhost:%s"
- (process-contact parallel--server :service))
- (format "%s@%s" username hostname)))
- (process-put tunnel 'username username)
- (process-put tunnel 'hostname hostname)
- (set-process-filter tunnel #'parallel--tunnel-filter)
- (while (null (process-get tunnel 'service))
- (sleep-for 0.01))
- (push tunnel parallel--tunnels))
- tunnel))
-
-(defun parallel-stop-tunnel (tunnel)
- (setq parallel--tunnels (delq tunnel parallel--tunnels))
- (delete-process tunnel))
-
-(defun parallel--tunnel-filter (proc output)
- (if (string-match "\\([0-9]+\\)" output)
- (process-put proc 'service (match-string 1 output))))
-
-(defmacro parallel--set-option (place config)
- `(setf ,place (or ,place
- (plist-get ,config ,(intern (format ":%s" (symbol-name place))))
- (plist-get parallel-config ,(intern (format ":%s" (symbol-name place)))))))
-
-(defmacro parallel--set-options (config &rest options)
- `(progn
- ,@(loop for option in options
- collect `(parallel--set-option ,option ,config))))
-
-(defun* parallel-start (exec-fun &key post-exec env timeout
- emacs-path library-path emacs-args
- graphical debug on-event continue-when-executed
- username hostname hostport
- config)
- (parallel--init-server)
-
- ;; Initialize parameters
- (parallel--set-options config
- post-exec
- env
- timeout
- emacs-args
- graphical
- debug
- on-event
- continue-when-executed
- username
- hostname
- hostport)
-
- (setq emacs-path (or emacs-path
- (plist-get config :emacs-path)
- (plist-get parallel-config :emacs-path)
- (expand-file-name invocation-name
- invocation-directory))
- library-path (or library-path
- (plist-get config :library-path)
- (plist-get parallel-config :library-path)
- (locate-library "parallel-remote")))
-
- (let ((task (parallel--new-task))
- proc tunnel ssh-args)
- (push task parallel--tasks)
- (put task 'initialized nil)
- (put task 'exec-fun exec-fun)
- (put task 'env env)
- (when (functionp post-exec)
- (put task 'post-exec post-exec))
- (when (functionp on-event)
- (put task 'on-event on-event))
- (put task 'results nil)
- (put task 'status 'run)
- (put task 'queue nil)
-
- ;; We need to get the tunnel if it exists so we can send the right
- ;; `service' to the remote.
- (when (and username hostname)
- (if hostport
- (setq ssh-args (list "-R" (format "%s:localhost:%s" hostport
- (process-contact parallel--server :service)))
- tunnel t)
- (setq tunnel (parallel-make-tunnel username hostname)
- hostport (process-get tunnel 'service)))
- (setq ssh-args (append
- ssh-args
- (if graphical (list "-X"))
- (list (format "%s@%s" username hostname)))))
- (setq emacs-args (remq nil
- (list* "-Q" "-l" library-path
- (if graphical nil "-batch")
- "--eval" (format "(setq parallel-service '%S)"
- (if tunnel
- hostport
- (process-contact parallel--server :service)))
- "--eval" (format "(setq parallel-task-id '%S)" task)
- "--eval" (format "(setq debug-on-error '%S)" debug)
- "--eval" (format "(setq parallel-continue-when-executed '%S)" continue-when-executed)
- "-f" "parallel-remote--init"
- emacs-args)))
-
- ;; Reformat emacs-args if we use a tunnel (escape string)
- (when tunnel
- (setq emacs-args (list (mapconcat (lambda (string)
- (if (find ?' string)
- (prin1-to-string string)
- string))
- emacs-args " "))))
- (setq proc (apply #'start-process "parallel" nil
- `(,@(when tunnel
- (list* "ssh" ssh-args))
- ,emacs-path
- ,@emacs-args)))
- (put task 'proc proc)
- (set-process-sentinel (get task 'proc) #'parallel--sentinel)
- (when timeout
- (run-at-time timeout nil (lambda ()
- (when (memq (parallel-status task)
- '(run stop))
- (parallel-stop task)))))
- task))
-
-(defun parallel--new-task ()
- "Generate a new task by enforcing a unique name."
- (let ((symbol-name (make-temp-name "parallel-task-")))
- (while (intern-soft symbol-name)
- (setq symbol-name (make-temp-name "parallel-task-")))
- (intern symbol-name)))
-
-(defun parallel--init-server ()
- "Initialize `parallel--server'."
- (when (or (null parallel--server)
- (not (eq (process-status parallel--server)
- 'listen)))
- (setq parallel--server
- (make-network-process :name "parallel-server"
- :buffer nil
- :server t
- :host "localhost"
- :service t
- :family 'ipv4
- :filter #'parallel--filter
- :filter-multibyte t))))
-
-(defun parallel--get-task-process (proc)
- "Return the task running the given PROC."
- (find-if (lambda (task)
- (eq (get task 'proc) proc))
- parallel--tasks))
-
-(defun parallel--sentinel (proc _event)
- "Sentinel to watch over the remote process.
-
-This function do the necessary cleanup when the remote process is
-finished."
- (when (memq (process-status proc) '(exit signal))
- (let* ((task (parallel--get-task-process proc))
- (results (get task 'results))
- (status (process-status proc)))
- ;; 0 means that the remote process has terminated normally (no
- ;; SIGNUM 0).
- (if (zerop (process-exit-status proc))
- (setq status 'success)
- ;; on failure, push the exit-code or signal number on the
- ;; results stack.
- (push (process-exit-status proc) results))
- (put task 'results results)
- (put task 'status status)
-
- (when (functionp (get task 'post-exec))
- (funcall (get task 'post-exec)
- results status))
- (setq parallel--tasks (delq task parallel--tasks)))))
-
-(defun parallel--call-with-env (fun env)
- "Return a string which can be READ/EVAL by the remote process
-to `funcall' FUN with ENV as arguments."
- (format "(funcall (read %S) %s)"
- (prin1-to-string fun)
- (mapconcat (lambda (obj)
- ;; We need to quote it because the remote
- ;; process will READ/EVAL it.
- (format "'%S" obj)) env " ")))
-
-(defun parallel--filter (connection output)
- "Server filter used to retrieve the results send by the remote
-process and send the code to be executed by it."
- (dolist (data (parallel--read-output output))
- (parallel--process-output connection (first data) (rest data))))
-
-(defun parallel--process-output (connection task result)
- (put task 'connection connection)
- (cond ((and (not (get task 'initialized))
- (eq result 'code))
- (apply #'parallel-send
- task
- (get task 'exec-fun)
- (get task 'env))
- (let ((code nil))
- (while (setq code (pop (get task 'queue)))
- (apply #'parallel-send task (car code) (cdr code))))
- (put task 'initialized t))
- (t
- (push result (get task 'results))
- (if (functionp (get task 'on-event))
- (funcall (get task 'on-event) result)))))
-
-(defun parallel-ready-p (task)
- "Determine whether TASK is finished and if the results are
-available."
- (memq (parallel-status task) '(success exit signal)))
-
-(defun parallel-get-result (task)
- "Return the last result send by the remote call, that is the
-result returned by exec-fun."
- (first (parallel-get-results task)))
-
-(defun parallel-get-results (task)
- "Return all results send during the call of exec-fun."
- (parallel-wait task)
- (get task 'results))
-
-(defun parallel-success-p (task)
- "Determine whether TASK has ended successfully."
- (parallel-wait task)
- (eq (parallel-status task) 'success))
-
-(defun parallel-status (task)
- "Return TASK status."
- (get task 'status))
-
-(defun parallel-wait (task)
- "Wait for TASK."
- (while (not (parallel-ready-p task))
- (sleep-for parallel-sleep))
- t) ; for REPL
-
-(defun parallel-stop (task)
- "Stop TASK."
- (delete-process (get task 'proc)))
-
-(defun parallel-send (task fun &rest env)
- "Send FUN to be evaluated by TASK in ENV."
- (let ((connection (get task 'connection)))
- (if connection
- (process-send-string
- connection
- (parallel--call-with-env fun env))
- (push (cons fun env) (get task 'queue)))))
-
-(provide 'parallel)
-
-;;; parallel.el ends here
+++ /dev/null
-;; -*- lexical-binding: t; -*-
-
-(require 'cl)
-(require 'xwidget)
-(require 'xwidget-test)
-(require 'parallel)
-
-(defvar xwidget-parallel-config (list :emacs-path (expand-file-name
- "~/packages/xwidget-build/src/emacs")))
-
-(defmacro xwidget-deftest (name types &rest body)
- (declare (indent defun))
- (if (null types)
- `(ert-deftest ,(intern (format "%s" name)) ()
- (let ((parallel-config xwidget-parallel-config))
- ,@body))
- `(progn
- ,@(loop for type in types
- collect
- `(ert-deftest ,(intern (format "%s-%s" name type)) ()
- (let ((parallel-config xwidget-parallel-config)
- (type ',type)
- (title ,(symbol-name type)))
- ,@body))))))
-
-(xwidget-deftest xwidget-make-xwidget (Button ToggleButton slider socket cairo)
- (let* ((beg 1)
- (end 1)
- (width 100)
- (height 100)
- (data nil)
- (proc (parallel-start
- (lambda (beg end type title width height data)
- (require 'xwidget)
- (require 'cl)
- (with-temp-buffer
- (insert ?\0)
- (let* ((buffer (current-buffer))
- (xwidget (make-xwidget beg end type title width height data buffer)))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (parallel-remote-send (coerce (xwidget-info xwidget) 'list))
- (parallel-remote-send (buffer-name buffer))
- (buffer-name (xwidget-buffer xwidget)))))
- :env (list beg end type title width height data)))
- (results (parallel-get-results proc)))
- (should (parallel-success-p proc))
- (when (parallel-success-p proc)
- (destructuring-bind (xwidget-buffer temp-buffer xwidget-info)
- results
- (should (equal (list type title width height)
- xwidget-info))
- (should (equal temp-buffer xwidget-buffer))))))
-
-(xwidget-deftest xwidget-query-on-exit-flag ()
- (should (equal '(nil t)
- (parallel-get-results
- (parallel-start (lambda ()
- (require 'xwidget)
- (let ((xwidget (make-xwidget 1 1 'Button "Button" 100 100 nil)))
- (parallel-remote-send (xwidget-query-on-exit-flag xwidget))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (xwidget-query-on-exit-flag xwidget))))))))
-
-(xwidget-deftest xwidget-query-on-exit-flag (Button ToggleButton slider socket cairo)
- (should (parallel-get-result
- (parallel-start (lambda (type title)
- (require 'xwidget)
- (with-temp-buffer
- (let ((xwidget (make-xwidget 1 1 type title 10 10 nil)))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (xwidgetp xwidget))))
- :env (list type title)))))
-
-(xwidget-deftest xwidget-CHECK_XWIDGET ()
- (should (equal (parallel-get-result
- (parallel-start (lambda ()
- (require 'xwidget)
- (xwidget-info nil))))
- '(wrong-type-argument xwidgetp nil)))
- (should (equal (parallel-get-result
- (parallel-start (lambda ()
- (require 'xwidget)
- (xwidget-view-info nil))))
- '(wrong-type-argument xwidget-view-p nil))))
-
-(xwidget-deftest xwidget-view-p (Button ToggleButton slider socket cairo)
- (should (parallel-get-result
- (parallel-start (lambda (type title)
- (require 'xwidget)
- (with-temp-buffer
- (insert ?\0)
- (let* ((xwidget (xwidget-insert 1 type title 100 100))
- (window (xwidget-display xwidget)))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (xwidget-view-p
- (xwidget-view-lookup xwidget window)))))
- :env (list type title)
- :graphical t
- :emacs-args '("-T" "emacs-debug")))))
-
-(defun xwidget-interactive-tests ()
- "Interactively test Button ToggleButton and slider.
-
-Start Emacs instances and try to insert the xwidget."
- (interactive)
- (flet ((test-xwidget (type)
- (parallel-get-result
- (parallel-start (lambda ()
- (require 'xwidget)
- (with-temp-buffer
- (insert ?\0)
- (set-xwidget-query-on-exit-flag
- (xwidget-insert 1 type (format "%s" type) 100 100) nil)
- (display-buffer (current-buffer))
- (cons type (or (y-or-n-p (format "Do you see a %s?" type)) 'failed))))
- :graphical t
- :debug t
- :config xwidget-parallel-config))))
- (message "%S" (mapcar #'test-xwidget '(Button ToggleButton slider)))))
-
-(provide 'xwidget-tests)