[elpa] externals/ssh-deploy 1d3d534 161/173: Added verbose flag to enable silencing of non-error messages

[Stefan Monnier]

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

    Added verbose flag to enable silencing of non-error messages
---
 README.md     |  2 +-
 ssh-deploy.el | 78 +++++++++++++++++++++++++++++------------------------------
 2 files changed, 40 insertions(+), 40 deletions(-)

diff --git a/README.md b/README.md
index 607995c..354b3bd 100644
--- a/README.md
+++ b/README.md
@@ -39,7 +39,7 @@ Here is a list of other variables you can set globally or per 
directory:
 * `ssh-deploy-remote-sql-server` Default server when connecting to remote SQL 
database *(string)*
 * `ssh-deploy-remote-sql-user` Default user when connecting to remote SQL 
database *(string)*
 * `ssh-deploy-remote-shell-executable` Default remote shell executable when 
launching shell on remote host *(string)*
-
+* `ssh-deploy-verbose` Show messages in message buffer when starting and 
ending actions, default t *(boolean)*
 
 ## Deployment configuration examples
 
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 3bac382..8635801 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: 8 July 2018
-;; Version: 1.94
+;; Modified: 31 July 2018
+;; Version: 1.95
 ;; Keywords: tools, convenience
 ;; URL: https://github.com/cjohansson/emacs-ssh-deploy
 
@@ -152,6 +152,7 @@
 ;; * `ssh-deploy-remote-sql-server' - Default server when connecting to remote 
SQL database *(string)*
 ;; * `ssh-deploy-remote-sql-user' - Default user when connecting to remote SQL 
database *(string)*
 ;; * `ssh-deploy-remote-shell-executable' - Default shell executable when 
launching shell on remote host
+;; * `ssh-deploy-verbose' - Show messages in message buffer when starting and 
ending actions, default t *(boolean)*
 ;;
 ;; Please see README.md from the same repository for extended documentation.
 
@@ -193,6 +194,13 @@
 (put 'ssh-deploy-debug 'permanent-local t)
 (put 'ssh-deploy-debug 'safe-local-variable 'booleanp)
 
+(defcustom ssh-deploy-verbose t
+  "Boolean variable if debug messages should be shown, t by default."
+  :type 'boolean
+  :group 'ssh-deploy)
+(put 'ssh-deploy-verbose 'permanent-local t)
+(put 'ssh-deploy-verbose 'safe-local-variable 'booleanp)
+
 (defcustom ssh-deploy-async t
   "Boolean variable if asynchrous method for transfers should be used, t by 
default."
   :type 'boolean
@@ -404,7 +412,7 @@
         (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)))
-              (message "Uploading file '%s' to '%s'.. (asynchronously)" 
path-local path-remote)
+              (when ssh-deploy-verbose (message "Uploading file '%s' to '%s'.. 
(asynchronously)" path-local path-remote))
               (async-start
                `(lambda()
                   (require 'ediff-util)
@@ -421,18 +429,18 @@
                (lambda(return)
                  (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
                  (if (= (nth 0 return) 0)
-                     (message (nth 1 return))
+                     (when ssh-deploy-verbose (message (nth 1 return)))
                    (display-warning 'ssh-deploy (nth 1 return) :warning)))))
           (progn
-            (message "Uploading directory '%s' to '%s'.. (asynchronously)" 
path-local path-remote)
+            (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)
-               (message "Completed upload of directory '%s'. (asynchronously)" 
return-path))))))
-    (message "async.el is not installed")))
+               (when ssh-deploy-verbose (message "Completed upload of 
directory '%s'. (asynchronously)" return-path)))))))
+    (display-warning 'ssh-deploy "async.el is not installed" :warning)))
 
 (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."
@@ -447,27 +455,27 @@
                       (not (file-exists-p path-remote))
                       (and (file-exists-p revision-path) 
(ediff-same-file-contents revision-path path-remote)))
                   (progn
-                    (message "Uploading file '%s' to '%s'.. (synchronously)" 
path-local path-remote)
+                    (when ssh-deploy-verbose (message "Uploading file '%s' to 
'%s'.. (synchronously)" path-local path-remote))
                     (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)
                     (ssh-deploy-store-revision path-local revision-folder)
-                    (message "Completed upload of '%s'. (synchronously)" 
path-local))
+                    (when ssh-deploy-verbose (message "Completed upload of 
'%s'. (synchronously)" path-local)))
                 (display-warning 'ssh-deploy (format "Remote file '%s' has 
changed, please download or diff. (synchronously)" path-remote) :warning))
             (display-warning 'ssh-deploy "Function 'ediff-same-file-contents' 
is missing." :warning))
           (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle))
       (progn
-        (message "Uploading directory '%s' to '%s'.. (synchronously)" 
path-local path-remote)
+        (when ssh-deploy-verbose (message "Uploading directory '%s' to '%s'.. 
(synchronously)" path-local path-remote))
         (copy-directory path-local path-remote t t t)
         (ssh-deploy--mode-line-set-status-and-update ssh-deploy--status-idle)
-        (message "Completed upload of '%s'. (synchronously)" path-local)))))
+        (when ssh-deploy-verbose (message "Completed upload of '%s'. 
(synchronously)" path-local))))))
 
 (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)
-        (message "Downloading '%s' to '%s'.. (asynchronously)" path-remote 
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))))
@@ -481,7 +489,7 @@
               ,path-local))
          (lambda(return-path)
            (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle return-path)
-           (message "Completed download of '%s'. (asynchronously)" 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
@@ -494,13 +502,13 @@
     (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-downloading)
     (if file-or-directory
         (progn
-          (message "Downloading file '%s' to '%s'.. (synchronously)" 
path-remote path-local)
+          (when ssh-deploy-verbose (message "Downloading file '%s' to '%s'.. 
(synchronously)" path-remote path-local))
           (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)
           (ssh-deploy-store-revision path-local revision-folder)
           (ssh-deploy--mode-line-set-status-and-update ssh-deploy--status-idle)
-          (message "Completed download of file '%s'. (synchronously)" 
path-local))
+          (when ssh-deploy-verbose (message "Completed download of file '%s'. 
(synchronously)" path-local)))
       (progn
         (message "Downloading directory '%s' to '%s'.. (synchronously)" 
path-remote path-local)
         (copy-directory path-remote path-local t t t)
@@ -775,7 +783,7 @@
                              (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
 
                              (if (= (nth 0 return) 0)
-                                 (message (nth 1 return))
+                                 (when ssh-deploy-verbose (message (nth 1 
return)))
                                (display-warning 'ssh-deploy (nth 1 return) 
:warning)))))
 
                       ;; Async.el is not installed - synchronous logic here
@@ -790,10 +798,10 @@
                               (require 'ediff-util)
                               (if (fboundp 'ediff-same-file-contents)
                                   (if (ediff-same-file-contents revision-path 
path-remote)
-                                      (message "Remote file '%s' has not 
changed. (synchronously)" path-remote)
+                                      (when ssh-deploy-verbose (message 
"Remote file '%s' has not changed. (synchronously)" path-remote))
                                     (display-warning 'ssh-deploy (format 
"Remote file '%s' has changed, please download or diff. (synchronously)" 
path-remote) :warning))
                                 (display-warning 'ssh-deploy "Function 
'ediff-same-file-contents' is missing. (synchronously)" :warning)))
-                          (message "Remote file '%s' doesn't exist. 
(synchronously)" path-remote))
+                          (when ssh-deploy-verbose (message "Remote file '%s' 
doesn't exist. (synchronously)" path-remote)))
 
                         ;; Update buffer status to idle
                         (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle)))
@@ -829,7 +837,7 @@
                            (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
 
                            (if (= (nth 0 return) 0)
-                               (message (nth 1 return))
+                               (when ssh-deploy-verbose (message (nth 1 
return)))
                              (display-warning 'ssh-deploy (nth 1 return) 
:warning)))))
 
                     ;; Async.el is not installed - synchronous logic here
@@ -846,21 +854,19 @@
                                 (if (ediff-same-file-contents path-local 
path-remote)
                                     (progn
                                       (copy-file path-local revision-path t t 
t t)
-                                      (message "Remote file '%s' has not 
changed, created base revision. (synchronously)" path-remote))
+                                      (when ssh-deploy-verbose (message 
"Remote file '%s' has not changed, created base revision. (synchronously)" 
path-remote)))
                                   (display-warning 'ssh-deploy (format "Remote 
file '%s' has changed, please download or diff. (synchronously)" path-remote) 
:warning))
                               (display-warning 'ssh-deploy "Function 
'ediff-same-file-contents' is missing. (synchronously)" :warning)))
-                        (message "Remote file '%s' does not exist. 
(synchronously)" path-remote))
+                        (when ssh-deploy-verbose (message "Remote file '%s' 
does not exist. (synchronously)" path-remote)))
 
                       ;; Update buffer status to idle
                       (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle)))))
 
             ;; File is a directory
-            (when ssh-deploy-debug
-              (message "File %s is a directory, ignoring remote changes 
check." path-local))))
+            (when ssh-deploy-debug (message "File %s is a directory, ignoring 
remote changes check." path-local))))
 
       ;; File is not inside root or is excluded from it
-      (when ssh-deploy-debug
-        (message "File %s is not in root or is excluded from it." 
path-local)))))
+      (when ssh-deploy-debug (message "File %s is not in root or is excluded 
from it." path-local)))))
 
 (defun ssh-deploy-delete (path &optional async debug buffer)
   "Delete PATH and use flags ASYNC and DEBUG, set status in BUFFER."
@@ -918,8 +924,7 @@
               (path-remote (concat root-remote (ssh-deploy--get-relative-path 
root-local path-local))))
           (ssh-deploy-delete path-local async debug path-local)
           (ssh-deploy-delete path-remote async debug path-local))
-      (if debug
-          (message "Path '%s' is not in the root '%s' or is excluded from it." 
path-local root-local)))))
+      (when debug (message "Path '%s' is not in the root '%s' or is excluded 
from it." path-local root-local)))))
 
 ;;;### autoload
 (defun ssh-deploy-rename (old-path-local new-path-local &optional root-local 
root-remote async debug exclude-list)
@@ -1037,7 +1042,7 @@
   (if (not (file-directory-p path))
       (let* ((root (or root ssh-deploy-revision-folder))
              (revision-path (ssh-deploy--get-revision-path path root)))
-        (message "Storing revision of '%s' at '%s'.." path revision-path)
+        (when ssh-deploy-verbose (message "Storing revision of '%s' at '%s'.." 
path revision-path))
         (copy-file path revision-path t t t t))))
 
 ;;;### autoload
@@ -1056,8 +1061,7 @@
         (if file-or-directory
             (ssh-deploy-diff-files path-local path-remote)
           (ssh-deploy-diff-directories path-local path-remote exclude-list 
async))
-      (if debug
-          (message "Path '%s' is not in the root '%s' or is excluded from it." 
path-local root-local)))))
+      (when debug (message "Path '%s' is not in the root '%s' or is excluded 
from it." path-local root-local)))))
 
 ;;;### autoload
 (defun ssh-deploy-upload (path-local path-remote &optional force async 
revision-folder)
@@ -1109,8 +1113,7 @@
                  (ssh-deploy--file-is-included path-local 
ssh-deploy-exclude-list))
             (let ((path-remote (concat ssh-deploy-root-remote 
(ssh-deploy--get-relative-path root-local path-local))))
               (ssh-deploy-upload path-local path-remote force ssh-deploy-async 
ssh-deploy-revision-folder))
-          (if ssh-deploy-debug
-              (message "Ignoring upload, path '%s' is empty, not in the root 
'%s' or is excluded from it." path-local root-local))))))
+          (when ssh-deploy-debug (message "Ignoring upload, path '%s' is 
empty, not in the root '%s' or is excluded from it." path-local root-local))))))
 
 ;;;### autoload
 (defun ssh-deploy-upload-handler-forced ()
@@ -1126,11 +1129,9 @@
            (ssh-deploy--is-not-empty-string ssh-deploy-root-remote)
            (ssh-deploy--is-not-empty-string buffer-file-name))
       (progn
-        (when ssh-deploy-debug
-          (message "Detecting remote-changes.."))
+        (when ssh-deploy-debug (message "Detecting remote-changes.."))
         (ssh-deploy-remote-changes (file-truename buffer-file-name) 
(file-truename ssh-deploy-root-local) ssh-deploy-root-remote ssh-deploy-async 
ssh-deploy-revision-folder ssh-deploy-exclude-list))
-    (when ssh-deploy-debug
-      (message "Ignoring remote-changes check since a root is empty or the 
current buffer lacks a file-name."))))
+    (when ssh-deploy-debug (message "Ignoring remote-changes check since a 
root is empty or the current buffer lacks a file-name."))))
 
 ;;;### autoload
 (defun ssh-deploy-remote-sql-mysql-handler()
@@ -1155,7 +1156,7 @@
       (let* ((root-local (file-truename ssh-deploy-root-local))
              (path-local (file-truename buffer-file-name))
              (path-remote (concat ssh-deploy-root-remote 
(ssh-deploy--get-relative-path root-local path-local))))
-        (message "Opening file on remote '%s'" path-remote)
+        (when ssh-deploy-verbose (message "Opening file on remote '%s'" 
path-remote))
         (find-file path-remote))))
 
 ;;;### autoload
@@ -1177,8 +1178,7 @@
                  (ssh-deploy--file-is-included path-local 
ssh-deploy-exclude-list))
             (let ((path-remote (concat ssh-deploy-root-remote 
(ssh-deploy--get-relative-path root-local path-local))))
               (ssh-deploy-download path-remote path-local ssh-deploy-async 
ssh-deploy-revision-folder))
-          (if ssh-deploy-debug
-              (message "Ignoring upload, path '%s' is empty, not in the root 
'%s' or is excluded from it." path-local root-local))))))
+          (when ssh-deploy-debug (message "Ignoring upload, path '%s' is 
empty, not in the root '%s' or is excluded from it." path-local root-local))))))
 
 ;;;### autoload
 (defun ssh-deploy-diff-handler ()