branch: externals/ssh-deploy
commit 5e191c65ad569d76690d8e48ed459461fe032484
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Added major mode for interactive directory differences
---
ssh-deploy-diff-mode.el | 274 ++++++++++++++++++++++++++++++++++++++++++++++++
ssh-deploy.el | 238 +++++++++++++++++++++++------------------
2 files changed, 409 insertions(+), 103 deletions(-)
diff --git a/ssh-deploy-diff-mode.el b/ssh-deploy-diff-mode.el
new file mode 100644
index 0000000..740a252
--- /dev/null
+++ b/ssh-deploy-diff-mode.el
@@ -0,0 +1,274 @@
+;;; ssh-deploy-diff-mode.el --- Mode for interactive directory differences
+
+;; Author: Christian Johansson <github.com/cjohansson>
+;; Maintainer: Christian Johansson <github.com/cjohansson>
+;; Created: 1 Feb 2018
+;; Modified: 14 Feb 2018
+;; Version: 1.0
+;; URL: https://github.com/cjohansson/emacs-ssh-deploy
+
+;; Package-Requires: ((emacs "24") (ssh-deploy "1.74"))
+
+;; Copyright (C) 2017 Christian Johansson
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Spathoftware Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Please see README.md from the same repository for extended documentation.
+
+;;; Code:
+
+
+(defvar ssh-deploy-diff-mode nil)
+
+(defconst ssh-deploy-diff-mode--section-directory-a 0 "Section for directory
a.")
+(defconst ssh-deploy-diff-mode--section-directory-b 1 "Section for directory
b.")
+(defconst ssh-deploy-diff-mode--section-exclude-list 2 "Section for
exclude-list.")
+(defconst ssh-deploy-diff-mode--section-only-in-a 3 "Section for only in a.")
+(defconst ssh-deploy-diff-mode--section-only-in-b 4 "Section for only in b.")
+(defconst ssh-deploy-diff-mode--section-in-both 5 "Section for in both.")
+
+(defconst ssh-deploy-diff-mode--action-copy 0 "Action for copy.")
+(defconst ssh-deploy-diff-mode--action-copy-a 1 "Action for copy A.")
+(defconst ssh-deploy-diff-mode--action-copy-b 2 "Action for copy B.")
+(defconst ssh-deploy-diff-mode--action-delete 3 "Action for delete.")
+(defconst ssh-deploy-diff-mode--action-difference 4 "Action for difference.")
+(defconst ssh-deploy-diff-mode--action-refresh 5 "Action for refreshing
differences.")
+
+(defconst ssh-deploy-diff-mode--keywords
+ (list
+ "DIRECTORY A"
+ "DIRECTORY B"
+ "EXCLUDE-LIST"
+ "FILES ONLY IN A"
+ "FILES ONLY IN B"
+ "FILES IN BOTH BUT DIFFERS"
+ "HELP"
+ )
+ "Use list of keywords to build regular expression for syntax highlighting.")
+
+(let ((regex (concat "\\<" (regexp-opt ssh-deploy-diff-mode--keywords t)
"\\>")))
+ (defconst ssh-deploy-diff-mode--font-lock-keywords
+ (list
+ `(,regex . font-lock-builtin-face)
+ '("\\('\\w*'\\)" . font-lock-variable-name-face))
+ "Minimal highlighting expressions for SSH Deploy Diff major mode."))
+
+(defvar ssh-deploy-diff-mode--map
+ (let ((map (make-keymap)))
+ (define-key map "q" 'quit-window)
+ (define-key map "c" 'ssh-deploy-diff-mode-copy-handler)
+ (define-key map "a" 'ssh-deploy-diff-mode-copy-a-handler)
+ (define-key map "b" 'ssh-deploy-diff-mode-copy-b-handler)
+ (define-key map "d" 'ssh-deploy-diff-mode-delete-handler)
+ (define-key map "\t" 'ssh-deploy-diff-mode-difference-handler)
+ (define-key map "g" 'ssh-deploy-diff-mode-refresh-handler)
+ map)
+ "Key-map for SSH Deploy Diff major mode.")
+
+(defun ssh-deploy-diff-mode-copy-handler() "Start the copy action."
(interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-copy))
+(defun ssh-deploy-diff-mode-copy-a-handler() "Start the copy A action."
(interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-copy-a))
+(defun ssh-deploy-diff-mode-copy-b-handler() "Start the copy B action."
(interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-copy-b))
+(defun ssh-deploy-diff-mode-delete-handler() "Start the delete action."
(interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-delete))
+(defun ssh-deploy-diff-mode-difference-handler() "Start the difference
action." (interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-difference))
+(defun ssh-deploy-diff-mode-refresh-handler() "Start the refresh action."
(interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-refresh))
+
+(defun ssh-deploy-diff-mode--get-parts ()
+ "Return current file and section if any."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (let ((file nil))
+ (if (looking-at "^- ")
+ (let* ((start (+ 2 (line-beginning-position)))
+ (end (line-end-position)))
+ (setq file (buffer-substring-no-properties start end))))
+ (while (and (> (line-number-at-pos) 0)
+ (not (looking-at "^[A-Z]+")))
+ (forward-line -1))
+ (if (looking-at "^[A-Z]")
+ (let* ((start (line-beginning-position))
+ (end (line-end-position))
+ (section (buffer-substring-no-properties start end)))
+ (setq section (replace-regexp-in-string ": ([0-9]+)$" "" section))
+ (cond ((string= section "DIRECTORY A") (setq section
ssh-deploy-diff-mode--section-directory-a))
+ ((string= section "DIRECTORY B") (setq section
ssh-deploy-diff-mode--section-directory-b))
+ ((string= section "EXCLUDE-LIST") (setq section
ssh-deploy-diff-mode--section-exclude-list))
+ ((string= section "FILES ONLY IN A") (setq section
ssh-deploy-diff-mode--section-only-in-a))
+ ((string= section "FILES ONLY IN B") (setq section
ssh-deploy-diff-mode--section-only-in-b))
+ ((string= section "FILES IN BOTH BUT DIFFERS") (setq section
ssh-deploy-diff-mode--section-in-both))
+ (t (message "Could not find section %s" section)))
+
+ (while (and (> (line-number-at-pos) 0)
+ (not (looking-at "^DIRECTORY B:")))
+ (forward-line -1))
+ (if (looking-at "^DIRECTORY B:")
+ (let* ((start (line-beginning-position))
+ (end (line-end-position))
+ (directory-b (buffer-substring-no-properties start
end)))
+ (setq directory-b (replace-regexp-in-string "DIRECTORY B: "
"" directory-b))
+
+ (while (and (> (line-number-at-pos) 0)
+ (not (looking-at "^DIRECTORY A:")))
+ (forward-line -1))
+ (if (looking-at "^DIRECTORY A:")
+ (let* ((start (line-beginning-position))
+ (end (line-end-position))
+ (directory-a (buffer-substring-no-properties
start end)))
+ (setq directory-a (replace-regexp-in-string "DIRECTORY
A: " "" directory-a))
+ (list file section directory-a directory-b))))))))))
+
+(defun ssh-deploy-diff-mode--action-handler (action)
+ "Route valid ACTION to their functions."
+ (interactive)
+ (let ((parts (ssh-deploy-diff-mode--get-parts)))
+ (if (not (eq parts nil))
+ (progn
+ ;; (message "Parts %s %s" action parts)
+ (cond ((and (not (null (nth 0 parts))) (= action
ssh-deploy-diff-mode--action-copy)) (ssh-deploy-diff-mode--copy parts))
+ ((and (not (null (nth 0 parts))) (= action
ssh-deploy-diff-mode--action-copy-a)) (ssh-deploy-diff-mode--copy-a parts))
+ ((and (not (null (nth 0 parts))) (= action
ssh-deploy-diff-mode--action-copy-b)) (ssh-deploy-diff-mode--copy-b parts))
+ ((and (not (null (nth 0 parts))) (= action
ssh-deploy-diff-mode--action-delete)) (ssh-deploy-diff-mode--delete parts))
+ ((and (not (null (nth 0 parts))) (= action
ssh-deploy-diff-mode--action-difference)) (ssh-deploy-diff-mode--difference
parts))
+ ((= action ssh-deploy-diff-mode--action-refresh)
(ssh-deploy-diff-mode--refresh parts))
+ (t (message "Found no function for %s" action))))
+ (message "Found nothing to do"))))
+
+(defun ssh-deploy-diff-mode--refresh (parts)
+ "Refresh current difference query based on PARTS."
+ (interactive)
+ (require 'ssh-deploy)
+ (if (and (boundp 'ssh-deploy-root-local)
+ (boundp 'ssh-deploy-root-remote)
+ (fboundp 'ssh-deploy-diff-directories))
+ (let ((root-local (nth 2 parts))
+ (root-remote (nth 3 parts)))
+ (progn
+ (kill-this-buffer)
+ (ssh-deploy-diff-directories root-local root-remote)))))
+
+(defun ssh-deploy-diff-mode--copy (parts)
+ "Perform an upload or download depending on section in PARTS."
+ (require 'ssh-deploy)
+ (let* ((file-name (nth 0 parts))
+ (root-local (nth 2 parts))
+ (root-remote (nth 3 parts))
+ (path-local (concat root-local file-name))
+ (path-remote (concat root-remote file-name))
+ (section (nth 1 parts)))
+ (let* ((path-local (file-truename path-local))
+ (root-local (file-truename root-local)))
+ (if (and (fboundp 'ssh-deploy-download)
+ (fboundp 'ssh-deploy-upload))
+ (cond ((= section ssh-deploy-diff-mode--section-only-in-a)
+ (ssh-deploy-upload path-local path-remote))
+ ((= section ssh-deploy-diff-mode--section-only-in-b)
+ (ssh-deploy-download path-remote path-local))
+ (t (message "Copy is not available in this section")))
+ (display-warning "ssh-deploy" "Function ssh-deploy-download or
ssh-deploy-upload is missing" :warning)))))
+
+(defun ssh-deploy-diff-mode--copy-a (parts)
+ "Perform a upload of local-path to remote-path based on PARTS from section A
or section BOTH."
+ (require 'ssh-deploy)
+ (let* ((section (nth 1 parts))
+ (file-name (nth 0 parts))
+ (root-local (nth 2 parts))
+ (root-remote (nth 3 parts))
+ (path-local (concat root-local file-name))
+ (path-remote (concat root-remote file-name)))
+ (let* ((path-local (file-truename path-local))
+ (root-local (file-truename root-local)))
+ (if (fboundp 'ssh-deploy-upload)
+ (cond ((or (= section ssh-deploy-diff-mode--section-only-in-a)
+ (= section ssh-deploy-diff-mode--section-in-both))
+ (ssh-deploy-upload path-local path-remote))
+ (t "Copy A is not available in this section"))
+ (display-warning "ssh-deploy" "Function ssh-deploy-upload is missing"
:warning)))))
+
+(defun ssh-deploy-diff-mode--copy-b (parts)
+ "Perform an download of remote-path to local-path based on PARTS from
section B or section BOTH."
+ (require 'ssh-deploy)
+ (let* ((section (nth 1 parts))
+ (file-name (nth 0 parts))
+ (root-local (nth 2 parts))
+ (root-remote (nth 3 parts))
+ (path-local (concat root-local file-name))
+ (path-remote (concat root-remote file-name)))
+ (let* ((path-local (file-truename path-local))
+ (root-local (file-truename root-local)))
+ (if (fboundp 'ssh-deploy-download)
+ (cond ((or (= section ssh-deploy-diff-mode--section-only-in-b)
+ (= section ssh-deploy-diff-mode--section-in-both))
+ (ssh-deploy-download path-remote path-local))
+ (t "Copy B is not available in this section"))
+ (display-warning "ssh-deploy" "Function ssh-deploy-download is
missing" :warning)))))
+
+(defun ssh-deploy-diff-mode--delete (parts)
+ "Delete path in both, only in a or only in b based on PARTS from section A,
B or BOTH."
+ (require 'ssh-deploy)
+ (let* ((section (nth 1 parts))
+ (file-name (nth 0 parts))
+ (root-local (nth 2 parts))
+ (root-remote (nth 3 parts))
+ (path-local (concat root-local file-name))
+ (path-remote (concat root-remote file-name)))
+ (let* ((path-local (file-truename path-local))
+ (root-local (file-truename root-local)))
+ (if (fboundp 'ssh-deploy-delete)
+ (cond ((= section ssh-deploy-diff-mode--section-in-both)
+ (let ((yes-no-prompt (read-string (format "Type 'yes' to
confirm that you want to delete the file '%s': " file-name))))
+ (if (string= yes-no-prompt "yes")
+ (ssh-deploy-delete path-local root-local root-remote))))
+ ((= section ssh-deploy-diff-mode--section-only-in-a)
(ssh-deploy-delete path-local))
+ ((= section ssh-deploy-diff-mode--section-only-in-b)
(ssh-deploy-delete path-remote))
+ ((= section ssh-deploy-diff-mode--section-in-both)
(ssh-deploy-delete path-local root-local root-remote))
+ (t (message "Delete is not available in this section")))
+ (display-warning "ssh-deploy" "Function ssh-deploy-delete is missing"
:warning)))))
+
+(defun ssh-deploy-diff-mode--difference (parts)
+ "If file exists in both start a difference session based on PARTS."
+ (require 'ssh-deploy)
+ (let ((section (nth 1 parts)))
+ (if (= section ssh-deploy-diff-mode--section-in-both)
+ (if (fboundp 'ssh-deploy-diff-files)
+ (let* ((file-name (nth 0 parts))
+ (root-local (nth 2 parts))
+ (root-remote (nth 3 parts))
+ (path-local (concat root-local file-name))
+ (path-remote (concat root-remote file-name)))
+ (let* ((path-local (file-truename path-local))
+ (root-local (file-truename root-local)))
+ (ssh-deploy-diff-files path-local path-remote)))
+ (display-warning "ssh-deploy" "Function ssh-deploy-diff-files is
missing" :warning))
+ (message "File must exists in both roots to perform a difference
action."))))
+
+(defun ssh-deploy-diff-mode ()
+ "Major mode for SSH Deploy interactive directory differences."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map ssh-deploy-diff-mode--map)
+ (set (make-local-variable 'font-lock-defaults)
'(ssh-deploy-diff-mode--font-lock-keywords))
+ (setq major-mode 'ssh-deploy-diff-mode)
+ (setq mode-name "SSH-Deploy-Diff")
+ (read-only-mode t)
+ (run-hooks 'ssh-deploy-diff-mode-hook))
+
+(provide 'ssh-deploy-diff-mode)
+
+;;; ssh-deploy-diff-mode.el ends here
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 204cf34..5d55fda 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -3,14 +3,16 @@
;; Author: Christian Johansson <github.com/cjohansson>
;; Maintainer: Christian Johansson <github.com/cjohansson>
;; Created: 5 Jul 2016
-;; Modified: 28 Jan 2018
-;; Version: 1.73
+;; Modified: 14 Feb 2018
+;; Version: 1.74
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-ssh-deploy
-;; This file is not part of GNU Emacs.
+;; Package-Requires: ((emacs "24") (ssh-deploy-diff-mode "1.0"))
+
+;; Copyright (C) 2017 - 2018 Christian Johansson
-;; Copyright (C) 2017 Christian Johansson
+;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -139,6 +141,8 @@
;;; Code:
+(require 'ssh-deploy-diff-mode)
+
(defgroup ssh-deploy nil
"Upload, download, difference, browse and terminal handler for files and
directories on remote hosts via TRAMP."
:group 'tools
@@ -210,11 +214,11 @@
(concat root (replace-regexp-in-string "\\(/\\|@\\|:\\)" "_" path)))
(defun ssh-deploy--file-is-in-path (file path)
- "Return true if FILE is in the path PATH."
+ "Return non-nil if FILE is in the path PATH."
(not (null (string-match path file))))
(defun ssh-deploy--file-is-included (path exclude-list)
- "Return true if PATH is not in EXCLUDE-LIST."
+ "Return non-nil if PATH is not in EXCLUDE-LIST."
(let ((not-found t))
(dolist (element exclude-list)
(if (and (not (null element))
@@ -228,7 +232,7 @@
(replace-regexp-in-string root "" path))
(defun ssh-deploy--is-not-empty-string (string)
- "Return true if the STRING is not empty and not nil. Expects string."
+ "Return non-nil if the STRING is not empty and not nil. Expects string."
(and (not (null string))
(not (zerop (length string)))))
@@ -240,10 +244,10 @@
(if file-or-directory
(progn
(let ((revision-path (ssh-deploy--get-revision-path path-local
revision-folder)))
- (message "Uploading file '%s' to '%s' via TRAMP
asynchronously.." path-local path-remote)
+ (message "Uploading file '%s' to '%s'.. (asynchronously)"
path-local path-remote)
(async-start
`(lambda()
- (require 'ediff)
+ (require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
(progn
(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)))
@@ -252,21 +256,21 @@
(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 "Upload '%s' completed."
,path-remote)))
- (list 1 (format "Remote file '%s' has changed,
please download or diff." ,path-remote))))
- (list 1 "Function 'ediff-same-file-contents' is
missing.")))
+ (list 0 (format "Upload of file '%s'
completed. (asynchronously)" ,path-remote)))
+ (list 1 (format "Remote file '%s' has changed,
please download or diff. (asynchronously)" ,path-remote))))
+ (list 1 "Function 'ediff-same-file-contents' is
missing. (asynchronously)")))
(lambda(return)
(if (= (nth 0 return) 0)
(message (nth 1 return))
(display-warning "ssh-deploy" (nth 1 return)
:warning))))))
(progn
- (message "Uploading directory '%s' to '%s' via TRAMP
asynchronously.." path-local path-remote)
+ (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)
- (message "Upload '%s' finished." return-path)))))))
+ (message "Upload of directory '%s' finished.
(asynchronously)" return-path)))))))
(message "async.el is not installed")))
(defun ssh-deploy--upload-via-tramp (path-local path-remote force
revision-folder)
@@ -275,24 +279,24 @@
(revision-path (ssh-deploy--get-revision-path path-local
revision-folder)))
(if file-or-directory
(progn
- (require 'ediff)
+ (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
- (message "Uploading file '%s' to '%s' via TRAMP
synchronously.." path-local path-remote)
+ (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)
- (message "Upload '%s' completed." path-local)
- (ssh-deploy-store-revision path-local revision-folder))
- (display-warning "ssh-deploy" (format "Remote file '%s' has
changed, please download or diff." path-remote) :warning))
+ (ssh-deploy-store-revision path-local revision-folder)
+ (message "Upload '%s' completed. (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)))
(progn
- (message "Uploading directory '%s' to '%s' via TRAMP synchronously.."
path-local path-remote)
+ (message "Uploading directory '%s' to '%s'.. (synchronously)"
path-local path-remote)
(copy-directory path-local path-remote t t t)
- (message "Upload '%s' finished" path-local)))))
+ (message "Upload '%s' finished. (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."
@@ -302,37 +306,37 @@
(if file-or-directory
(progn
(let ((revision-path (ssh-deploy--get-revision-path path-local
revision-folder)))
- (message "Downloading file '%s' to '%s' via TRAMP
asynchronously.." path-remote path-local)
+ (message "Downloading file '%s' to '%s'.. (asynchronously)"
path-remote path-local)
(async-start
`(lambda()
(copy-file ,path-remote ,path-local t t t t)
(copy-file ,path-local ,revision-path t t t t)
,path-local)
(lambda(return-path)
- (message "Download '%s' finished." return-path)))))
+ (message "Download of file '%s' finished.
(asynchronously)" return-path)))))
(progn
- (message "Downloading directory '%s' to '%s' via TRAMP
synchronously.." path-remote path-local)
+ (message "Downloading directory '%s' to '%s'.. (asynchronously)"
path-remote path-local)
(async-start
`(lambda()
(copy-directory ,path-remote ,path-local t t t)
,path-local)
(lambda(return-path)
- (message "Download '%s' finished." return-path)))))))
- (message "async.el is not installed")))
+ (message "Download of directory '%s' finished.
(asynchronously)" return-path)))))))
+ (display-warning "ssh-deploy" "async.el is not installed" :warning)))
(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."
(let ((file-or-directory (file-regular-p path-local)))
(if file-or-directory
(progn
- (message "Downloading file '%s' to '%s' via TRAMP synchronously.."
path-remote path-local)
+ (message "Downloading file '%s' to '%s'.. (synchronously)"
path-remote path-local)
(copy-file path-remote path-local t t t t)
- (message "Download '%s' finished." path-local)
- (ssh-deploy-store-revision path-local revision-folder))
+ (ssh-deploy-store-revision path-local revision-folder)
+ (message "Download of file '%s' finished. (synchronously)"
path-local))
(progn
- (message "Downloading directory '%s' to '%s' via TRAMP
synchronously.." path-remote path-local)
+ (message "Downloading directory '%s' to '%s'.. (synchronously)"
path-remote path-local)
(copy-directory path-remote path-local t t t)
- (message "Download '%s' finished." path-local)))))
+ (message "Download of directory '%s' finished. (synchronously)"
path-local)))))
(defun ssh-deploy--diff-directories-data (directory-a directory-b exclude-list)
"Find difference between DIRECTORY-A and DIRECTORY-B but exclude paths
matching EXCLUDE-LIST."
@@ -418,7 +422,7 @@
files-b-relative-list)
;; Collect files that differ in contents and have equal contents
- (require 'ediff)
+ (require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
(mapc
(lambda (file)
@@ -436,50 +440,71 @@
(list directory-a directory-b exclude-list files-both files-a-only
files-b-only files-both-equals files-both-differs))
(display-warning "ssh-deploy" "Function 'string-remove-prefix' is
missing.")))
-;; TODO Make this function interactive
(defun ssh-deploy--diff-directories-present (diff)
"Present difference data for directories from DIFF."
- (let ((buffer (generate-new-buffer "ssh-deploy diff")))
+ (require 'ssh-deploy-diff-mode)
+
+ (let ((buffer (generate-new-buffer "ssh-deploy diff"))
+ (old-ssh-deploy-root-local ssh-deploy-root-local)
+ (old-ssh-deploy-root-remote ssh-deploy-root-remote)
+ (old-ssh-deploy-on-explicit-save ssh-deploy-on-explicit-save)
+ (old-ssh-deploy-debug ssh-deploy-debug)
+ (old-ssh-deploy-async ssh-deploy-async)
+ (old-ssh-deploy-revision-folder ssh-deploy-revision-folder)
+ (old-ssh-deploy-automatically-detect-remote-changes
ssh-deploy-automatically-detect-remote-changes)
+ (old-ssh-deploy-exclude-list ssh-deploy-exclude-list))
(switch-to-buffer buffer)
- (ssh-deploy--insert-keyword "Directory A: ")
+ (ssh-deploy--insert-keyword "DIRECTORY A: ")
(insert (nth 0 diff) "\n")
- (ssh-deploy--insert-keyword "Directory B: ")
+ (ssh-deploy--insert-keyword "DIRECTORY B: ")
(insert (nth 1 diff) "\n")
(if (length (nth 2 diff))
(progn
(insert "\n")
- (ssh-deploy--insert-keyword (format "Exclude-list (%d)" (length (nth
2 diff))))
+ (ssh-deploy--insert-keyword (format "EXCLUDE-LIST: (%d)" (length
(nth 2 diff))))
(dolist (element (nth 2 diff))
- (insert "\n" element))
+ (insert "\n- " element))
(insert "\n")))
(insert "\n")
(if (length (nth 4 diff))
(progn
- (ssh-deploy--insert-keyword (format "Files only in A (%d)" (length
(nth 4 diff))))
+ (ssh-deploy--insert-keyword (format "FILES ONLY IN A: (%d)" (length
(nth 4 diff))))
(dolist (element (nth 4 diff))
- (insert "\n" element))
+ (insert "\n- " element))
(insert "\n\n")))
(if (length (nth 5 diff))
(progn
- (ssh-deploy--insert-keyword (format "Files only in B (%d)" (length
(nth 5 diff))))
+ (ssh-deploy--insert-keyword (format "FILES ONLY IN B: (%d)" (length
(nth 5 diff))))
(dolist (element (nth 5 diff))
- (insert "\n" element))
+ (insert "\n- " element))
(insert "\n\n")))
(if (length (nth 7 diff))
(progn
- (ssh-deploy--insert-keyword (format "Files in both but differs (%d)"
(length (nth 7 diff))))
+ (ssh-deploy--insert-keyword (format "FILES IN BOTH BUT DIFFERS:
(%d)" (length (nth 7 diff))))
(dolist (element (nth 7 diff))
- (insert "\n" element))
+ (insert "\n- " element))
(insert "\n\n")))
- (read-only-mode)))
+ (insert "\nHELP: (q) quit, (c) copy, (a) copy A to B, (b) copy B to A, (d)
delete, (TAB) difference, (g) refresh")
+
+ (ssh-deploy-diff-mode)
+
+ ;; Set local variables same as current directories
+ (set (make-local-variable 'ssh-deploy-root-local)
old-ssh-deploy-root-local)
+ (set (make-local-variable 'ssh-deploy-root-remote)
old-ssh-deploy-root-remote)
+ (set (make-local-variable 'ssh-deploy-on-explicit-save)
old-ssh-deploy-on-explicit-save)
+ (set (make-local-variable 'ssh-deploy-debug) old-ssh-deploy-debug)
+ (set (make-local-variable 'ssh-deploy-async) old-ssh-deploy-async)
+ (set (make-local-variable 'ssh-deploy-revision-folder)
old-ssh-deploy-revision-folder)
+ (set (make-local-variable 'ssh-deploy-automatically-detect-remote-changes)
old-ssh-deploy-automatically-detect-remote-changes)
+ (set (make-local-variable 'ssh-deploy-exclude-list)
old-ssh-deploy-exclude-list)))
;; PUBLIC functions
@@ -491,7 +516,7 @@
;;;### autoload
(defun ssh-deploy-diff-files (file-a file-b)
"Find difference between FILE-A and FILE-B."
- (require 'ediff)
+ (require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
(progn
(message "Comparing file '%s' to '%s'.." file-a file-b)
@@ -509,20 +534,20 @@
(setq exclude-list ssh-deploy-exclude-list))
(if (and async (fboundp 'async-start))
(let ((script-filename (file-name-directory (symbol-file
'ssh-deploy-diff-directories))))
- (message "Generating differences asynchronously between directory '%s'
and '%s'.." directory-a directory-b)
+ (message "Generating differences between directory '%s' and '%s'..
(asynchronously)" directory-a directory-b)
(async-start
`(lambda()
(add-to-list 'load-path ,script-filename)
(require 'ssh-deploy)
(ssh-deploy--diff-directories-data ,directory-a ,directory-b (list
,@exclude-list)))
(lambda(diff)
- (message "Differences calculated: %s only in A, %s only in B, %s
differs" (length (nth 4 diff)) (length (nth 5 diff)) (length (nth 7 diff)))
+ (message "Differences calculated between directory '%s' and '%s' ->
%s only in A, %s only in B, %s differs. (asynchronously)" (nth 0 diff) (nth 1
diff) (length (nth 4 diff)) (length (nth 5 diff)) (length (nth 7 diff)))
(if (or (> (length (nth 4 diff)) 0) (> (length (nth 5 diff)) 0) (>
(length (nth 7 diff)) 0))
(ssh-deploy--diff-directories-present diff)))))
(progn
- (message "Generating differences synchronously between directory '%s'
and '%s'.." directory-a directory-b)
+ (message "Generating differences between directory '%s' and '%s'..
(synchronously)" directory-a directory-b)
(let ((diff (ssh-deploy--diff-directories-data directory-a directory-b
exclude-list)))
- (message "Differences calculated: %s only in A, %s only in B, %s
differs" (length (nth 4 diff)) (length (nth 5 diff)) (length (nth 7 diff)))
+ (message "Differences calculated between directory '%s' and '%s' -> %s
only in A, %s only in B, %s differs. (synchronously)" (nth 0 diff) (nth 1 diff)
(length (nth 4 diff)) (length (nth 5 diff)) (length (nth 7 diff)))
(if (or (> (length (nth 4 diff)) 0) (> (length (nth 5 diff)) 0) (>
(length (nth 7 diff)) 0))
(ssh-deploy--diff-directories-present diff))))))
@@ -545,19 +570,19 @@
`(lambda()
(if (file-exists-p ,path-remote)
(progn
- (require 'ediff)
+ (require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
(progn
(if (ediff-same-file-contents
,revision-path ,path-remote)
- (list 0 (format "Remote file '%s'
has not changed." ,path-remote))
+ (list 0 (format "Remote file '%s'
has not changed. (asynchronously)" ,path-remote))
(progn
(if (ediff-same-file-contents
,path-local ,path-remote)
(progn
(copy-file ,path-local
,revision-path t t t t)
- (list 0 (format "Remote file
'%s' is identical to local file '%s' but different to local revision. Updated
local revision." ,path-remote ,path-local)))
- (list 1 (format "Remote file
'%s' has changed, please download or diff." ,path-remote))))))
- (list 1 "Function
'ediff-same-file-contents' is missing.")))
- (list 0 (format "Remote file '%s' doesn't
exist." ,path-remote))))
+ (list 0 (format "Remote file
'%s' is identical to local file '%s' but different to local revision. Updated
local revision. (asynchronously)" ,path-remote ,path-local)))
+ (list 1 (format "Remote file
'%s' has changed, please download or diff. (asynchronously)" ,path-remote))))))
+ (list 1 "Function
'ediff-same-file-contents' is missing. (asynchronously)")))
+ (list 0 (format "Remote file '%s' doesn't exist.
(asynchronously)" ,path-remote))))
(lambda(return)
(if (= (nth 0 return) 0)
(message (nth 1 return))
@@ -565,47 +590,74 @@
(progn
(if (file-exists-p path-remote)
(progn
- (require 'ediff)
+ (require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
(progn
(if (ediff-same-file-contents revision-path
path-remote)
- (message "Remote file '%s' has not
changed." path-remote)
- (display-warning "ssh-deploy" (format
"Remote file '%s' has changed, please download or diff." path-remote)
:warning)))
- (display-warning "ssh-deploy" "Function
'ediff-same-file-contents' is missing." :warning)))
- (message "Remote file '%s' doesn't exist."
path-remote))))
+ (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))))
(if (and async (fboundp 'async-start))
(async-start
`(lambda()
(if (file-exists-p ,path-remote)
(progn
- (require 'ediff)
+ (require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
(progn
(if (ediff-same-file-contents ,path-local
,path-remote)
(progn
(copy-file ,path-local
,revision-path t t t t)
- (list 0 (format "Remote file '%s'
has not changed, created base revision." ,path-remote)))
- (list 1 (format "Remote file '%s' has
changed, please download or diff." ,path-remote))))
- (list 1 "Function ediff-file-same-contents is
missing")))
- (list 0 (format "Remote file '%s' doesn't exist."
,path-remote))))
+ (list 0 (format "Remote file '%s'
has not changed, created base revision. (asynchronously)" ,path-remote)))
+ (list 1 (format "Remote file '%s' has
changed, please download or diff. (asynchronously)" ,path-remote))))
+ (list 1 "Function ediff-file-same-contents is
missing. (asynchronously)")))
+ (list 0 (format "Remote file '%s' doesn't exist.
(asynchronously)" ,path-remote))))
(lambda(return)
(if (= (nth 0 return) 0)
(message (nth 1 return))
(display-warning "ssh-deploy" (nth 1 return)
:warning))))
(if (file-exists-p path-remote)
(progn
- (require 'ediff)
- (if (and (fboundp 'ediff-same-file-contents)
- (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." path-remote))
- (display-warning "ssh-deploy" (format "Remote file
'%s' has changed, please download or diff." path-remote) :warning))
- (display-warning "ssh-deploy" "Function
'ediff-same-file-contents' is missing." :warning)))
- (message "Remote file '%s' doesn't exist."
path-remote))))))))
+ (require 'ediff-util)
+ (if (fboundp 'ediff-same-file-contents)
+ (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))
+ (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)))))))))
+
+(defun ssh-deploy-delete (path &optional async debug)
+ "Delete PATH and use flags ASYNC and DEBUG."
+ (if (and async (fboundp 'async-start))
+ (progn
+ (async-start
+ `(lambda()
+ (if (file-exists-p ,path)
+ (let ((file-or-directory (file-regular-p ,path)))
+ (progn
+ (if file-or-directory
+ (delete-file ,path t)
+ (delete-directory ,path t t))
+ (list ,path 0)))
+ (list ,path 1)))
+ (lambda(response)
+ (cond ((= 0 (nth 1 response)) (message "Deleted '%s'.
(asynchronously)" (nth 0 response)))
+ ((t (display-warning "ssh-deploy" (format "Did not find '%s'.
(asynchronously)" (nth 0 response)) :warning)))))))
+ (progn
+ (if (file-exists-p path)
+ (let ((file-or-directory (file-regular-p path)))
+ (progn
+ (if file-or-directory
+ (delete-file path t)
+ (delete-directory path t t))
+ (message "Deleted '%s'. (synchronously)" path)))
+ (display-warning "ssh-deploy" (format "Did not find '%s'.
(synchronously)" path) :warning)))))
;;;### autoload
-(defun ssh-deploy-delete (path-local &optional root-local root-remote async
debug exclude-list)
+(defun ssh-deploy-delete-both (path-local &optional root-local root-remote
async debug exclude-list)
"Delete PATH-LOCAL relative to ROOT-LOCAL as well as on ROOT-REMOTE, do it
asynchronously if ASYNC is non-nil, debug if DEBUG is non-nil, check if path is
excluded in EXCLUDE-LIST."
(let ((root-local (or root-local ssh-deploy-root-local))
(root-remote (or root-remote ssh-deploy-root-remote)))
@@ -614,29 +666,9 @@
(let ((exclude-list (or exclude-list ssh-deploy-exclude-list))
(file-or-directory (file-regular-p path-local))
(path-remote (concat root-remote (ssh-deploy--get-relative-path
root-local path-local))))
- (if file-or-directory
- (progn
- (delete-file path-local t)
- (message "Deleted file '%s'" path-local))
- (progn
- (delete-directory path-local t t)
- (message "Deleted directory '%s'" path-local)))
+ (ssh-deploy-delete path-local async debug)
(kill-this-buffer)
- (if (and async (fboundp 'async-start))
- (progn
- (async-start
- `(lambda()
- (if ,file-or-directory
- (delete-file ,path-remote t)
- (delete-directory ,path-remote t t))
- (list ,path-remote))
- (lambda(files)
- (message "Asynchronously deleted '%s'." (nth 0 files)))))
- (progn
- (if file-or-directory
- (delete-file path-remote t)
- (delete-directory path-remote t t))
- (message "Synchronously deleted '%s'." path-remote))))
+ (ssh-deploy-delete path-remote async debug))
(if debug
(message "Path '%s' is not in the root '%s' or is excluded from it."
path-local root-local)))))
@@ -673,10 +705,10 @@
(rename-file ,old-path-remote ,new-path-remote t)
(list ,old-path-remote ,new-path-remote))
(lambda(files)
- (message "Asynchronously renamed '%s' to '%s'." (nth
0 files) (nth 1 files)))))
+ (message "Renamed '%s' to '%s'. (asynchronously)"
(nth 0 files) (nth 1 files)))))
(progn
(rename-file old-path-remote new-path-remote t)
- (message "Synchronously renamed '%s' to '%s'."
old-path-remote new-path-remote)))))))
+ (message "Renamed '%s' to '%s'. (synchronously)"
old-path-remote new-path-remote)))))))
(if debug
(message "Path '%s' or '%s' is not in the root '%s' or is excluded
from it." old-path-local new-path-local root-local)))))
@@ -808,7 +840,7 @@
;;;### autoload
(defun ssh-deploy-remote-changes-handler()
- "Check if local revision exists or remote file has changed if path is
configured for deployment"
+ "Check if local revision exists or remote file has changed if path is
configured for deployment."
(interactive)
(if (and (ssh-deploy--is-not-empty-string ssh-deploy-root-local)
(ssh-deploy--is-not-empty-string ssh-deploy-root-remote)
@@ -868,14 +900,14 @@
(root-local (file-truename ssh-deploy-root-local))
(yes-no-prompt (read-string (format "Type 'yes' to confirm
that you want to delete the file '%s': " path-local))))
(if (string= yes-no-prompt "yes")
- (ssh-deploy-delete path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))
+ (ssh-deploy-delete-both path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))
(if (and (ssh-deploy--is-not-empty-string default-directory)
(file-exists-p default-directory))
(let* ((path-local (file-truename default-directory))
(root-local (file-truename ssh-deploy-root-local))
(yes-no-prompt (read-string (format "Type 'yes' to confirm
that you want to delete the directory '%s': " path-local))))
(if (string= yes-no-prompt "yes")
- (ssh-deploy-delete path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug
ssh-deploy-exclude-list)))))))
+ (ssh-deploy-delete-both path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug
ssh-deploy-exclude-list)))))))
;;;### autoload
(defun ssh-deploy-rename-handler ()
