branch: externals/ssh-deploy
commit 1d3d53497003415f254bccee2c65fec6cf82e5f5
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
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 ()
