From d5ccaa07b92c3450dcdd354db107d2527f3ebd19 Mon Sep 17 00:00:00 2001 From: Joakim Verona Date: Tue, 3 Feb 2015 01:11:56 +0100 Subject: [PATCH] Moved emacs-parallell to the aux repo --- lisp/emacs-parallel/README.org | 147 --------------- lisp/emacs-parallel/parallel-remote.el | 81 --------- lisp/emacs-parallel/parallel-xwidget.el | 59 ------ lisp/emacs-parallel/parallel.el | 310 -------------------------------- test/automated/xwidget-tests.el | 121 ------------- 5 files changed, 718 deletions(-) delete mode 100644 lisp/emacs-parallel/README.org delete mode 100644 lisp/emacs-parallel/parallel-remote.el delete mode 100644 lisp/emacs-parallel/parallel-xwidget.el delete mode 100644 lisp/emacs-parallel/parallel.el delete mode 100644 test/automated/xwidget-tests.el diff --git a/lisp/emacs-parallel/README.org b/lisp/emacs-parallel/README.org deleted file mode 100644 index dd08381225f..00000000000 --- a/lisp/emacs-parallel/README.org +++ /dev/null @@ -1,147 +0,0 @@ -* 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! diff --git a/lisp/emacs-parallel/parallel-remote.el b/lisp/emacs-parallel/parallel-remote.el deleted file mode 100644 index 54626afc267..00000000000 --- a/lisp/emacs-parallel/parallel-remote.el +++ /dev/null @@ -1,81 +0,0 @@ -;; -*- mode: emacs-lisp; lexical-binding: t; -*- -;;; parallel-remote.el --- - -;; Copyright (C) 2013 Grégoire Jadi - -;; Author: Grégoire Jadi - -;; 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 . - -;;; 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 diff --git a/lisp/emacs-parallel/parallel-xwidget.el b/lisp/emacs-parallel/parallel-xwidget.el deleted file mode 100644 index 7e23863d6eb..00000000000 --- a/lisp/emacs-parallel/parallel-xwidget.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; parallel-xwidget.el --- - -;; Copyright (C) 2013 Grégoire Jadi - -;; Author: Grégoire Jadi - -;; 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 . - -;;; 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 diff --git a/lisp/emacs-parallel/parallel.el b/lisp/emacs-parallel/parallel.el deleted file mode 100644 index a6c77eac26b..00000000000 --- a/lisp/emacs-parallel/parallel.el +++ /dev/null @@ -1,310 +0,0 @@ -;; -*- lexical-binding: t; -*- -;;; parallel.el --- - -;; Copyright (C) 2013 Grégoire Jadi - -;; Author: Grégoire Jadi - -;; 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 . - -;;; 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 diff --git a/test/automated/xwidget-tests.el b/test/automated/xwidget-tests.el deleted file mode 100644 index 7f79c9422f6..00000000000 --- a/test/automated/xwidget-tests.el +++ /dev/null @@ -1,121 +0,0 @@ -;; -*- 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) -- 2.11.4.GIT