[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ssh-deploy b62abf2 073/173: Improved code structure and
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/ssh-deploy b62abf2 073/173: Improved code structure and improved documentation |
|
Date: |
Sat, 20 Oct 2018 10:36:33 -0400 (EDT) |
branch: externals/ssh-deploy
commit b62abf265ac821940cae8fb737b8e10aaae2dc73
Author: Christian Johansson <address@hidden>
Commit: Christian Johansson <address@hidden>
Improved code structure and improved documentation
---
README.md | 29 +++-
ssh-deploy.el | 514 +++++++++++++++++++++++++++++++---------------------------
2 files changed, 297 insertions(+), 246 deletions(-)
diff --git a/README.md b/README.md
index f9a6b43..c71e51d 100644
--- a/README.md
+++ b/README.md
@@ -1,13 +1,36 @@
# `emacs-ssh-deploy`
[](http://melpa.org/#/ssh-deploy)
[](http://stable.melpa.org/#/ssh-deploy)
-The `ssh-deploy` plug-in for Emacs makes it possible to effortlessly deploy
local files and directories to remote hosts via SSH and FTP. 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 and whether you want transfers to be
asynchronous or not. For asynchronous transfers you need a setup which doesn't
require a interactive authorization. The plug-in also enables manual upload and
download of files and dire [...]
-
-`ssh-deploy` works with `DirectoryVariables` so you can have different deploy
setups in different ways for different folders.
+The `ssh-deploy` plug-in for Emacs makes it possible to effortlessly deploy
local files and directories to remote hosts via SSH and FTP using TRAMP. It
tries to provide functions that can be easily used by custom scripts.
+
+## Features:
+* Define syncing configuration globally or per directory (using
`DirectoryVariables`)
+* Control whether uploads should be on save or manually
+* Automatic and manual uploads of files
+* Manual downloads and uploads of directories
+* Manual downloads of files
+* Automatic and manual detection of remote changes
+* Launch remote terminals with the integrated `tramp-term` functionality (SSH)
+* Launch remote browsing using `dired-mode` (SSH)
+* Launch difference sessions using `ediff-mode`
+* Supports asynchronous operations if `async.el` is installed. (You need to
setup an automatic authorization for this, like `~/.netrc` or key-based
authorization)
+* Supports renaming and deletion of files and directories
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.
+## Configuration
+
+Here is a list of other variables you can set globally or per directory:
+
+* `ssh-deploy-root-local` The local root that should be under deployment
[string]
+* `ssh-deploy-root-remote` The remote root that should be under deployment,
should follow a `/protocol:address@hidden:path` format [string]
+* `ssh-deploy-debug` Enables debugging messages [boolean]
+* `ssh-deploy-revision-folder` The folder used for storing local revisions
[string]
+* `ssh-deploy-automatically-detect-remote-changes` Enables automatic detection
of remote changes [boolean]
+* `ssh-deploy-exclude-list` A list defining what paths to exclude from
deployment [list]
+* `ssh-deploy-async` Enables asynchronous transfers (you need to install
`async.el' as well) [boolean]
+
## A setup example
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 3640d1e..37db9cd 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: 20 May 2017
-;; Version: 1.56
+;; Modified: 27 Jul 2017
+;; Version: 1.57
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-ssh-deploy
@@ -37,9 +37,9 @@
;; `ssh-deploy-root-local',`ssh-deploy-root-remote',
`ssh-deploy-on-explicit-save'
;; you can setup a directory for `SSH' or `FTP' deployment.
;;
-;; For asynchronous transfers you need to setup `~/.netrc' or equivalent for
automatic authentication.
+;; For asynchronous transfers you need to setup `~/.netrc' or key-based
authorization or equivalent for automatic authentication.
;;
-;; Example contents of `~/.netrc':
+;; Example contents of `~/.netrc' for `FTP':
;; machine myserver.com login myuser port ftp password mypassword
;;
;; Set permissions to this file to `700' with you as the owner.
@@ -61,7 +61,7 @@
;; (global-set-key (kbd "C-c C-z e") (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
+;; 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/")
@@ -77,6 +77,15 @@
;;
;; Now when you are in a directory which is deployed via SSH or FTP you can
access these features.
;;
+;;
+;; Here is a list of other variables you can set globally or per directory:
+;; * `ssh-deploy-debug' Enables debugging messages
+;; * `ssh-deploy-revision-folder' The folder used for storing local revisions
+;; * `ssh-deploy-automatically-detect-remote-changes' Enables automatic
detection of remote changes
+;; * `ssh-deploy-exclude-list' A list defining what paths to exclude from
deployment
+;; * `ssh-deploy-async' Enables asynchronous transfers (you need to install
`async.el' as well)
+;;
+;;
;; Please see README.md from the same repository for documentation.
;;; Code:
@@ -126,6 +135,10 @@
:type 'list
:group 'ssh-deploy)
+
+;; PRIVATE FUNCTIONS - the idea about these is that these functions should
only be used by the plug-in internally.
+
+
(defun ssh-deploy--get-revision-path (path)
"Generate revision-path for PATH."
(if (not (file-exists-p ssh-deploy-revision-folder))
@@ -176,79 +189,8 @@
(and (not (null string))
(not (zerop (length string)))))
-(defun ssh-deploy--delete (local-path local-root remote-root async debug)
- "Delete LOCAL-PATH relative to LOCAL-ROOT as well as on REMOTE-ROOT, do it
asynchronously if ASYNC is non-nil, debug if DEBUG is non-nil."
- (if (and (ssh-deploy--file-is-in-path local-path local-root)
- (ssh-deploy--file-is-included local-path))
- (progn
- (let ((file-or-directory (file-regular-p local-path)))
- (let ((remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root local-path))))
- (if (file-regular-p local-path)
- (progn
- (delete-file local-path t)
- (message "Deleted file '%s'" local-path))
- (progn
- (delete-directory local-path t t)
- (message "Deleted directory '%s'" local-path)))
- (kill-this-buffer)
- (if (and async (fboundp 'async-start))
- (progn
- (async-start
- `(lambda()
- (if (file-regular-p ,remote-path)
- (delete-file ,remote-path t)
- (delete-directory ,remote-path t t))
- (list ,remote-path))
- (lambda(files)
- (message "Asynchronously deleted '%s'." (nth 0 files)))))
- (progn
- (if (file-regular-p remote-path)
- (delete-file remote-path t)
- (delete-directory remote-path t t))
- (message "Synchronously deleted '%s'." remote-path))))))
- (if debug
- (message "Path '%s' is not in the root '%s' or is excluded from it."
local-path local-root))))
-
-(defun ssh-deploy--rename (old-path new-path local-root remote-root async
debug)
- "Rename OLD-PATH to NEW-PATH relative to LOCAL-ROOT as well as on
REMOTE-ROOT, do it asynchronously if ASYNC is non-nil, debug if DEBUG is
non-nil."
- (if (and (ssh-deploy--file-is-in-path old-path local-root)
- (ssh-deploy--file-is-in-path new-path local-root)
- (ssh-deploy--file-is-included old-path)
- (ssh-deploy--file-is-included new-path))
- (progn
- (let ((file-or-directory (file-regular-p old-path)))
- (let ((old-remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root old-path)))
- (new-remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root new-path))))
- (rename-file old-path new-path t)
- (if (file-regular-p new-path)
- (progn
- (rename-buffer new-path)
- (set-buffer-modified-p nil)
- (set-visited-file-name new-path))
- (dired new-path))
- (message "Renamed '%s' -> '%s'." old-path new-path)
- (if (and async (fboundp 'async-start))
- (progn
- (async-start
- `(lambda()
- (rename-file ,old-remote-path ,new-remote-path t)
- (list ,old-remote-path ,new-remote-path))
- (lambda(files)
- (message "Asynchronously renamed '%s' -> '%s'." (nth 0
files) (nth 1 files)))))
- (progn
- (rename-file old-remote-path new-remote-path t)
- (message "Synchronously renamed '%s' -> '%s'." old-remote-path
new-remote-path))))))
- (if debug
- (message "Path '%s' or '%s' is not in the root '%s' or is excluded
from it." old-path new-path local-root))))
-
-(defun ssh-deploy--download (remote local local-root async)
- "Download REMOTE to LOCAL with the LOCAL-ROOT via tramp, ASYNC determines if
transfer should be asynchrous or not."
- (if (and async (fboundp 'async-start))
- (ssh-deploy--download-via-tramp-async remote local local-root)
- (ssh-deploy--download-via-tramp remote local local-root)))
-
(defun ssh-deploy--upload-via-tramp-async (local remote local-root force)
- "Upload LOCAL path to REMOTE and LOCAL-ROOT via tramp asynchrously and FORCE
upload despite external change."
+ "Upload LOCAL path to REMOTE and LOCAL-ROOT via TRAMP asynchronously and
FORCE upload despite external change."
(if (fboundp 'async-start)
(progn
(let ((remote-path (concat "/" (shell-quote-argument (alist-get
'protocol remote)) ":" (shell-quote-argument (alist-get 'username remote)) "@"
(shell-quote-argument (alist-get 'server remote)) ":" (alist-get 'path remote)))
@@ -256,7 +198,7 @@
(if file-or-directory
(progn
(let ((revision-path (ssh-deploy--get-revision-path local)))
- (message "Uploading file '%s' to '%s' via tramp
asynchronously.." local remote-path)
+ (message "Uploading file '%s' to '%s' via TRAMP
asynchronously.." local remote-path)
(async-start
`(lambda()
(require 'ediff)
@@ -276,7 +218,7 @@
(message (nth 1 return))
(display-warning "ssh-deploy" (nth 1 return)
:warning))))))
(progn
- (message "Uploading directory '%s' to '%s' via tramp
asynchronously.." local remote-path)
+ (message "Uploading directory '%s' to '%s' via TRAMP
asynchronously.." local remote-path)
(if (string= remote-path (alist-get 'string remote))
(progn
(async-start
@@ -297,14 +239,14 @@
(message "async.el is not installed")))
(defun ssh-deploy--upload-via-tramp (local remote local-root force)
- "Upload LOCAL path to REMOTE and LOCAL-ROOT via tramp synchrously and FORCE
despite external change."
+ "Upload LOCAL path to REMOTE and LOCAL-ROOT via TRAMP synchrously and FORCE
despite external change."
(let ((remote-path (concat "/" (shell-quote-argument (alist-get 'protocol
remote)) ":" (shell-quote-argument (alist-get 'username remote)) "@"
(shell-quote-argument (alist-get 'server remote)) ":" (alist-get 'path remote)))
(file-or-directory (file-regular-p local)))
(if file-or-directory
(progn
(if (or (boundp 'force) (not (ssh-deploy--remote-has-changed local
remote-path)))
(progn
- (message "Uploading file '%s' to '%s' via tramp
synchronously.." local remote-path)
+ (message "Uploading file '%s' to '%s' via TRAMP
synchronously.." local remote-path)
(if (not (file-directory-p (file-name-directory remote-path)))
(make-directory (file-name-directory remote-path) t))
(copy-file local remote-path t t t t)
@@ -312,7 +254,7 @@
(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)
+ (message "Uploading directory '%s' to '%s' via TRAMP synchronously.."
local remote-path)
(if (string= remote-path (alist-get 'string remote))
(progn
(copy-directory local remote-path t t t)
@@ -322,14 +264,14 @@
(message "Upload '%s' finished" local)))))))
(defun ssh-deploy--download-via-tramp-async (remote local local-root)
- "Download REMOTE path to LOCAL and LOCAL-ROOT via tramp asynchronously."
+ "Download REMOTE path to LOCAL and LOCAL-ROOT via TRAMP asynchronously."
(if (fboundp 'async-start)
(progn
(let ((remote-path (concat "/" (shell-quote-argument (alist-get
'protocol remote)) ":" (shell-quote-argument (alist-get 'username remote)) "@"
(shell-quote-argument (alist-get 'server remote)) ":" (alist-get 'path remote)))
(file-or-directory (file-regular-p local)))
(if file-or-directory
(progn
- (message "Downloading file '%s' to '%s' via tramp
asynchronously.." remote-path local)
+ (message "Downloading file '%s' to '%s' via TRAMP
asynchronously.." remote-path local)
(async-start
`(lambda()
(copy-file ,remote-path ,local t t t t)
@@ -338,7 +280,7 @@
(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)
+ (message "Downloading directory '%s' to '%s' via TRAMP
asynchronously.." remote-path local)
(if (string= remote-path (alist-get 'string remote))
(progn
(async-start
@@ -357,17 +299,17 @@
(message "async.el is not installed")))
(defun ssh-deploy--download-via-tramp (remote local local-root)
- "Download REMOTE path to LOCAL and LOCAL-ROOT via tramp synchronously."
+ "Download REMOTE path to LOCAL and LOCAL-ROOT via TRAMP synchronously."
(let ((remote-path (concat "/" (shell-quote-argument (alist-get 'protocol
remote)) ":" (shell-quote-argument (alist-get 'username remote)) "@"
(shell-quote-argument (alist-get 'server remote)) ":" (alist-get 'path remote)))
(file-or-directory (file-regular-p local)))
(if file-or-directory
(progn
- (message "Downloading file '%s' to '%s' via tramp synchronously.."
remote-path local)
+ (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)
(ssh-deploy-store-revision local))
(progn
- (message "Downloading directory '%s' to '%s' via tramp
synchronously.." remote-path local)
+ (message "Downloading directory '%s' to '%s' via TRAMP
synchronously.." remote-path local)
(if (string= remote-path (alist-get 'string remote))
(progn
(copy-directory remote-path local t t t)
@@ -377,12 +319,6 @@
(message "Download '%s' finished." local))
)))))
-(defun ssh-deploy--upload (local remote local-root async force)
- "Upload LOCAL to REMOTE and LOCAL-ROOT via tramp, ASYNC determines if
transfer should be asynchronously or not, FORCE uploads despite external
change."
- (if (and async (fboundp 'async-start))
- (ssh-deploy--upload-via-tramp-async local remote local-root force)
- (ssh-deploy--upload-via-tramp local remote local-root force)))
-
(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)))
@@ -402,9 +338,13 @@
t))
nil)))
+
+;; PUBLIC functions - the idea is that handlers use these to do things and
people should be able to use these as they please themselves.
+
+
;;;### autoload
(defun ssh-deploy (local-root remote-root upload-or-download path debug async
force)
- "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, FORCE upload despite external change."
+ "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, FORCE upload despite external change."
(if (and (ssh-deploy--file-is-in-path path local-root)
(ssh-deploy--file-is-included path))
(progn
@@ -412,12 +352,240 @@
(let ((remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root path))))
(let ((connection (ssh-deploy--parse-remote remote-path)))
(if (not (null upload-or-download))
- (ssh-deploy--upload path connection local-root async force)
- (ssh-deploy--download connection path local-root async))))))
+ (ssh-deploy-upload path connection local-root async force)
+ (ssh-deploy-download connection path local-root async))))))
(if debug
(message "Path '%s' is not in the root '%s' or is excluded from it."
path local-root))))
;;;### autoload
+(defun ssh-deploy-remote-changes (local-root remote-root path async)
+ "Check if a local revision exists on LOCAL-ROOT and if remote file has
changed on REMOTE-ROOT for file PATH and do it optionally asynchronously if
ASYNC is t."
+ (if (and (ssh-deploy--file-is-in-path path local-root)
+ (ssh-deploy--file-is-included path))
+ (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 (and async (fboundp 'async-start))
+ (progn
+ (async-start
+ `(lambda()
+ (if (file-exists-p ,remote-path)
+ (progn
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (progn
+ (if (ediff-same-file-contents
,revision-path ,remote-path)
+ (list 0 (format "Remote file
'%s' has not changed." ,remote-path))
+ (progn
+ (if (ediff-same-file-contents
,path ,remote-path)
+ (progn
+ (copy-file ,path
,revision-path t t t t)
+ (list 0 (format
"External file '%s' is identical to local file '%s' but different to local
revision. Updated local revision." ,remote-path ,path)))
+ (list 1 (format "External
file '%s' has changed, please download or diff." ,remote-path))))))
+ (list 1 "Function
ediff-same-file-contents is missing.")))
+ (list 0 (format "Remote file '%s' doesn't
exist." ,remote-path))))
+ (lambda(return)
+ (if (= (nth 0 return) 0)
+ (message (nth 1 return))
+ (display-warning "ssh-deploy" (nth 1 return)
:warning)))))
+ (progn
+ (if (file-exists-p remote-path)
+ (progn
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (progn
+ (if (ediff-same-file-contents
revision-path remote-path)
+ (message "Remote file '%s' has not
changed." remote-path)
+ (display-warning "ssh-deploy" (format
"External file '%s' has changed, please download or diff." remote-path)
:warning)))
+ (display-warning "ssh-deploy" "Function
ediff-same-file-contents is missing." :warning)))
+ (message "Remote file '%s' doesn't exist."
remote-path)))))
+ (progn
+ (if (and async (fboundp 'async-start))
+ (progn
+ (async-start
+ `(lambda()
+ (if (file-exists-p ,remote-path)
+ (progn
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (progn
+ (if (ediff-same-file-contents ,path
,remote-path)
+ (progn
+ (copy-file ,path
,revision-path t t t t)
+ (list 0 (format "Remote file
'%s' has not changed, created base revision." ,remote-path)))
+ (list 1 (format "External file has
'%s' changed, please download or diff." ,remote-path))))
+ (list 1 "Function
ediff-file-same-contents is missing")))
+ (list 0 (format "Remote file '%s' doesn't
exist." ,remote-path))))
+ (lambda(return)
+ (if (= (nth 0 return) 0)
+ (message (nth 1 return))
+ (display-warning "ssh-deploy" (nth 1 return)
:warning)))))
+ (progn
+ (if (file-exists-p remote-path)
+ (progn
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (progn
+ (if (ediff-same-file-contents path
remote-path)
+ (progn
+ (copy-file path revision-path t t t
t)
+ (message "Remote file '%s' has not
changed, created base revision." remote-path))
+ (display-warning "ssh-deploy" (format
"External file '%s' has changed, please download or diff." remote-path)
:warning)))
+ (display-warning "ssh-deploy" "Function
ediff-same-file-contents is missing." :warning)))
+ (message "Remote file '%s' doesn't exist."
remote-path))))))))))))
+
+;;;### autoload
+(defun ssh-deploy-delete (local-path local-root remote-root async debug)
+ "Delete LOCAL-PATH relative to LOCAL-ROOT as well as on REMOTE-ROOT, do it
asynchronously if ASYNC is non-nil, debug if DEBUG is non-nil."
+ (if (and (ssh-deploy--file-is-in-path local-path local-root)
+ (ssh-deploy--file-is-included local-path))
+ (progn
+ (let ((file-or-directory (file-regular-p local-path)))
+ (let ((remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root local-path))))
+ (if (file-regular-p local-path)
+ (progn
+ (delete-file local-path t)
+ (message "Deleted file '%s'" local-path))
+ (progn
+ (delete-directory local-path t t)
+ (message "Deleted directory '%s'" local-path)))
+ (kill-this-buffer)
+ (if (and async (fboundp 'async-start))
+ (progn
+ (async-start
+ `(lambda()
+ (if (file-regular-p ,remote-path)
+ (delete-file ,remote-path t)
+ (delete-directory ,remote-path t t))
+ (list ,remote-path))
+ (lambda(files)
+ (message "Asynchronously deleted '%s'." (nth 0 files)))))
+ (progn
+ (if (file-regular-p remote-path)
+ (delete-file remote-path t)
+ (delete-directory remote-path t t))
+ (message "Synchronously deleted '%s'." remote-path))))))
+ (if debug
+ (message "Path '%s' is not in the root '%s' or is excluded from it."
local-path local-root))))
+
+;;;### autoload
+(defun ssh-deploy-rename (old-path new-path local-root remote-root async debug)
+ "Rename OLD-PATH to NEW-PATH relative to LOCAL-ROOT as well as on
REMOTE-ROOT, do it asynchronously if ASYNC is non-nil, debug if DEBUG is
non-nil."
+ (if (and (ssh-deploy--file-is-in-path old-path local-root)
+ (ssh-deploy--file-is-in-path new-path local-root)
+ (ssh-deploy--file-is-included old-path)
+ (ssh-deploy--file-is-included new-path))
+ (progn
+ (let ((file-or-directory (file-regular-p old-path)))
+ (let ((old-remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root old-path)))
+ (new-remote-path (concat remote-root
(ssh-deploy--get-relative-path local-root new-path))))
+ (rename-file old-path new-path t)
+ (if (file-regular-p new-path)
+ (progn
+ (rename-buffer new-path)
+ (set-buffer-modified-p nil)
+ (set-visited-file-name new-path))
+ (dired new-path))
+ (message "Renamed '%s' -> '%s'." old-path new-path)
+ (if (and async (fboundp 'async-start))
+ (progn
+ (async-start
+ `(lambda()
+ (rename-file ,old-remote-path ,new-remote-path t)
+ (list ,old-remote-path ,new-remote-path))
+ (lambda(files)
+ (message "Asynchronously renamed '%s' -> '%s'." (nth 0
files) (nth 1 files)))))
+ (progn
+ (rename-file old-remote-path new-remote-path t)
+ (message "Synchronously renamed '%s' -> '%s'." old-remote-path
new-remote-path))))))
+ (if debug
+ (message "Path '%s' or '%s' is not in the root '%s' or is excluded
from it." old-path new-path local-root))))
+
+;;;### autoload
+(defun ssh-deploy-browse-remote (local-root remote-root-string path)
+ "Browse relative to LOCAL-ROOT on REMOTE-ROOT-STRING the path PATH in
`dired-mode`."
+ (if (and (ssh-deploy--file-is-in-path path local-root)
+ (ssh-deploy--file-is-included path))
+ (let ((remote-path (concat remote-root-string
(ssh-deploy--get-relative-path local-root path))))
+ (let ((remote-root (ssh-deploy--parse-remote remote-path)))
+ (let ((command (concat "/" (alist-get 'protocol remote-root) ":"
(alist-get 'username remote-root) "@" (alist-get 'server remote-root) ":"
(alist-get 'path remote-root))))
+ (message "Opening '%s' for browsing on remote host.." command)
+ (dired command))))))
+
+;;;### autoload
+(defun ssh-deploy-remote-terminal (remote-host-string)
+ "Opens REMOTE-HOST-STRING in terminal."
+ (let ((remote-root (ssh-deploy--parse-remote remote-host-string)))
+ (if (string= (alist-get 'protocol remote-root) "ssh")
+ (if (and (fboundp 'tramp-term)
+ (fboundp 'tramp-term--initialize)
+ (fboundp 'tramp-term--do-ssh-login))
+ (progn
+ (let ((hostname (concat (alist-get 'username remote-root) "@"
(alist-get 'server remote-root))))
+ (let ((host (split-string hostname "@")))
+ (message "Opening TRAMP-terminal for remote host
'address@hidden' and '%s'.." (car host) (car (last host)) hostname)
+ (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")))))
+ (message "tramp-term is not installed."))
+ (message "Remote terminal is only available for the 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)))
+
+;;;### 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
and the path PATH, DEBUG enables feedback message."
+ (let ((file-or-directory (file-regular-p path)))
+ (if (and (ssh-deploy--file-is-in-path path local-root)
+ (ssh-deploy--file-is-included path))
+ (progn
+ (let ((remote-path (concat remote-root-string
(ssh-deploy--get-relative-path local-root path))))
+ (let ((remote (ssh-deploy--parse-remote remote-path)))
+ (let ((command (concat "/" (alist-get 'protocol remote) ":"
(alist-get 'username remote) "@" (alist-get 'server remote) ":" (alist-get
'path remote))))
+ (if file-or-directory
+ (progn
+ (require 'ediff)
+ (if (fboundp 'ediff-same-file-contents)
+ (progn
+ (message "Comparing file '%s' to '%s'.." path
command)
+ (if (ediff-same-file-contents path command)
+ (message "Files have identical contents.")
+ (ediff path command)))
+ (message "Function ediff-same-file-contents is
missing.")))
+ (progn
+ (message "Unfortunately directory differences are not yet
implemented.")))))))
+ (if debug
+ (message "Path '%s' is not in the root '%s' or is excluded from it."
path local-root)))))
+
+;;;### autoload
+(defun ssh-deploy-upload (local remote local-root async force)
+ "Upload LOCAL to REMOTE and LOCAL-ROOT via TRAMP, ASYNC determines if
transfer should be asynchronously or not, FORCE uploads despite external
change."
+ (if (and async (fboundp 'async-start))
+ (ssh-deploy--upload-via-tramp-async local remote local-root force)
+ (ssh-deploy--upload-via-tramp local remote local-root force)))
+
+;;;### autoload
+(defun ssh-deploy-download (remote local local-root async)
+ "Download REMOTE to LOCAL with the LOCAL-ROOT via TRAMP, ASYNC determines if
transfer should be asynchrous or not."
+ (if (and async (fboundp 'async-start))
+ (ssh-deploy--download-via-tramp-async remote local local-root)
+ (ssh-deploy--download-via-tramp remote local local-root)))
+
+
+;; HANDLERS - the idea is that these should be bound to various Emacs commands.
+
+
+;;;### autoload
(defun ssh-deploy-upload-handler ()
"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)
@@ -453,86 +621,7 @@
(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 ssh-deploy-root-remote)
- (path (file-truename buffer-file-name)))
- (if (and (ssh-deploy--file-is-in-path path local-root)
- (ssh-deploy--file-is-included path))
- (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()
- (if (file-exists-p ,remote-path)
- (progn
- (require 'ediff)
- (if (fboundp
'ediff-same-file-contents)
- (progn
- (if
(ediff-same-file-contents ,revision-path ,remote-path)
- (list 0 (format
"Remote file '%s' has not changed." ,remote-path))
- (progn
- (if
(ediff-same-file-contents ,path ,remote-path)
- (progn
- (copy-file
,path ,revision-path t t t t)
- (list 0
(format "External file '%s' is identical to local file '%s' but different to
local revision. Updated local revision." ,remote-path ,path)))
- (list 1 (format
"External file '%s' has changed, please download or diff." ,remote-path))))))
- (list 1 "Function
ediff-same-file-contents is missing.")))
- (list 0 (format "Remote file '%s'
doesn't exist." ,remote-path))))
- (lambda(return)
- (if (= (nth 0 return) 0)
- (message (nth 1 return))
- (display-warning "ssh-deploy" (nth
1 return) :warning)))))
- (progn
- (if (file-exists-p remote-path)
- (progn
- (require 'ediff)
- (if (fboundp
'ediff-same-file-contents)
- (progn
- (if (ediff-same-file-contents
revision-path remote-path)
- (message "Remote file '%s'
has not changed." remote-path)
- (display-warning
"ssh-deploy" (format "External file '%s' has changed, please download or diff."
remote-path) :warning)))
- (display-warning "ssh-deploy"
"Function ediff-same-file-contents is missing." :warning)))
- (message "Remote file '%s' doesn't
exist." remote-path)))))
- (progn
- (if (fboundp 'async-start)
- (progn
- (async-start
- `(lambda()
- (if (file-exists-p ,remote-path)
- (progn
- (require 'ediff)
- (if (fboundp
'ediff-same-file-contents)
- (progn
- (if
(ediff-same-file-contents ,path ,remote-path)
- (progn
- (copy-file ,path
,revision-path t t t t)
- (list 0 (format
"Remote file '%s' has not changed, created base revision." ,remote-path)))
- (list 1 (format
"External file has '%s' changed, please download or diff." ,remote-path))))
- (list 1 "Function
ediff-file-same-contents is missing")))
- (list 0 (format "Remote file '%s'
doesn't exist." ,remote-path))))
- (lambda(return)
- (if (= (nth 0 return) 0)
- (message (nth 1 return))
- (display-warning "ssh-deploy" (nth 1
return) :warning)))))
- (progn
- (if (file-exists-p remote-path)
- (progn
- (require 'ediff)
- (if (fboundp 'ediff-same-file-contents)
- (progn
- (if (ediff-same-file-contents
path remote-path)
- (progn
- (copy-file path
revision-path t t t t)
- (message "Remote file '%s'
has not changed, created base revision." remote-path))
- (display-warning "ssh-deploy"
(format "External file '%s' has changed, please download or diff." remote-path)
:warning)))
- (display-warning "ssh-deploy"
"Function ediff-same-file-contents is missing." :warning)))
- (message "Remote file '%s' doesn't exist."
remote-path)))))))))))))))
+ (ssh-deploy-remote-changes (file-truename ssh-deploy-root-local)
ssh-deploy-root-remote (file-truename buffer-file-name) ssh-deploy-async))))
;;;### autoload
(defun ssh-deploy-download-handler ()
@@ -577,14 +666,14 @@
(local-root (file-truename ssh-deploy-root-local))
(yes-no-prompt (read-string (format "Type 'yes' to confirm
that you want to delete the file '%s': " local-path))))
(if (string= yes-no-prompt "yes")
- (ssh-deploy--delete local-path local-root
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))
+ (ssh-deploy-delete local-path local-root
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* ((local-path (file-truename default-directory))
(local-root (file-truename ssh-deploy-root-local))
(yes-no-prompt (read-string (format "Type 'yes' to confirm
that you want to delete the directory '%s': " local-path))))
(if (string= yes-no-prompt "yes")
- (ssh-deploy--delete local-path local-root
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))))))
+ (ssh-deploy-delete local-path local-root
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))))))
;;;### autoload
(defun ssh-deploy-rename-handler ()
@@ -599,7 +688,7 @@
(new-local-path-tmp (read-file-name "New file name:"
(file-name-directory old-local-path) basename nil basename))
(new-local-path (file-truename new-local-path-tmp)))
(if (not (string= old-local-path new-local-path))
- (ssh-deploy--rename old-local-path new-local-path local-root
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))
+ (ssh-deploy-rename old-local-path new-local-path local-root
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* ((old-local-path (file-truename default-directory))
@@ -608,11 +697,11 @@
(new-local-path-tmp (read-file-name "New directory name:"
(file-name-directory old-local-path) basename nil basename))
(new-local-path (file-truename new-local-path-tmp)))
(if (not (string= old-local-path new-local-path))
- (ssh-deploy--rename old-local-path new-local-path local-root
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))))))
+ (ssh-deploy-rename old-local-path new-local-path local-root
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))))))
;;;### autoload
(defun ssh-deploy-remote-terminal-handler ()
- "Open remote host in tramp terminal it is configured for 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)))
@@ -626,67 +715,6 @@
(local-root (file-truename ssh-deploy-root-local)))
(ssh-deploy-browse-remote local-root ssh-deploy-root-remote
local-path))))
-;;;### 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
and the path PATH, DEBUG enables feedback message."
- (let ((file-or-directory (file-regular-p path)))
- (if (and (ssh-deploy--file-is-in-path path local-root)
- (ssh-deploy--file-is-included path))
- (progn
- (let ((remote-path (concat remote-root-string
(ssh-deploy--get-relative-path local-root path))))
- (let ((remote (ssh-deploy--parse-remote remote-path)))
- (let ((command (concat "/" (alist-get 'protocol remote) ":"
(alist-get 'username remote) "@" (alist-get 'server remote) ":" (alist-get
'path remote))))
- (if file-or-directory
- (progn
- (require 'ediff)
- (if (fboundp 'ediff-same-file-contents)
- (progn
- (message "Comparing file '%s' to '%s'.." path
command)
- (if (ediff-same-file-contents path command)
- (message "Files have identical contents.")
- (ediff path command)))
- (message "Function ediff-same-file-contents is
missing.")))
- (progn
- (message "Unfortunately directory differences are not yet
implemented.")))))))
- (if debug
- (message "Path '%s' is not in the root '%s' or is excluded from it."
path local-root)))))
-
-;;;### autoload
-(defun ssh-deploy-browse-remote (local-root remote-root-string path)
- "Browse relative to LOCAL-ROOT on REMOTE-ROOT-STRING the path PATH in
`dired-mode`."
- (if (and (ssh-deploy--file-is-in-path path local-root)
- (ssh-deploy--file-is-included path))
- (let ((remote-path (concat remote-root-string
(ssh-deploy--get-relative-path local-root path))))
- (let ((remote-root (ssh-deploy--parse-remote remote-path)))
- (let ((command (concat "/" (alist-get 'protocol remote-root) ":"
(alist-get 'username remote-root) "@" (alist-get 'server remote-root) ":"
(alist-get 'path remote-root))))
- (message "Opening '%s' for browsing on remote host.." command)
- (dired command))))))
-
-;;;### autoload
-(defun ssh-deploy-remote-terminal (remote-host-string)
- "Opens REMOTE-HOST-STRING in terminal."
- (let ((remote-root (ssh-deploy--parse-remote remote-host-string)))
- (if (string= (alist-get 'protocol remote-root) "ssh")
- (if (and (fboundp 'tramp-term)
- (fboundp 'tramp-term--initialize)
- (fboundp 'tramp-term--do-ssh-login))
- (progn
- (let ((hostname (concat (alist-get 'username remote-root) "@"
(alist-get 'server remote-root))))
- (let ((host (split-string hostname "@")))
- (message "Opening tramp-terminal for remote host
'address@hidden' and '%s'.." (car host) (car (last host)) hostname)
- (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")))))
- (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
- [elpa] externals/ssh-deploy 4a9dfb6 105/173: Added feature to open corresponding file on remote, (continued)
- [elpa] externals/ssh-deploy 4a9dfb6 105/173: Added feature to open corresponding file on remote, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy d8153b9 134/173: Improved configuration examples, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 3b69647 065/173: Whitespace fix, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 9107add 079/173: Fixed code notices in new code related to eshell integration, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy d117b9b 090/173: Improved documentation, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy af7f33c 082/173: Launch eshell and dired in base or current directory, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy ee808ac 098/173: Fixed whitespace in readme, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy ab4b80e 096/173: Detection for remote changes doesn't apply to directories, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy c65d282 087/173: Removed tramp-term functionality, supports native TRAMP strings, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy b483b3e 117/173: Improved handling of changing directory using let, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy b62abf2 073/173: Improved code structure and improved documentation,
Stefan Monnier <=
- [elpa] externals/ssh-deploy 810106a 093/173: Added feature to diff directories and fixed a bug, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy d1d68b9 128/173: Started with new menu in menu-bar, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 6134cd3 122/173: Added instructors for using remote shell terminal, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy c84f56c 131/173: Added Open command to menu as well, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy d0be946 124/173: Improved the salience of completion messages, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 53081a3 148/173: After downloading asynchronously associated buffer is reverted, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy fd7abe9 143/173: Mode-line status update for asynchronously deleted file working, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy e64a454 149/173: Starting ssh-deploy-mode-line on init, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 519939d 153/173: Fixes for mode-line status as stack, Stefan Monnier, 2018/10/20
- [elpa] externals/ssh-deploy 16a22f4 157/173: More (when (not to (unless conversions, Stefan Monnier, 2018/10/20