[elpa] externals/ssh-deploy b1f9e5b 050/173: Now detects remote changes

[Stefan Monnier]

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

    Now detects remote changes
---
 README.md     |   1 +
 ssh-deploy.el | 203 +++++++++++++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 174 insertions(+), 30 deletions(-)

diff --git a/README.md b/README.md
index fef0f0c..0f0b2ce 100644
--- a/README.md
+++ b/README.md
@@ -55,6 +55,7 @@ Set your user and group as owner and file permissions to 700. 
Emacs should now b
 (use-package ssh-deploy
   :config
   (add-hook 'after-save-hook (lambda() (if ssh-deploy-on-explicit-save 
(ssh-deploy-upload-handler)) ))
+  (add-hook 'find-file-hook (lambda() (if 
ssh-deploy-automatically-detect-remote-changes 
(ssh-deploy-remote-changes-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) ))
   (global-set-key (kbd "C-c C-z x") (lambda() 
(interactive)(ssh-deploy-diff-handler) ))
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 16ae266..c6aa242 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -1,10 +1,10 @@
-;;; `ssh-deploy.el --- Deployment via SSH, global or per directory.
+;;; `ssh-deploy.el --- Deployment via SSH or FTP, global or per directory.
 
 ;; Author: Christian Johansson <github.com/cjohansson>
 ;; Maintainer: Christian Johansson <github.com/cjohansson>
 ;; Created: 5 Jul 2016
-;; Modified: 20 Nov 2016
-;; Version: 1.42
+;; Modified: 30 Nov 2016
+;; Version: 1.43
 ;; Keywords: tools, convenience
 ;; URL: https://github.com/cjohansson/emacs-ssh-deploy
 
@@ -30,7 +30,7 @@
 ;;; Commentary:
 
 ;; `ssh-deploy' enables automatic deploys on explicit-save, manual uploads,
-;; downloads, differences, remote terminals (optional) and remote directory 
browsing via TRAMP.
+;; downloads, differences, remote terminals, detection of remote changes and 
remote directory browsing via TRAMP.
 ;; To do this it progressively uses `tramp', `tramp-term', `ediff', `async` 
and `ztree'.
 ;; By setting the variables (globally or per directory):
 ;; `ssh-deploy-root-local',`ssh-deploy-root-remote', 
`ssh-deploy-on-explicit-save'
@@ -46,17 +46,21 @@
 ;; - To setup a upload hook on save do this:
 ;;     (add-hook 'after-save-hook (lambda() (if ssh-deploy-on-explicit-save 
(ssh-deploy-upload-handler)) ))
 ;;
+;; - To setup automatic storing of base revisions and download of external 
changes do this:
+;;     (add-hook 'find-file-hook (lambda() (if 
ssh-deploy-automatically-detect-remote-changes 
(ssh-deploy-remote-changes-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) ))
 ;;     (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 r") (lambda() 
(interactive)(ssh-deploy-remote-changes-handler) ))
 ;;     (global-set-key (kbd "C-c C-z b") (lambda() 
(interactive)(ssh-deploy-browse-remote-handler) ))
 ;;
 ;; An illustrative example for `SSH' deployment, 
/Users/Chris/Web/Site1/.dir.locals.el
 ;; ((nil . (
 ;;   (ssh-deploy-root-local . "/Users/Chris/Web/Site1/")
-;;   (ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/site1/")
+;;   (ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/site1/")
 ;;   (ssh-deploy-on-explicity-save . t)
 ;; )))
 ;;
@@ -88,8 +92,8 @@
   :type 'string
   :group 'ssh-deploy)
 
-(defcustom ssh-deploy-on-explicit-save nil
-  "Boolean variable if deploy should be made on explicit save, nil by default."
+(defcustom ssh-deploy-on-explicit-save t
+  "Boolean variable if deploy should be made on explicit save, t by default."
   :type 'boolean
   :group 'ssh-deploy)
 
@@ -103,6 +107,21 @@
   :type 'boolean
   :group 'ssh-deploy)
 
+(defcustom ssh-deploy-revision-folder "~/.ssh-deploy-revisions/"
+  "String variable with path to revisions with trailing slash."
+  :type 'string
+  :group 'ssh-deploy)
+
+(defcustom ssh-deploy-automatically-detect-remote-changes t
+  "Detect remote changes and store base revisions automatically, t by default."
+  :type 'boolean
+  :group 'ssh-deploy)
+
+(defun ssh-deploy--get-revision-path (path)
+  "Generate revision-path for PATH."
+  (if (not (file-exists-p ssh-deploy-revision-folder))
+      (make-directory ssh-deploy-revision-folder))
+  (concat ssh-deploy-revision-folder (replace-regexp-in-string 
"\\(/\\|@\\|:\\)" "_" path)))
 
 (defun ssh-deploy--file-is-in-path (file path)
   "Return true if FILE is in the path PATH."
@@ -112,7 +131,6 @@
   "Return a string for the relative path based on ROOT and PATH."
   (replace-regexp-in-string root "" path))
 
-
 (defun ssh-deploy--parse-remote (string)
   "Return alist with connection attributes parsed from STRING."
   (let ((remote string))
@@ -153,13 +171,25 @@
               (file-or-directory (file-regular-p local)))
           (if file-or-directory
               (progn
-                (message "Uploading file '%s' to '%s' via tramp 
asynchrously.." local remote-path)
-                (async-start
-                 `(lambda()
-                    (copy-file ,local ,remote-path t t t t)
-                    ,local)
-                 (lambda(return-path)
-                   (message "Upload '%s' finished" return-path))))
+                (let ((revision-path (ssh-deploy--get-revision-path local)))
+                  (message "Uploading file '%s' to '%s' via tramp 
asynchronously.." local remote-path)
+                  (async-start
+                   `(lambda()
+                      (require 'ediff)
+                      (if (fboundp 'ediff-same-contents)
+                          (progn
+                            (if (or (not (file-exists-p ,remote-path)) (and 
(file-exists-p ,revision-path) (ediff-same-contents ,revision-path 
,remote-path)))
+                                (progn
+                                  (message "Uploading file '%s' to '%s' via 
tramp asynchronously.." ,local ,remote-path)
+                                  (copy-file ,local ,remote-path t t t t)
+                                  (copy-file ,local ,revision-path t t t t)
+                                  0)
+                              1))
+                        2))
+                   (lambda(return-message)
+                     (if (= return-message 0) (message "Upload completed.")
+                       (if (= return-message 1) (display-warning "ssh-deploy" 
"External file has changed, please download or diff." :warning)
+                         (if (= return-message 2) (display-warning 
"ssh-deploy" "Function ediff-same-contents is missing" :warning))))))))
             (progn
               (message "Uploading directory '%s' to '%s' via tramp 
asynchronously.." local remote-path)
               (if (string= remote-path (alist-get 'string remote))
@@ -185,9 +215,13 @@
         (file-or-directory (file-regular-p local)))
     (if file-or-directory
         (progn
-          (message "Uploading file '%s' to '%s' via tramp synchronously.." 
local remote-path)
-          (copy-file local remote-path t t t t)
-          (message "Upload '%s' finished" local))
+          (if (not (ssh-deploy--remote-has-changed local remote-path))
+              (progn
+                (message "Uploading file '%s' to '%s' via tramp 
synchronously.." local remote-path)
+                (copy-file local remote-path t t t t)
+                (message "Upload '%s' finished" local)
+                (ssh-deploy-store-revision local))
+            (display-warning "ssh-deploy" "Remote contents has changed or no 
base revision exists, please download or diff." :warning)))
       (progn
         (message "Uploading directory '%s' to '%s' via tramp synchronously.." 
local remote-path)
         (if (string= remote-path (alist-get 'string remote))
@@ -212,7 +246,8 @@
                     (copy-file ,remote-path ,local t t t t)
                     ,local)
                  (lambda(return-path)
-                   (message "Download '%s' finished" return-path))))
+                   (message "Download '%s' finished" return-path)
+                   (ssh-deploy-store-revision return-path))))
             (progn
               (message "Downloading directory '%s' to '%s' via tramp 
asynchronously.." remote-path local)
               (if (string= remote-path (alist-get 'string remote))
@@ -240,7 +275,8 @@
         (progn
           (message "Downloading file '%s' to '%s' via tramp synchronously.." 
remote-path local)
           (copy-file remote-path local t t t t)
-          (message "Download '%s' finished" local))
+          (message "Download '%s' finished" local)
+          (ssh-deploy-store-revision local))
       (progn
         (message "Downloading directory '%s' to '%s' via tramp 
synchronously.." remote-path local)
         (if (string= remote-path (alist-get 'string remote))
@@ -253,11 +289,30 @@
           )))))
 
 (defun ssh-deploy--upload (local remote local-root async)
-  "Upload LOCAL to REMOTE and LOCAL-ROOT via tramp, ASYNC determines if 
transfer should be asynchrous ot not."
+  "Upload LOCAL to REMOTE and LOCAL-ROOT via tramp, ASYNC determines if 
transfer should be asynchronously or not."
   (if (and async (fboundp 'async-start))
       (ssh-deploy--upload-via-tramp-async local remote local-root)
     (ssh-deploy--upload-via-tramp local remote local-root)))
 
+(defun ssh-deploy--remote-has-changed (local remote)
+  "Check if last stored revision of LOCAL exists or has changed on REMOTE 
synchronously."
+  (let ((revision-path (ssh-deploy--get-revision-path local)))
+    (if (file-exists-p remote)
+        (progn
+          (if (file-exists-p revision-path)
+              (progn
+                (require 'ediff)
+                (if (fboundp 'ediff-same-contents)
+                    (progn
+                      (if (not (ediff-same-contents revision-path remote))
+                          t
+                        nil))
+                  (progn
+                    (message "Function ediff-same-contents is missing.")
+                    nil)))
+            t))
+      nil)))
+
 ;;;### autoload
 (defun ssh-deploy (local-root remote-root upload-or-download path debug async)
   "Upload/Download file or directory relative to the roots LOCAL-ROOT with 
REMOTE-ROOT via ssh or ftp according to UPLOAD-OR-DOWNLOAD and the path PATH, 
DEBUG enables some feedback messages and ASYNC determines if transfers should 
be asynchrous or not."
@@ -287,9 +342,85 @@
                   (local-root (file-truename ssh-deploy-root-local)))
               (ssh-deploy local-root ssh-deploy-root-remote t local-path 
ssh-deploy-debug ssh-deploy-async))))))
 
+;; TODO Test this
+;;;### autoload
+(defun ssh-deploy-remote-changes-handler()
+  "Check if local revision exists or remote file has changed if path is 
configured for deployment"
+  (if (and (ssh-deploy--is-not-empty-string ssh-deploy-root-local)
+           (ssh-deploy--is-not-empty-string ssh-deploy-root-remote))
+      (if (and (ssh-deploy--is-not-empty-string buffer-file-name))
+          (let ((local-root (file-truename ssh-deploy-root-local))
+                (remote-root (file-truename ssh-deploy-root-remote))
+                (path (file-truename buffer-file-name)))
+            (if (ssh-deploy--file-is-in-path path local-root)
+                (progn
+                  (let ((revision-path (ssh-deploy--get-revision-path path))
+                        (remote-path (concat remote-root 
(ssh-deploy--get-relative-path local-root path))))
+                    (if (file-regular-p path)
+                        (progn
+                          (if (file-exists-p revision-path)
+                              (progn
+                                (if (fboundp 'async-start)
+                                    (progn
+                                      (async-start
+                                       `(lambda()
+                                          (require 'ediff)
+                                          (if (fboundp 'ediff-same-contents)
+                                              (progn
+                                                (if (ediff-same-contents 
,revision-path ,remote-path)
+                                                    0
+                                                  1))
+                                            2))
+                                       (lambda(return-message)
+                                         (if (= return-message 0) (message 
"Remote file has not changed.")
+                                           (if (= return-message 1) 
(display-warning "ssh-deploy" "External file has changed, please download or 
diff." :warning)
+                                             (if (= return-message 2) 
(display-warning "ssh-deploy" "Function ediff-same-contents is missing" 
:warning)))))))
+                                  (progn
+                                    (require 'ediff)
+                                    (if (fboundp 'ediff-same-contents)
+                                        (progn
+                                          (if (ediff-same-contents 
revision-path remote-path)
+                                              (message "Remote file has not 
changed.")
+                                            (display-warning "ssh-deploy" 
"External file has changed, please download or diff." :warning)))
+                                      (display-warning "ssh-deploy" "Function 
ediff-same-contents is missing" :warning)))))
+                            (progn
+                              (if (fboundp 'async-start)
+                                  (progn
+                                    (async-start
+                                     `(lambda()
+                                        (if (file-exists-p ,remote-path)
+                                            (progn
+                                              (require 'ediff)
+                                              (if (fboundp 
'ediff-same-contents)
+                                                  (progn
+                                                    (if (ediff-same-contents 
,path ,remote-path)
+                                                        (progn
+                                                          (copy-file ,path 
,revision-path t t t t)
+                                                          (message "Remote 
file has not changed, created base revision."))
+                                                      (display-warning 
"ssh-deploy" "External file has changed, please download or diff." :warning)))
+                                                (display-warning "ssh-deploy" 
"Function ediff-same-contents is missing" :warning)))
+                                          (progn
+                                            (message "Remote file doesn't 
exist"))))
+                                     (lambda(return-message)
+                                       (message return-message))))
+                                (progn
+                                  (if (file-exists-p remote-path)
+                                      (progn
+                                        (require 'ediff)
+                                        (if (fboundp 'ediff-same-contents)
+                                            (progn
+                                              (if (ediff-same-contents path 
remote-path)
+                                                  (progn
+                                                    (copy-file path 
revision-path t t t t)
+                                                    (message "Remote file has 
not changed, created base revision."))
+                                                (display-warning "ssh-deploy" 
"External file has changed, please download or diff." :warning)))
+                                          (display-warning "ssh-deploy" 
"Function ediff-same-contents is missing" :warning)))
+                                    (progn
+                                      (message "Remote file doesn't 
exist"))))))))))))))))
+
 ;;;### autoload
 (defun ssh-deploy-download-handler ()
-  "Download current path from remote host if it is configured for SSH 
deployment."
+  "Download current path from remote host if it is configured for deployment."
   (if (and (ssh-deploy--is-not-empty-string ssh-deploy-root-local)
            (ssh-deploy--is-not-empty-string ssh-deploy-root-remote))
       (if (and (ssh-deploy--is-not-empty-string buffer-file-name)
@@ -305,7 +436,7 @@
 
 ;;;### autoload
 (defun ssh-deploy-diff-handler ()
-  "Compare current path with remote host if it is configured for SSH 
deployment."
+  "Compare current path with remote host if it is configured for deployment."
   (if (and (ssh-deploy--is-not-empty-string ssh-deploy-root-local) 
(ssh-deploy--is-not-empty-string ssh-deploy-root-remote))
       (if (and (ssh-deploy--is-not-empty-string buffer-file-name)
                (file-exists-p buffer-file-name))
@@ -320,13 +451,13 @@
 
 ;;;### autoload
 (defun ssh-deploy-remote-terminal-handler ()
-  "Open remote host in tramp terminal it is configured for SSH deployment."
+  "Open remote host in tramp terminal it is configured for 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."
+  "Open current relative path on remote host in `dired-mode' if it is 
configured for 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))
@@ -336,7 +467,7 @@
 
 ;;;### autoload
 (defun ssh-deploy-diff (local-root remote-root-string path &optional debug)
-  "Find differences relative to the roots LOCAL-ROOT with REMOTE-ROOT-STRING 
via ssh and the path PATH, DEBUG enables feedback message."
+  "Find differences relative to the roots LOCAL-ROOT with REMOTE-ROOT-STRING 
and the path PATH, DEBUG enables feedback message."
   (let ((file-or-directory (file-regular-p path)))
     (if (ssh-deploy--file-is-in-path path local-root)
         (progn
@@ -345,15 +476,20 @@
               (let ((command (concat "/" (alist-get 'protocol remote) ":" 
(alist-get 'username remote) "@" (alist-get 'server remote) ":" (alist-get 
'path remote))))
                 (if file-or-directory
                     (progn
-                      (message "Comparing file '%s' to '%s'.." path command)
-                      (ediff path command))
+                      (require 'ediff)
+                      (if (fboundp 'ediff-same-contents)
+                          (progn
+                            (message "Comparing file '%s' to '%s'.." path 
command)
+                            (if (ediff-same-contents path command)
+                                (message "Files have identical contents.")
+                              (ediff path command)))
+                        (message "Function ediff-same-contents is missing.")))
                   (progn
                     (if (fboundp 'ztree-diff)
                         (progn
                           (message "Comparing directory '%s' to '%s'.." path 
command)
                           (ztree-diff path command))
-                      (message "ztree-diff is not installed.")
-                      )))))))
+                      (message "ztree-diff is not installed."))))))))
       (if debug
           (message "Path '%s' is not in the root '%s'" path local-root)))))
 
@@ -386,5 +522,12 @@
           (message "tramp-term is not installed."))
       (message "Remote terminal is only available for ssh protocol"))))
 
+;;;### autoload
+(defun ssh-deploy-store-revision (path)
+  "Store PATH in revision-folder."
+  (let ((revision-path (ssh-deploy--get-revision-path path)))
+    (message "Storing revision of '%s' at '%s'.." path revision-path)
+    (copy-file path (ssh-deploy--get-revision-path path) t t t t)))
+
 (provide 'ssh-deploy)
 ;;; ssh-deploy.el ends here