[elpa] externals/ssh-deploy ffc3cd0 173/173: Added support for multithreading

[Stefan Monnier]

branch: externals/ssh-deploy
commit ffc3cd000e50144b5b10d1cba457398ed7eef6e5
Author: Christian Johansson <address@hidden>
Commit: Christian Johansson <address@hidden>

    Added support for multithreading
---
 README.md     |   4 +-
 ssh-deploy.el | 191 ++++++++++++++++++++++++++++++----------------------------
 2 files changed, 102 insertions(+), 93 deletions(-)

diff --git a/README.md b/README.md
index b5ebf4f..ef8e619 100644
--- a/README.md
+++ b/README.md
@@ -16,7 +16,7 @@ The `ssh-deploy` plug-in for Emacs makes it possible to 
effortlessly deploy loca
 * Open corresponding file on the remote host
 * Open SQL database-session on remote hosts
 * Run custom deployment scripts
-* All operations support asynchronous mode if `async.el` is installed. (You 
need to setup an automatic authorization for this, i.e. `~/.netrc`, 
`~/.authinfo` or `~/.authinfo.gpg` and/or key-based password-less authorization)
+* All operations support asynchronous mode if `(make-thread`) or `async.el` is 
installed. (You need to setup an automatic authorization for this, i.e. 
`~/.netrc`, `~/.authinfo` or `~/.authinfo.gpg` and/or key-based password-less 
authorization)
 
 The idea for this plug-in was to mimic the behavior of **PhpStorm** deployment 
functionality.
 
@@ -33,7 +33,7 @@ Here is a list of other variables you can set globally or per 
directory:
 * `ssh-deploy-automatically-detect-remote-changes` Enables automatic detection 
of remote changes *(boolean)*
 * `ssh-deploy-on-explicit-save` Enabled automatic uploads on save *(boolean)*
 * `ssh-deploy-exclude-list` A list defining what paths to exclude from 
deployment *(list)*
-* `ssh-deploy-async` Enables asynchronous transfers (you need to have 
`async.el` installed as well) *(boolean)*
+* `ssh-deploy-async` Enables asynchronous transfers (you need to have 
`(make-thread)` or `async.el` installed as well) *(boolean)*
 * `ssh-deploy-remote-sql-database` Default database when connecting to remote 
SQL database *(string)*
 * `ssh-deploy-remote-sql-password` Default password when connecting to remote 
SQL database *(string)*
 * `ssh-deploy-remote-sql-port` - Default port when connecting to remote SQL 
database *(integer)*
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 7ff218e..b8f1d09 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -4,7 +4,7 @@
 ;; Maintainer: Christian Johansson <github.com/cjohansson>
 ;; Created: 5 Jul 2016
 ;; Modified: 19 Aug 2018
-;; Version: 1.98
+;; Version: 2.0
 ;; Keywords: tools, convenience
 ;; URL: https://github.com/cjohansson/emacs-ssh-deploy
 
@@ -36,7 +36,7 @@
 ;; detection of remote changes, remote directory browsing, remote SQL database 
sessions and
 ;; running custom deployment scripts via TRAMP.
 ;;
-;; For asynchronous operations it uses package `async.el'.
+;; For asynchronous operations it uses package '`make-thread' or if not 
available '`async.el'.
 ;;
 ;; By setting the variables (globally, per directory or per file):
 ;; ssh-deploy-root-local,ssh-deploy-root-remote, ssh-deploy-on-explicit-save
@@ -150,7 +150,7 @@
 ;; * `ssh-deploy-automatically-detect-remote-changes' - Enables automatic 
detection of remote changes *(boolean)*
 ;; * `ssh-deploy-on-explicit-save' - Enabled automatic uploads on save 
*(boolean)*
 ;; * `ssh-deploy-exclude-list' - A list defining what paths to exclude from 
deployment *(list)*
-;; * `ssh-deploy-async' - Enables asynchronous transfers (you need to have 
`async.el` installed as well) *(boolean)*
+;; * `ssh-deploy-async' - Enables asynchronous transfers (you need to have 
`(make-thread)` or `async.el` available as well) *(boolean)*
 ;; * `ssh-deploy-remote-sql-database' - Default database when connecting to 
remote SQL database *(string)*
 ;; * `ssh-deploy-remote-sql-password' - Default password when connecting to 
remote SQL database *(string)*
 ;; * `ssh-deploy-remote-sql-port' - Default port when connecting to remote SQL 
database *(integer)*
@@ -316,9 +316,28 @@
 ;; PRIVATE FUNCTIONS
 ;;
 ;; these functions are only used internally and should be of no value to 
outside public and handler functions.
-;; these functions MUST not use module variables.
+;; these functions MUST not use module variables in any way.
 
 
+(defun ssh-deploy--async-process (start &optional finish)
+  "Asynchronously do START and then optionally do FINISH."
+  (if (fboundp 'make-thread)
+      (make-thread `(lambda()
+                      (let ((start ,start)
+                            (finish ,finish))
+                        (if (boundp 'start)
+                            (progn
+                              (let ((result (funcall start)))
+                                (if (boundp 'finish)
+                                    (progn
+                                      (funcall finish result)))))))))
+    (if (fboundp 'async-start)
+        (if (boundp 'start)
+            (if (boundp 'finish)
+                (async-start start finish)
+              (async-start start)))
+      (display-warning 'ssh-deploy "Neither make-thread nor async-start 
functions are available!"))))
+
 (defun ssh-deploy--mode-line-set-status-and-update (status &optional filename)
   "Set the mode line STATUS in optionally in buffer visiting FILENAME."
   (if (and (boundp 'filename)
@@ -421,40 +440,38 @@
 
 (defun ssh-deploy--upload-via-tramp-async (path-local path-remote force 
revision-folder)
   "Upload PATH-LOCAL to PATH-REMOTE via TRAMP asynchronously and FORCE upload 
despite remote change, check for revisions in REVISION-FOLDER."
-  (if (fboundp 'async-start)
-      (let ((file-or-directory (not (file-directory-p path-local))))
-        (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-uploading path-local)
-        (if file-or-directory
-            (let ((revision-path (ssh-deploy--get-revision-path path-local 
revision-folder)))
-              (when ssh-deploy-verbose (message "Uploading file '%s' to '%s'.. 
(asynchronously)" path-local path-remote))
-              (async-start
-               `(lambda()
-                  (require 'ediff-util)
-                  (if (fboundp 'ediff-same-file-contents)
-                      (if (or (eq t ,force) (not (file-exists-p ,path-remote)) 
(and (file-exists-p ,revision-path) (ediff-same-file-contents ,revision-path 
,path-remote)))
-                          (progn
-                            (if (not (file-directory-p (file-name-directory 
,path-remote)))
-                                (make-directory (file-name-directory 
,path-remote) t))
-                            (copy-file ,path-local ,path-remote t t t t)
-                            (copy-file ,path-local ,revision-path t t t t)
-                            (list 0 (format "Completed upload of file '%s'. 
(asynchronously)" ,path-remote) ,path-local))
-                        (list 1 (format "Remote file '%s' has changed, please 
download or diff. (asynchronously)" ,path-remote) ,path-local))
-                    (list 1 "Function 'ediff-same-file-contents' is missing. 
(asynchronously)" ,path-local)))
-               (lambda(return)
-                 (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
-                 (if (= (nth 0 return) 0)
-                     (when ssh-deploy-verbose (message (nth 1 return)))
-                   (display-warning 'ssh-deploy (nth 1 return) :warning)))))
-          (progn
-            (when ssh-deploy-verbose (message "Uploading directory '%s' to 
'%s'.. (asynchronously)" path-local path-remote))
-            (async-start
-             `(lambda()
-                (copy-directory ,path-local ,path-remote t t t)
-                ,path-local)
-             (lambda(return-path)
-               (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle return-path)
-               (when ssh-deploy-verbose (message "Completed upload of 
directory '%s'. (asynchronously)" return-path)))))))
-    (display-warning 'ssh-deploy "async.el is not installed" :warning)))
+  (let ((file-or-directory (not (file-directory-p path-local))))
+    (ssh-deploy--mode-line-set-status-and-update ssh-deploy--status-uploading 
path-local)
+    (if file-or-directory
+        (let ((revision-path (ssh-deploy--get-revision-path path-local 
revision-folder)))
+          (when ssh-deploy-verbose (message "Uploading file '%s' to '%s'.. 
(asynchronously)" path-local path-remote))
+          (ssh-deploy--async-process
+           `(lambda()
+              (require 'ediff-util)
+              (if (fboundp 'ediff-same-file-contents)
+                  (if (or (eq t ,force) (not (file-exists-p ,path-remote)) 
(and (file-exists-p ,revision-path) (ediff-same-file-contents ,revision-path 
,path-remote)))
+                      (progn
+                        (if (not (file-directory-p (file-name-directory 
,path-remote)))
+                            (make-directory (file-name-directory ,path-remote) 
t))
+                        (copy-file ,path-local ,path-remote t t t t)
+                        (copy-file ,path-local ,revision-path t t t t)
+                        (list 0 (format "Completed upload of file '%s'. 
(asynchronously)" ,path-remote) ,path-local))
+                    (list 1 (format "Remote file '%s' has changed, please 
download or diff. (asynchronously)" ,path-remote) ,path-local))
+                (list 1 "Function 'ediff-same-file-contents' is missing. 
(asynchronously)" ,path-local)))
+           (lambda(return)
+             (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
+             (if (= (nth 0 return) 0)
+                 (when ssh-deploy-verbose (message (nth 1 return)))
+               (display-warning 'ssh-deploy (nth 1 return) :warning)))))
+      (progn
+        (when ssh-deploy-verbose (message "Uploading directory '%s' to '%s'.. 
(asynchronously)" path-local path-remote))
+        (ssh-deploy--async-process
+         `(lambda()
+            (copy-directory ,path-local ,path-remote t t t)
+            ,path-local)
+         (lambda(return-path)
+           (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle return-path)
+           (when ssh-deploy-verbose (message "Completed upload of directory 
'%s'. (asynchronously)" return-path))))))))
 
 (defun ssh-deploy--upload-via-tramp (path-local path-remote force 
revision-folder)
   "Upload PATH-LOCAL to PATH-REMOTE via TRAMP synchronously and FORCE despite 
remote change compared with copy in REVISION-FOLDER."
@@ -486,29 +503,27 @@
 
 (defun ssh-deploy--download-via-tramp-async (path-remote path-local 
revision-folder)
   "Download PATH-REMOTE to PATH-LOCAL via TRAMP asynchronously and make a copy 
in REVISION-FOLDER."
-  (if (fboundp 'async-start)
-      (let ((revision-path (ssh-deploy--get-revision-path path-local 
revision-folder)))
-        (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-downloading path-local)
-        (when ssh-deploy-verbose (message "Downloading '%s' to '%s'.. 
(asynchronously)" path-remote path-local))
-        (async-start
-         `(lambda()
-            (let ((file-or-directory (not (file-directory-p ,path-remote))))
-              (if file-or-directory
-                  (progn
-                    (if (not (file-directory-p (file-name-directory 
,path-local)))
-                        (make-directory (file-name-directory ,path-local) t))
-                    (copy-file ,path-remote ,path-local t t t t)
-                    (copy-file ,path-local ,revision-path t t t t))
-                (copy-directory ,path-remote ,path-local t t t))
-              ,path-local))
-         (lambda(return-path)
-           (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle return-path)
-           (when ssh-deploy-verbose (message "Completed download of '%s'. 
(asynchronously)" return-path))
-           (let ((local-buffer (find-buffer-visiting return-path)))
-             (when local-buffer
-               (with-current-buffer local-buffer
-                 (revert-buffer t t t)))))))
-    (display-warning 'ssh-deploy "async.el is not installed" :warning)))
+  (let ((revision-path (ssh-deploy--get-revision-path path-local 
revision-folder)))
+    (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-downloading path-local)
+    (when ssh-deploy-verbose (message "Downloading '%s' to '%s'.. 
(asynchronously)" path-remote path-local))
+    (ssh-deploy--async-process
+     `(lambda()
+        (let ((file-or-directory (not (file-directory-p ,path-remote))))
+          (if file-or-directory
+              (progn
+                (if (not (file-directory-p (file-name-directory ,path-local)))
+                    (make-directory (file-name-directory ,path-local) t))
+                (copy-file ,path-remote ,path-local t t t t)
+                (copy-file ,path-local ,revision-path t t t t))
+            (copy-directory ,path-remote ,path-local t t t))
+          ,path-local))
+     (lambda(return-path)
+       (ssh-deploy--mode-line-set-status-and-update ssh-deploy--status-idle 
return-path)
+       (when ssh-deploy-verbose (message "Completed download of '%s'. 
(asynchronously)" return-path))
+       (let ((local-buffer (find-buffer-visiting return-path)))
+         (when local-buffer
+           (with-current-buffer local-buffer
+             (revert-buffer t t t))))))))
 
 (defun ssh-deploy--download-via-tramp (path-remote path-local revision-folder)
   "Download PATH-REMOTE to PATH-LOCAL via TRAMP synchronously and store a copy 
in REVISION-FOLDER."
@@ -726,10 +741,10 @@
       (setq async ssh-deploy-async))
   (if (not (boundp 'exclude-list))
       (setq exclude-list ssh-deploy-exclude-list))
-  (if (and async (fboundp 'async-start))
+  (if async
       (let ((script-filename (file-name-directory (symbol-file 
'ssh-deploy-diff-directories))))
         (message "Calculating differences between directory '%s' and '%s'.. 
(asynchronously)" directory-a directory-b)
-        (async-start
+        (ssh-deploy--async-process
          `(lambda()
             (add-to-list 'load-path ,script-filename)
             (require 'ssh-deploy)
@@ -766,17 +781,15 @@
                 ;; Does a local revision of the file exist?
                 (if (file-exists-p revision-path)
 
-                    ;; Local revision exist. Is async.el installed?
-                    (if (and async (fboundp 'async-start))
-
-                        ;; Async.el is installed
+                    ;; Local revision exist. Is async enabled?
+                    (if async
                         (progn
 
                           ;; Update buffer status
                           (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
 
                           ;; Asynchronous logic here
-                          (async-start
+                          (ssh-deploy--async-process
                            `(lambda()
                               (if (file-exists-p ,path-remote)
                                   (progn
@@ -800,7 +813,7 @@
                                  (when ssh-deploy-verbose (message (nth 1 
return)))
                                (display-warning 'ssh-deploy (nth 1 return) 
:warning)))))
 
-                      ;; Async.el is not installed - synchronous logic here
+                      ;; Async is not enabled - synchronous logic here
                       (progn
 
                         ;; Update buffer status
@@ -820,17 +833,15 @@
                         ;; Update buffer status to idle
                         (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle)))
 
-                  ;; Does not have local revision. Is async.el installed?
-                  (if (and async (fboundp 'async-start))
-
-                      ;; Async.el is installed
+                  ;; Does not have local revision. Is async enabled?
+                  (if async
                       (progn
 
                         ;; Update buffer status
                         (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
 
                         ;; Asynchronous logic here
-                        (async-start
+                        (ssh-deploy--async-process
                          `(lambda()
 
                             ;; Does remote file exist?
@@ -854,7 +865,7 @@
                                (when ssh-deploy-verbose (message (nth 1 
return)))
                              (display-warning 'ssh-deploy (nth 1 return) 
:warning)))))
 
-                    ;; Async.el is not installed - synchronous logic here
+                    ;; Async is not enabled - synchronous logic here
                     (progn
 
                       ;; Update buffer status
@@ -884,12 +895,12 @@
 
 (defun ssh-deploy-delete (path &optional async debug buffer)
   "Delete PATH and use flags ASYNC and DEBUG, set status in BUFFER."
-  (if (and async (fboundp 'async-start))
+  (if async
       (progn
         (when (and (boundp 'buffer)
                    buffer)
           (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-deleting buffer))
-        (async-start
+        (ssh-deploy--async-process
          `(lambda()
             (if (file-exists-p ,path)
                 (let ((file-or-directory (not (file-directory-p ,path))))
@@ -966,8 +977,8 @@
                 (set-buffer-modified-p nil))
             (dired new-path-local))
           (message "Renamed '%s' to '%s'." old-path-local new-path-local)
-          (if (and async (fboundp 'async-start))
-              (async-start
+          (if async
+              (ssh-deploy--async-process
                `(lambda()
                   (rename-file ,old-path-remote ,new-path-remote t)
                   (list ,old-path-remote ,new-path-remote ,new-path-local))
@@ -1085,7 +1096,7 @@
   (if (not (boundp 'force))
       (setq force nil))
   (let ((revision-folder (or revision-folder ssh-deploy-revision-folder)))
-    (if (and async (fboundp 'async-start))
+    (if async
         (ssh-deploy--upload-via-tramp-async path-local path-remote force 
revision-folder)
       (ssh-deploy--upload-via-tramp path-local path-remote force 
revision-folder))))
 
@@ -1095,7 +1106,7 @@
   (if (not (boundp 'async))
       (setq async ssh-deploy-async))
   (let ((revision-folder (or revision-folder ssh-deploy-revision-folder)))
-    (if (and async (fboundp 'async-start))
+    (if async
         (ssh-deploy--download-via-tramp-async path-remote path-local 
revision-folder)
       (ssh-deploy--download-via-tramp path-remote path-local 
revision-folder))))
 
@@ -1326,16 +1337,14 @@
   (if (and (boundp 'ssh-deploy-script)
            ssh-deploy-script)
       (if ssh-deploy-async
-          (if (fboundp 'async-start)
-              (progn
-                (message "Executing of deployment-script starting... 
(asynchronously)")
-                (async-start
-                 `(lambda()
-                    (let ((ssh-deploy-root-local ,ssh-deploy-root-local)
-                          (ssh-deploy-root-remote ,ssh-deploy-root-remote))
-                      (funcall ,ssh-deploy-script)))
-                 (lambda(result) (message "Completed execution of 
deployment-script. '%s'(asynchronously)" result))))
-            (display-warning 'ssh-deploy "async.el is not installed" :warning))
+          (progn
+            (message "Executing of deployment-script starting... 
(asynchronously)")
+            (ssh-deploy--async-process
+             `(lambda()
+                (let ((ssh-deploy-root-local ,ssh-deploy-root-local)
+                      (ssh-deploy-root-remote ,ssh-deploy-root-remote))
+                  (funcall ,ssh-deploy-script)))
+             (lambda(result) (message "Completed execution of 
deployment-script. '%s'(asynchronously)" result))))
         (progn
           (message "Executing of deployment-script starting... 
(synchronously)")
           (funcall ssh-deploy-script)