[elpa] externals/ssh-deploy d599659 015/173: Added support for opening remote terminals, uploads/downloads/differences of directories, browsing remote hosts and fixed a bug where paths with special chars were not handled correctly.

[Stefan Monnier]

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

    Added support for opening remote terminals, uploads/downloads/differences 
of directories, browsing remote hosts and fixed a bug where paths with special 
chars were not handled correctly.
---
 README.md     |  14 +++--
 ssh-deploy.el | 170 +++++++++++++++++++++++++++++++++++++++++-----------------
 2 files changed, 132 insertions(+), 52 deletions(-)

diff --git a/README.md b/README.md
index 861bdd8..7dfca28 100644
--- a/README.md
+++ b/README.md
@@ -1,10 +1,10 @@
 # `ssh-deploy`
 
-The `ssh-deploy` plugin makes it possible to effortlessly deploy local files 
to remote hosts via SSH. It also makes it possible to define remote paths per 
directory and whether or not you want to deploy on explicit save actions or 
not. Also it enables manual upload and download of files. You can also check 
differences between local file and remote file if you have `tramp` installed. 
**You need to have a setup which allows password-less key-based logins to 
servers via SSH and have scp ins [...]
+The `ssh-deploy` plug-in makes it possible to effortlessly deploy local files 
and directories to remote hosts via SSH. It also makes it possible to define 
remote paths per directory and whether or not you want to deploy on explicit 
save actions or not. Also it enables manual upload and download of files and 
directories. You can also check differences between local files and directories 
and remote files and directories if you have `tramp`,`ediff` and `ztree` 
installed. You can browse remo [...]
 
 `ssh-deploy` works with `DirectoryVariables` so you can have different deploy 
setups in different ways for different folders.
 
-The idea for this plug-in was to mimic the behavior of PhpStorm deployment 
functionality.
+The idea for this plug-in was to mimic the behavior of **PhpStorm** deployment 
functionality.
 
 This application is made by Christian Johansson <address@hidden> 2016 and is 
licensed under GNU General Public License 3.
 
@@ -25,13 +25,15 @@ This application is made by Christian Johansson 
<address@hidden> 2016 and is l
 
 ``` elisp
 ;; ssh-deploy - prefix = C-c C-z, u = upload, d = download, x = diff
-(add-to-list 'load-path "~/.emacs.d/ssh-deploy/") ;; Comment out this line if 
installed from MELPA
+(add-to-list 'load-path "~/.emacs.d/ssh-deploy/")
 (use-package ssh-deploy
   :config
   (add-hook 'after-save-hook (lambda() (if ssh-deploy-on-explicit-save 
(ssh-deploy-upload-handler)) ))
   (global-set-key (kbd "C-c C-z u") (lambda() 
(interactive)(ssh-deploy-upload-handler) ))
   (global-set-key (kbd "C-c C-z d") (lambda() 
(interactive)(ssh-deploy-download-handler)(revert-buffer) ))
-  (global-set-key (kbd "C-c C-z x") (lambda() 
(interactive)(ssh-deploy-diff-handler) )))
+  (global-set-key (kbd "C-c C-z x") (lambda() 
(interactive)(ssh-deploy-diff-handler) ))
+  (global-set-key (kbd "C-c C-z t") (lambda() 
(interactive)(ssh-deploy-remote-terminal-handler) ))
+  (global-set-key (kbd "C-c C-z b") (lambda() 
(interactive)(ssh-deploy-browse-remote-handler) )))
 ```
 
 You can remove the `add-to-list` line if you installed via `MELPA` repository.
@@ -40,6 +42,8 @@ You can remove the `add-to-list` line if you installed via 
`MELPA` repository.
 * If you press `C-c C-z x` you will launch a `ediff` session showing 
differences between local file and remote file using `tramp`.
 * If you press `C-c C-z u` you will upload local file to remote host.
 * If you press `C-c C-z d` you will download file from remote host and reload 
current buffer.
+* If you press `C-c C-z t` you will open a terminal with remote host.
+* If you press `C-c C-z b` you will browse remote host in `dired-mode`.
 
 The above configuration uses the plugin `use-package` which I highly recommend.
 
@@ -49,3 +53,5 @@ The above configuration uses the plugin `use-package` which I 
highly recommend.
 * <https://github.com/jwiegley/use-package>
 * <https://www.emacswiki.org/emacs/EdiffMode>
 * <http://melpa.org/>
+* <https://github.com/fourier/ztree>
+* <https://github.com/randymorris/tramp-term.el>
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 240a490..614003e 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -3,8 +3,8 @@
 ;; Author: Christian Johansson <github.com/cjohansson>
 ;; Maintainer: Christian Johansson <github.com/cjohansson>
 ;; Created: 5 Jul 2016
-;; Modified: 15 Jul 2016
-;; Version: 1.1
+;; Modified: 17 Jul 2016
+;; Version: 1.15
 ;; Keywords: tools, convenience
 ;; URL: https://github.com/cjohansson/emacs-ssh-deploy
 
@@ -30,27 +30,32 @@
 ;;; Commentary:
 
 ;; `ssh-deploy' enables automatic deploys on explicit-save, manual
-;; uploads, manual downloads and manual diffs via key-pair
-;; password-less authorized SSH connections.  To do this it uses tramp,
-;; scp and ediff.  By setting the variables (globally or per directory):
+;; uploads, downloads, differences, remote terminals and remote directory 
browsing
+;; via key-pair password-less authorized SSH connections.  To do this it uses 
tramp,
+;; tramp-term, scp, ediff and ztree-diff.
+;; By setting the variables (globally or per directory):
 ;; `ssh-deploy-root-local`,`ssh-deploy-root-remote`,
 ;; `ssh-deploy-on-explicit-save` you can setup a directory for
 ;; SSH deploy.
 ;;
-;; - To setup hook on explicit save do this:
+;; - To setup a hook on explicit save do this:
 ;;     (add-hook 'after-save-hook (lambda() (if ssh-deploy-on-explicit-save 
(ssh-deploy-upload-handler)) ))
 ;;
 ;; - To set key-bindings do something like this:
 ;;     (global-set-key (kbd "C-c C-z u") (lambda() 
(interactive)(ssh-deploy-upload-handler) ))
 ;;     (global-set-key (kbd "C-c C-z d") (lambda() 
(interactive)(ssh-deploy-download-handler)(revert-buffer) ))
 ;;     (global-set-key (kbd "C-c C-z x") (lambda() 
(interactive)(ssh-deploy-diff-handler) ))
+;;     (global-set-key (kbd "C-c C-z t") (lambda() 
(interactive)(ssh-deploy-remote-terminal-handler) ))
+;;     (global-set-key (kbd "C-c C-z b") (lambda() 
(interactive)(ssh-deploy-browse-remote-handler) ))
+;;
+;; Now when your in a directory which is deployed via SSH you can access these 
features.
 ;;
 ;; Please see README.md from the same repository for documentation.
 
 ;;; Code:
 
 (defgroup ssh-deploy nil
-  "Upload, download and difference handler for files on remote hosts via SSH."
+  "Upload, download and difference handler for files and directories on remote 
hosts via SSH."
   :group 'tools
   :group 'convenience)
 
@@ -69,66 +74,135 @@
   :type 'boolean
   :group 'ssh-deploy)
 
-(defun ssh-deploy-diff (local-root-raw remote-root)
-  "Find differences between the path LOCAL-ROOT-RAW with REMOTE-ROOT via ssh."
-  (let ((filename (shell-quote-argument buffer-file-name))
-        (local-root (shell-quote-argument local-root-raw)))
-    (let ((remote-path (concat "/ssh:" remote-root (replace-regexp-in-string 
local-root "" filename))))
-      (if (string-match local-root filename)
-          (progn
-           (message "Comparing file '%s' to '%s'.." filename remote-path)
-           (ediff filename remote-path))))))
+(defcustom ssh-deploy-debug nil
+  "Boolean variable if debug messages should be shown, nil by default."
+  :type 'boolean
+  :group 'ssh-deploy)
+
+(defun ssh-deploy-browse-remote (local-root remote-root path)
+  "Browse relative to LOCAL-ROOT on REMOTE-ROOT the path PATH in `dired-mode`."
+  (let ((remote-path (concat remote-root (replace-regexp-in-string local-root 
"" path))))
+    (message "Opening '%s' for browsing on remote host.." remote-path)
+    (dired (concat "/ssh:" remote-path))))
+
+(defun ssh-deploy-remote-terminal (remote-host)
+  "Opens REMOTE-HOST in tramp terminal."
+  (let ((hostname (replace-regexp-in-string ":.*$" "" remote-host)))
+    (let ((host (split-string hostname "@")))
+      (message "Opening tramp-terminal for remote host 'address@hidden' or 
'%s' translated from '%s'.." (car host) (car (last host)) hostname remote-host)
+      (unless (eql (catch 'tramp-term--abort (tramp-term--do-ssh-login host)) 
'tramp-term--abort)
+        (tramp-term--initialize hostname)
+        (run-hook-with-args 'tramp-term-after-initialized-hook hostname)
+        (message "tramp-term initialized")))))
+
+(defun ssh-deploy-file-is-in-path (file path)
+  "Return true if FILE is in the path PATH."
+  (not (null (string-match path file)))
+  )
+
+(defun ssh-deploy-diff (local-root remote-root path)
+  "Find differences relative to the roots LOCAL-ROOT with REMOTE-ROOT via ssh 
and the path PATH."
+  (let ((file-or-directory (file-regular-p path)))
+    (if (ssh-deploy-file-is-in-path path local-root)
+        (progn
+          (let ((remote-path (concat "/ssh:" remote-root 
(replace-regexp-in-string local-root "" path))))
+            (if file-or-directory
+                (progn
+                  (message "Comparing file '%s' to '%s'.." path remote-path)
+                  (ediff path remote-path))
+              (progn
+                (message "Comparing directory '%s' to '%s'.." path remote-path)
+                (ztree-diff path remote-path)))))
+      (if ssh-deploy-debug
+          (message "Path '%s' is not in the root '%s'" path local-root)))))
 
 (defun ssh-deploy-is-not-empty-string (string)
   "Return true if the STRING is not empty and not nil.  Expects string."
   (and (not (null string))
        (not (zerop (length string)))))
 
-(defun ssh-deploy (local-root-raw remote-root-raw upload-or-download)
-  "Upload/Download the path LOCAL-ROOT-RAW with REMOTE-ROOT-RAW via SSH 
according to UPLOAD-OR-DOWNLOAD."
-  (let ((filename (shell-quote-argument buffer-file-name))
-        (local-root (shell-quote-argument local-root-raw))
-        (remote-root (shell-quote-argument remote-root-raw)))
-    (let ((remote-path (concat remote-root (replace-regexp-in-string 
local-root "" filename))))
-      (if (string-match local-root filename)
+(defun ssh-deploy (local-root remote-root upload-or-download path)
+  "Upload/Download relative to the roots LOCAL-ROOT with REMOTE-ROOT via SSH 
according to UPLOAD-OR-DOWNLOAD and the path PATH."
+  (let ((file-or-directory (file-regular-p path)))
+    (let ((remote-path (concat remote-root (replace-regexp-in-string 
local-root "" path))))
+      (if (ssh-deploy-file-is-in-path path local-root)
           (progn
             (if (not (null upload-or-download))
                 (progn
-                  (message "Uploading file '%s' to '%s'.." filename 
remote-path)
-                  (let ((command (concat "scp " filename " " remote-path)))
-                    (message "Upload command: '%s'" command)
-                   (if (= (shell-command command) 0)
-                       (message "Successfully uploaded '%s' to '%s'" filename 
remote-path)
-                     (message "Failed to upload '%s' to '%s'" filename 
remote-path))))
+                  (message "Uploading path '%s' to '%s'.." path remote-path)
+                  (if file-or-directory
+                      (progn
+                        (let ((command (concat "scp " (shell-quote-argument 
path) " " (shell-quote-argument remote-path))))
+                          (message "Upload command: '%s'" command)
+                          (if (= (shell-command command) 0)
+                              (message "Successfully uploaded file '%s' to 
'%s'" path remote-path)
+                            (message "Failed to upload file '%s' to '%s'" path 
remote-path))))
+                    (progn
+                      (let ((command (concat "scp -r " (shell-quote-argument 
path) " " (shell-quote-argument (file-name-directory (directory-file-name 
remote-path))))))
+                        (message "Upload command: '%s'" command)
+                        (if (= (shell-command command) 0)
+                            (message "Successfully uploaded directory '%s' to 
'%s'" path (file-name-directory (directory-file-name remote-path)))
+                          (message "Failed to upload directory '%s' to '%s'" 
path (file-name-directory (directory-file-name remote-path))))))
+                    ))
               (progn
-               (message "Downloading file '%s' to '%s'.." remote-path filename)
-               (let ((command (concat "scp " remote-path " " filename)))
-                 (message "Upload command: '%s'" command)
-                 (if (= (shell-command command) 0)
-                     (message "Successfully downloaded '%s' to '%s'" 
remote-path filename)
-                   (message "Failed to download '%s' to '%s'" remote-path 
filename)
-                   )))))))))
+                (message "Downloading path '%s' to '%s'.." remote-path path)
+                (if file-or-directory
+                    (progn
+                      (message "Downloading file '%s' to '%s'.." remote-path 
path)
+                      (let ((command (concat "scp " (shell-quote-argument 
remote-path) " " (shell-quote-argument path))))
+                        (message "Download command: '%s'" command)
+                        (if (= (shell-command command) 0)
+                            (message "Successfully downloaded file '%s' to 
'%s'" remote-path path)
+                          (message "Failed to download file '%s' to '%s'" 
remote-path path))))
+                  (progn
+                    (message "Downloading directory '%s' to '%s'.." 
remote-path path)
+                    (let ((command (concat "scp -r " (shell-quote-argument 
remote-path) " " (shell-quote-argument (file-name-directory 
(directory-file-name path))))))
+                      (message "Download command: '%s'" command)
+                      (if (= (shell-command command) 0)
+                          (message "Successfully downloaded directory '%s' to 
'%s'" remote-path (file-name-directory (directory-file-name path)))
+                        (message "Failed to download directory '%s' to '%s'" 
remote-path (file-name-directory (directory-file-name path))))))
+                  ))))
+        (if ssh-deploy-debug
+            (message "Path '%s' is not in the root '%s'" path local-root))))))
 
 ;;;### autoload
 (defun ssh-deploy-upload-handler ()
-  "Upload current file if it is configured for SSH deployment."
-  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote) 
(ssh-deploy-is-not-empty-string buffer-file-name))
-      (ssh-deploy ssh-deploy-root-local ssh-deploy-root-remote t)
-    ))
+  "Upload current path to remote host if it is configured for SSH deployment."
+  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote))
+      (if (ssh-deploy-is-not-empty-string buffer-file-name)
+          (ssh-deploy ssh-deploy-root-local ssh-deploy-root-remote t 
buffer-file-name)
+        (if (ssh-deploy-is-not-empty-string default-directory)
+            (ssh-deploy ssh-deploy-root-local ssh-deploy-root-remote t 
(expand-file-name default-directory))))))
 
 ;;;### autoload
 (defun ssh-deploy-download-handler ()
-  "Download current file if it is configured for SSH deployment."
-  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote) 
(ssh-deploy-is-not-empty-string buffer-file-name))
-      (ssh-deploy ssh-deploy-root-local ssh-deploy-root-remote nil)
-    ))
+  "Download current path from remote host if it is configured for SSH 
deployment."
+  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote))
+      (if (ssh-deploy-is-not-empty-string buffer-file-name)
+          (ssh-deploy ssh-deploy-root-local ssh-deploy-root-remote nil 
buffer-file-name)
+        (if (ssh-deploy-is-not-empty-string default-directory)
+            (ssh-deploy ssh-deploy-root-local ssh-deploy-root-remote nil 
(expand-file-name default-directory))))))
 
 ;;;### autoload
 (defun ssh-deploy-diff-handler ()
-  "Compare current file with remote if it is configured for SSH deployment."
-  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote) 
(ssh-deploy-is-not-empty-string buffer-file-name))
-      (ssh-deploy-diff ssh-deploy-root-local ssh-deploy-root-remote)
-    ))
+  "Compare current path with remote host if it is configured for SSH 
deployment."
+  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote))
+      (if (ssh-deploy-is-not-empty-string buffer-file-name)
+          (ssh-deploy-diff ssh-deploy-root-local ssh-deploy-root-remote 
buffer-file-name)
+        (if (ssh-deploy-is-not-empty-string default-directory)
+            (ssh-deploy-diff ssh-deploy-root-local ssh-deploy-root-remote 
(expand-file-name default-directory))))))
+
+;;;### autoload
+(defun ssh-deploy-remote-terminal-handler ()
+  "Open remote host in tramp terminal it is configured for SSH deployment."
+  (if (ssh-deploy-is-not-empty-string ssh-deploy-root-remote)
+      (ssh-deploy-remote-terminal ssh-deploy-root-remote)))
+
+;;;### autoload
+(defun ssh-deploy-browse-remote-handler ()
+  "Open current relative path on remote host in `dired-mode' if it is 
configured for SSH deployment."
+  (if (and (ssh-deploy-is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy-is-not-empty-string ssh-deploy-root-remote) 
(ssh-deploy-is-not-empty-string default-directory))
+      (ssh-deploy-browse-remote ssh-deploy-root-local ssh-deploy-root-remote 
default-directory)))
 
 (provide 'ssh-deploy)
 ;;; ssh-deploy.el ends here