[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ssh-deploy b692b66: Merged changes from GitHub
|
From: |
Christian Johansson |
|
Subject: |
[elpa] externals/ssh-deploy b692b66: Merged changes from GitHub |
|
Date: |
Thu, 29 Nov 2018 01:00:22 -0500 (EST) |
branch: externals/ssh-deploy
commit b692b668520d1682253ff5cbb6bbce0d96243be8
Author: Christian Johansson <address@hidden>
Commit: Christian Johansson <address@hidden>
Merged changes from GitHub
* pre-defined hydra
* pre-defined prefix map
* fixed issue with boolean fallbacks on nil by using integer instead
---
README.md | 143 ++++-----
ssh-deploy-diff-mode.el | 265 +++++++---------
ssh-deploy.el | 790 +++++++++++++++++++++++++-----------------------
3 files changed, 589 insertions(+), 609 deletions(-)
diff --git a/README.md b/README.md
index ef8e619..5e5967a 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,5 @@
-# `emacs-ssh-deploy`
[](http://melpa.org/#/ssh-deploy)
[](http://stable.melpa.org/#/ssh-deploy)
+# `emacs-ssh-deploy`
+[](https://www.gnu.org/licenses/gpl-3.0.txt)
[](https://melpa.org/#/ssh-deploy)
[](https://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 TRAMP (including but not
limited to SSH, SFTP, FTP). It tries to provide functions that can be easily
used by custom scripts.
@@ -16,7 +17,7 @@ The `ssh-deploy` plug-in for Emacs makes it possible to
effortlessly deploy loca
* Open corresponding file on the remote host
* Open SQL database-session on remote hosts
* Run custom deployment scripts
-* All operations support asynchronous mode if `(make-thread`) or `async.el` is
installed. (You need to setup an automatic authorization for this, i.e.
`~/.netrc`, `~/.authinfo` or `~/.authinfo.gpg` and/or key-based password-less
authorization)
+* All operations support asynchronous mode if `(make-thread`) or `async.el` is
installed. (You need to setup an automatic authorization for this, i.e.
`~/.authinfo.gpg` and/or key-based password-less authorization)
The idea for this plug-in was to mimic the behavior of **PhpStorm** deployment
functionality.
@@ -28,72 +29,75 @@ 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 TRAMP root that is used for deployment
*(string)*
-* `ssh-deploy-debug` Enables debugging messages *(boolean)*
+* `ssh-deploy-debug` Enables debugging messages *(integer)*
* `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-on-explicit-save` Enabled automatic uploads on save *(boolean)*
+* `ssh-deploy-automatically-detect-remote-changes` Enables automatic detection
of remote changes *(integer)*
+* `ssh-deploy-on-explicit-save` Enabled automatic uploads on save *(integer)*
* `ssh-deploy-exclude-list` A list defining what paths to exclude from
deployment *(list)*
-* `ssh-deploy-async` Enables asynchronous transfers (you need to have
`(make-thread)` or `async.el` installed as well) *(boolean)*
+* `ssh-deploy-async` Enables asynchronous transfers (you need to have
`(make-thread)` or `async.el` installed as well) *(integer)*
* `ssh-deploy-remote-sql-database` Default database when connecting to remote
SQL database *(string)*
* `ssh-deploy-remote-sql-password` Default password when connecting to remote
SQL database *(string)*
* `ssh-deploy-remote-sql-port` - Default port when connecting to remote SQL
database *(integer)*
* `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)*
-* `ssh-deploy-script` - Your custom lambda function that will be called using
(funcall) when running deploy script handler
+* `ssh-deploy-verbose` Show messages in message buffer when starting and
ending actions *(integer)*
+* `ssh-deploy-script` - Your custom lambda function that will be called using
(funcall) when running deploy script handler *(function)*
+* `ssh-deploy-async-with-threads` - Whether to use threads (make threads)
instead of processes (async-start) for asynchronous operations *(integer)*
+
+When integers are used as booleans, above zero means true, zero means false
and nil means unset and fallback to global settings.
## Deployment configuration examples
-* Download ssh-deploy and place it at `~/.emacs.d/ssh-deploy/` or install via
`package.el` (`M-x list-packages` or `M-x package-install` + `ssh-deploy`) from
the `MELPA` repository.
+* Download ssh-deploy and place it at `~/.emacs.d/ssh-deploy/` or install via
`package.el` (`M-x list-packages` or `M-x package-install` + `ssh-deploy`) from
the `ELPA` or `MELPA` repository.
* So if you want to deploy `/Users/username/Web/MySite/` to create this
`DirectoryVariables` file in your project root at
`/Users/username/Web/MySite/.dir-locals.el`.
You really need to do a bit of research about how to connect via different
protocols using TRAMP on your operating system, I think Windows users should
use `plink` for most protocols. Linux should work out of the box and macOS
requires a bit of tweaking to get FTP support.
-### SSH, automatic uploads, SQL
+### SSH, with automatic uploads and SQL
``` emacs-lisp
((nil . (
(ssh-deploy-root-local . "/Users/username/Web/MySite/")
(ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/MySite/")
- (ssh-deploy-on-explicit-save . t)
+ (ssh-deploy-on-explicit-save . 1)
(ssh-deploy-remote-sql-database . "myuser")
(ssh-deploy-remote-sql-password . "mypassword")
(ssh-deploy-remote-sql-user . "myuser")
)))
```
-### SFTP, automatic uploads
+### SFTP, with automatic uploads
``` emacs-lisp
((nil . (
(ssh-deploy-root-local . "/Users/username/Web/MySite/")
(ssh-deploy-root-remote . "/sftp:address@hidden:/var/www/MySite/")
- (ssh-deploy-on-explicit-save . t)
+ (ssh-deploy-on-explicit-save . 1)
)))
```
-### SSH, custom port, not asynchronous, without automatic uploads
+### SSH, custom port 2120, not asynchronous and without automatic uploads
``` emacs-lisp
((nil . (
(ssh-deploy-root-local . "/Users/username/Web/MySite/")
(ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/MySite/")
- (ssh-deploy-on-explicit-save . nil)
- (ssh-deploy-async . nil)
+ (ssh-deploy-on-explicit-save . 0)
+ (ssh-deploy-async . 0)
)))
```
You can pipe remote connections as well like this:
-### SSH, not asynchronous, automatic uploads, piped to other user on remote
server and with custom deployment script.
+### SSH, not asynchronous, with automatic uploads, piped to other user on
remote server and with custom deployment script.
``` emacs-lisp
((nil . (
(ssh-deploy-root-local . "/Users/username/Web/MySite/")
(ssh-deploy-root-remote .
"/ssh:address@hidden|sudo:address@hidden:/var/www/MySite/")
- (ssh-deploy-async . nil)
- (ssh-deploy-on-explicit-save . t)
+ (ssh-deploy-async . 0)
+ (ssh-deploy-on-explicit-save . 1)
(ssh-deploy-script . (lambda() (let ((default-directory
ssh-deploy-root-remote))(shell-command "bash compile.sh"))))
)))
```
@@ -106,7 +110,7 @@ If you have a password-less sudo on your remote host you
should be to do this as
((nil . (
(ssh-deploy-root-local . "/Users/username/Web/MySite/")
(ssh-deploy-root-remote . "/ftp:address@hidden:/MySite/")
- (ssh-deploy-on-explicit-save . t)
+ (ssh-deploy-on-explicit-save . 1)
)))
```
@@ -127,7 +131,7 @@ Host remote-host
## Interaction-free password-based setup on *NIX systems
-For automatic **FTP** connections you need to setup `~/.netrc`, `~/.authinfo`
or `~/.authinfo.gpg` with your login credentials. An example of contents:
+For automatic **FTP** connections you need to setup `~/.authinfo.gpg` with
your login credentials. An example of contents:
``` shell
machine myserver.com login myuser port ftp password mypassword
@@ -139,7 +143,7 @@ Set your user and group as owner and file permissions to
`600`. Emacs should now
## Interaction-free SSH setup using public-key password-based authorization
-By combining a `~/.netrc`, `~/.authinfo` or `~/.authinfo.gpg` setup and a
`public-key` setup you should be able to have a interaction-free public-key
password-based authorization that can be used asynchronously.
+By combining a `~/.authinfo.gpg` setup and a `public-key` setup you should be
able to have a interaction-free public-key password-based authorization that
can be used asynchronously.
## Emacs configuration example
@@ -149,23 +153,16 @@ By combining a `~/.netrc`, `~/.authinfo` or
`~/.authinfo.gpg` setup and a `publi
;; ssh-deploy - prefix = C-c C-z, f = forced upload, u = upload, d = download,
x = diff, t = terminal, b = browse, h = shell
(add-to-list 'load-path "~/.emacs.d/ssh-deploy/")
(require 'ssh-deploy)
-(add-hook 'after-save-hook (lambda() (if (and (boundp
'ssh-deploy-on-explicit-save) ssh-deploy-on-explicit-save)
(ssh-deploy-upload-handler)) ))
-(add-hook 'find-file-hook (lambda() (if (and (boundp
'ssh-deploy-automatically-detect-remote-changes)
ssh-deploy-automatically-detect-remote-changes)
(ssh-deploy-remote-changes-handler)) ))
-(global-set-key (kbd "C-c C-z f") (lambda()
(interactive)(ssh-deploy-upload-handler-forced) ))
-(global-set-key (kbd "C-c C-z u") (lambda()
(interactive)(ssh-deploy-upload-handler) ))
-(global-set-key (kbd "C-c C-z D") (lambda()
(interactive)(ssh-deploy-delete-handler) ))
-(global-set-key (kbd "C-c C-z d") (lambda()
(interactive)(ssh-deploy-download-handler) ))
-(global-set-key (kbd "C-c C-z x") (lambda()
(interactive)(ssh-deploy-diff-handler) ))
-(global-set-key (kbd "C-c C-z t") (lambda()
(interactive)(ssh-deploy-remote-terminal-eshell-base-handler) ))
-(global-set-key (kbd "C-c C-z T") (lambda()
(interactive)(ssh-deploy-remote-terminal-eshell-handler) ))
-(global-set-key (kbd "C-c C-z h") (lambda()
(interactive)(ssh-deploy-remote-terminal-shell-base-handler) ))
-(global-set-key (kbd "C-c C-z H") (lambda()
(interactive)(ssh-deploy-remote-terminal-shell-handler) ))
-(global-set-key (kbd "C-c C-z R") (lambda()
(interactive)(ssh-deploy-rename-handler) ))
-(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-base-handler) ))
-(global-set-key (kbd "C-c C-z o") (lambda()
(interactive)(ssh-deploy-open-remote-file-handler) ))
-(global-set-key (kbd "C-c C-z m") (lambda()
(interactive)(ssh-deploy-remote-sql-mysql-handler) ))
-(global-set-key (kbd "C-c C-z s") (lambda()
(interactive)(ssh-deploy-run-deploy-script-handler) ))
+(ssh-deploy-line-mode) ;; If you want mode-line feature
+(ssh-deploy-add-menu) ;; If you want menu-bar feature
+(ssh-deploy-add-after-save-hook) ;; If you want automatic upload support
+(ssh-deploy-add-find-file-hook) ;; If you want detecting remote changes support
+(global-set-key (kbd "C-c C-z") 'ssh-deploy-prefix-map)
+```
+
+If you want to use the pre-defined hydra you can use this key-binding instead:
+``` elisp
+(global-set-key (kbd "C-c C-z") 'ssh-deploy-hydra/body)
```
* Or use the `use-package` and `hydra-script` I'm using:
@@ -174,51 +171,36 @@ By combining a `~/.netrc`, `~/.authinfo` or
`~/.authinfo.gpg` setup and a `publi
(use-package ssh-deploy
:ensure t
:demand
- :bind (("C-c C-z" . hydra-ssh-deploy/body))
- :hook ((after-save . (lambda() (if (and (boundp
'ssh-deploy-on-explicit-save) ssh-deploy-on-explicit-save)
(ssh-deploy-upload-handler)) ))
- (find-file . (lambda() (if (and (boundp
'ssh-deploy-automatically-detect-remote-changes)
ssh-deploy-automatically-detect-remote-changes)
(ssh-deploy-remote-changes-handler)) )))
+ :bind (("C-c C-z" . ssh-deploy-hydra/body))
+ :hook ((after-save . ssh-deploy-after-save)
+ (find-file . ssh-deploy-find-file))
:config
- (defhydra hydra-ssh-deploy (:color red :hint nil)
- "
- _u_: Upload _f_: Force Upload
- _d_: Download
- _D_: Delete
- _x_: Difference
- _t_: Eshell Base Terminal _T_: Eshell Relative Terminal
- _h_: Shell Base Terminal _H_: Shell Relative Terminal
- _e_: Detect Remote Changes
- _R_: Rename
- _b_: Browse Base _B_: Browse Relative
- _o_: Open current file on remote _m_: Open sql-mysql on remote
- _s_: Run deploy script
- "
- ("f" ssh-deploy-upload-handler-forced)
- ("u" ssh-deploy-upload-handler)
- ("d" ssh-deploy-download-handler)
- ("D" ssh-deploy-delete-handler)
- ("x" ssh-deploy-diff-handler)
- ("t" ssh-deploy-remote-terminal-eshell-base-handler)
- ("T" ssh-deploy-remote-terminal-eshell-handler)
- ("h" ssh-deploy-remote-terminal-shell-base-handler)
- ("H" ssh-deploy-remote-terminal-shell-handler)
- ("e" ssh-deploy-remote-changes-handler)
- ("R" ssh-deploy-rename-handler)
- ("b" ssh-deploy-browse-remote-base-handler)
- ("B" ssh-deploy-browse-remote-handler)
- ("o" ssh-deploy-open-remote-file-handler)
- ("m" ssh-deploy-remote-sql-mysql-handler)
- ("s" ssh-deploy-run-deploy-script-handler)))
+ (ssh-deploy-line-mode) ;; If you want mode-line feature
+ (ssh-deploy-add-menu) ;; If you want menu-bar feature
+ )
```
-(1) You can remove the `(add-to-list)` and `(require)` lines if you installed
via `MELPA` repository.
+(1) You can remove the `(add-to-list)` and `(require)` lines if you installed
via `ELPA` or `MELPA` repository.
* Restart Emacs or re-evaluate your *emacs-init-script*
## Example usage
+File contents `/Users/username/Web/MySite/.dir-locals.el`:
+
+``` emacs-lisp
+((nil . (
+ (ssh-deploy-root-local . "/Users/username/Web/MySite/")
+ (ssh-deploy-root-remote .
"/ssh:address@hidden|sudo:address@hidden:/var/www/MySite/")
+ (ssh-deploy-async . 1)
+ (ssh-deploy-on-explicit-save . 1)
+ (ssh-deploy-script . (lambda() (let ((default-directory
ssh-deploy-root-remote))(shell-command "bash compile.sh"))))
+)))
+```
+
* Now when you save a file somewhere under the directory
`/Users/username/Web/MySite/`, the script will launch and deploy the file with
the remote server.
* If you press `C-c C-z x` and the current buffer is a file, you will launch a
`ediff` session showing differences between local file and remote file via
TRAMP, or if current buffer is a directory it will open a buffer showing
directory differences
-* If you press `C-c C-z f` you will **force** upload local file or directory
to remote host even if they have external changes.
+w* If you press `C-c C-z f` you will **force** upload local file or directory
to remote host even if they have external changes.
* If you press `C-c C-z u` you will upload local file or directory to remote
host.
* If you press `C-c C-z d` you will download the current file or directory
from remote host and then reload current buffer.
* If you press `C-c C-z D` you will delete the current file or directory after
a confirmation on local and remote host.
@@ -248,9 +230,18 @@ macOS 10.13 removed the Darwin port of BSD `ftp` which is
needed for `ange-ftp`,
4. Type `./configure` then `make` and then `sudo make install`
5. Type `mv ./src/ftp /usr/local/bin/ftp`
+## TRAMP FTP doesn't read my ~/.authinfo.gpg
+
+Ange-FTP defaults to `~/.netrc` so you need to add this to your init script:
+
+``` elisp
+(setq ange-ftp-netrc-filename "~/.authinfo.gpg")
+```
+
## Read more
-* <http://www.gnu.org/software/tramp/>
-* <http://melpa.org/>
+* <https://www.gnu.org/software/tramp/>
+* <https://elpa.gnu.org/>
+* <https://melpa.org/>
* <https://www.emacswiki.org/emacs/DirectoryVariables>
* <https://www.emacswiki.org/emacs/EdiffMode>
* <https://github.com/jwiegley/emacs-async>
diff --git a/ssh-deploy-diff-mode.el b/ssh-deploy-diff-mode.el
index e6e077a..c6db269 100644
--- a/ssh-deploy-diff-mode.el
+++ b/ssh-deploy-diff-mode.el
@@ -1,12 +1,12 @@
-;;; ssh-deploy-diff-mode.el --- Mode for interactive directory differences
+;;; ssh-deploy-diff-mode.el --- Mode for interactive directory differences
-*- lexical-binding:t -*-
;; Copyright (C) 2017-2018 Free Software Foundation, Inc.
-;; Author: Christian Johansson <github.com/cjohansson>
-;; Maintainer: Christian Johansson <github.com/cjohansson>
+;; Author: Christian Johansson <address@hidden>
+;; Maintainer: Christian Johansson <address@hidden>
;; Created: 1 Feb 2018
-;; Modified: 23 Feb 2018
-;; Version: 1.14
+;; Modified: 28 Nov 2018
+;; Version: 2.0
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-ssh-deploy
@@ -34,45 +34,34 @@
;;; 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--action-open 6 "Action for open file.")
+(autoload 'ssh-deploy-diff-directories "ssh-deploy")
+(autoload 'ssh-deploy-upload "ssh-deploy")
+(autoload 'ssh-deploy-download "ssh-deploy")
+(autoload 'ssh-deploy-delete-both "ssh-deploy")
+(autoload 'ssh-deploy-delete "ssh-deploy")
+(autoload 'ssh-deploy-diff-files "ssh-deploy")
(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"
- )
+ '(
+ "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
+(defconst ssh-deploy-diff-mode--font-lock-keywords
+ (let ((regex (concat "\\<" (regexp-opt ssh-deploy-diff-mode--keywords t)
"\\>")))
(list
`(,regex . font-lock-builtin-face)
- '("\\('\\w*'\\)" . font-lock-variable-name-face))
- "Minimal highlighting expressions for SSH Deploy Diff major mode."))
+ '("\\('\\w*'\\)" . font-lock-variable-name-face)))
+ "Minimal highlighting expressions for SSH Deploy Diff major mode.")
-(defvar ssh-deploy-diff-mode--map
+(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)
@@ -84,13 +73,13 @@
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-open-handler() "Start the open action."
(interactive)(ssh-deploy-diff-mode--action-handler
ssh-deploy-diff-mode--action-open))
+(defun ssh-deploy-diff-mode-copy-handler() "Start the copy action."
(interactive)(ssh-deploy-diff-mode--action-handler
#'ssh-deploy-diff-mode--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--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--copy-b))
+(defun ssh-deploy-diff-mode-delete-handler() "Start the delete action."
(interactive)(ssh-deploy-diff-mode--action-handler
#'ssh-deploy-diff-mode--delete))
+(defun ssh-deploy-diff-mode-difference-handler() "Start the difference
action." (interactive)(ssh-deploy-diff-mode--action-handler
#'ssh-deploy-diff-mode--difference))
+(defun ssh-deploy-diff-mode-refresh-handler() "Start the refresh action."
(interactive)(ssh-deploy-diff-mode--action-handler
#'ssh-deploy-diff-mode--refresh))
+(defun ssh-deploy-diff-mode-open-handler() "Start the open action."
(interactive)(ssh-deploy-diff-mode--action-handler
#'ssh-deploy-diff-mode--open))
(defun ssh-deploy-diff-mode--get-parts ()
"Return current file and section if any."
@@ -109,14 +98,17 @@
(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)))
+ (setq section (replace-regexp-in-string ": ([0-9]+)\\'" ""
section))
+ (setq section
+ (pcase section
+ ("DIRECTORY A" 'directory-a)
+ ("DIRECTORY B" 'directory-b)
+ ("EXCLUDE-LIST" 'exclude-list)
+ ("FILES ONLY IN A" 'only-in-a)
+ ("FILES ONLY IN B" 'only-in-b)
+ ("FILES IN BOTH BUT DIFFERS" 'in-both)
+ (_ (message "Could not find section %s" section)
+ section)))
(while (and (> (line-number-at-pos) 1)
(not (looking-at "^DIRECTORY B:")))
(forward-line -1))
@@ -141,68 +133,50 @@
(interactive)
(let ((parts (ssh-deploy-diff-mode--get-parts)))
(if (not (eq parts nil))
- (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))
- ((and (not (null (nth 0 parts))) (= action
ssh-deploy-diff-mode--action-open)) (ssh-deploy-diff-mode--open parts))
- ((= action ssh-deploy-diff-mode--action-refresh)
(ssh-deploy-diff-mode--refresh parts))
- (t (message "Found nothing to do in the section for action %s"
action)))
- (message "Found nothing to do"))))
+ (cond
+ ((null parts) (message "Found nothing to do"))
+ ((not (or (nth 0 parts)
+ ;; FIXME: Comparing equality of functions is bad karma!
+ (eq action #'ssh-deploy-diff-mode--refresh)))
+ (message "Found nothing to do in the section for action %s"
+ (replace-regexp-in-string "ssh-deploy-diff-mode--" ""
+ (format "%s" action))))
+ (t (funcall action parts))))))
(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))
- (async (cond ((boundp 'ssh-deploy-async) ssh-deploy-async)(t nil)))
- (exclude-list (cond ((boundp 'ssh-deploy-exclude-list)
ssh-deploy-exclude-list)(t nil))))
- (progn
- (kill-this-buffer)
- (ssh-deploy-diff-directories root-local root-remote exclude-list
async)))))
+ (let ((root-local (nth 2 parts))
+ (root-remote (nth 3 parts)))
+ (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 (file-truename (nth 2 parts)))
(root-remote (nth 3 parts))
- (path-local (file-truename (concat root-local file-name)))
- (path-remote (concat root-remote file-name))
- (section (nth 1 parts))
- (async (cond ((boundp 'ssh-deploy-async) ssh-deploy-async)(t nil)))
- (revision-folder (cond ((boundp 'ssh-deploy-revision-folder)
ssh-deploy-revision-folder)(t nil))))
- (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 t async
revision-folder))
- ((= section ssh-deploy-diff-mode--section-only-in-b)
- (ssh-deploy-download path-remote path-local async
revision-folder))
- (t (message "Copy is not available in this section")))
- (display-warning 'ssh-deploy "Function ssh-deploy-download or
ssh-deploy-upload is missing" :warning))))
+ (path-local (file-truename (expand-file-name file-name root-local)))
+ (path-remote (expand-file-name file-name root-remote))
+ (section (nth 1 parts)))
+ (pcase section
+ ('only-in-a
+ (ssh-deploy-upload path-local path-remote 1))
+ ('only-in-b
+ (ssh-deploy-download path-remote path-local))
+ (_ (message "Copy is not available in this section")))))
(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 (file-truename (nth 2 parts)))
(root-remote (nth 3 parts))
- (path-local (file-truename (concat root-local file-name)))
- (path-remote (concat root-remote file-name))
- (async (cond ((boundp 'ssh-deploy-async) ssh-deploy-async)(t nil)))
- (revision-folder (cond ((boundp 'ssh-deploy-revision-folder)
ssh-deploy-revision-folder)(t nil))))
- (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 async
revision-folder))
- (t "Copy A is not available in this section"))
- (display-warning 'ssh-deploy "Function ssh-deploy-upload is missing"
:warning))))
+ (path-local (file-truename (expand-file-name file-name root-local)))
+ (path-remote (expand-file-name file-name root-remote)))
+ (cond ((memq section '(only-in-a in-both))
+ (ssh-deploy-upload path-local path-remote 1))
+ (t (message "Copy A is not available in this section")))))
(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."
@@ -211,56 +185,42 @@
(file-name (nth 0 parts))
(root-local (file-truename (nth 2 parts)))
(root-remote (nth 3 parts))
- (path-local (file-truename (concat root-local file-name)))
- (path-remote (concat root-remote file-name))
- (async (cond ((boundp 'ssh-deploy-async) ssh-deploy-async)(t nil)))
- (revision-folder (cond ((boundp 'ssh-deploy-revision-folder)
ssh-deploy-revision-folder)(t nil))))
- (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 async
revision-folder))
- (t "Copy B is not available in this section"))
- (display-warning 'ssh-deploy "Function ssh-deploy-download is missing"
:warning))))
+ (path-local (file-truename (expand-file-name file-name root-local)))
+ (path-remote (expand-file-name file-name root-remote)))
+ (cond ((memq section '(only-in-b in-both))
+ (ssh-deploy-download path-remote path-local))
+ (t (message "Copy B is not available in this section")))))
(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 (file-truename (concat root-local file-name)))
- (path-remote (file-truename (concat root-remote file-name)))
- (async (cond ((boundp 'ssh-deploy-async) ssh-deploy-async)(t nil)))
- (debug (cond ((boundp 'ssh-deploy-debug) ssh-deploy-debug)(t nil)))
- (exclude-list (cond ((boundp 'ssh-deploy-exclude-list)
ssh-deploy-exclude-list)(t nil)))
- (revision-folder (cond ((boundp 'ssh-deploy-revision-folder)
ssh-deploy-revision-folder)(t nil))))
- (if (and (fboundp 'ssh-deploy-delete)
- (fboundp 'ssh-deploy-delete-both))
- (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-both path-local root-local root-remote
async debug exclude-list))))
- ((= section ssh-deploy-diff-mode--section-only-in-a)
(ssh-deploy-delete path-local async debug))
- ((= section ssh-deploy-diff-mode--section-only-in-b)
(ssh-deploy-delete path-remote async debug))
- ((= section ssh-deploy-diff-mode--section-in-both)
(ssh-deploy-delete-both path-local root-local root-remote async debug
exclude-list))
- (t (message "Delete is not available in this section")))
- (display-warning 'ssh-deploy "Function ssh-deploy-delete or
ssh-deploy-delete-both is missing" :warning))))
+ (path-local (file-truename (expand-file-name file-name root-local)))
+ (path-remote (expand-file-name file-name root-remote)))
+ (pcase 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-both path-local))))
+ ('only-in-a
+ (ssh-deploy-delete path-local))
+ ('only-in-b
+ (ssh-deploy-delete path-remote))
+ (_ (message "Delete is not available in this section")))))
(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 (file-truename (nth 2 parts)))
- (root-remote (nth 3 parts))
- (path-local (file-truename (concat root-local file-name)))
- (path-remote (concat root-remote file-name)))
- (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.")))
+ (if (eq section 'in-both)
+ (let* ((file-name (nth 0 parts))
+ (root-local (file-truename (nth 2 parts)))
+ (root-remote (nth 3 parts))
+ (path-local (file-truename (expand-file-name file-name
root-local)))
+ (path-remote (expand-file-name file-name root-remote)))
+ (ssh-deploy-diff-files path-local path-remote))
+ (message "File must exists in both roots to perform a difference
action."))))
(defun ssh-deploy-diff-mode--open (parts)
"Perform a open file action based on PARTS from section A or section B."
@@ -269,28 +229,21 @@
(file-name (nth 0 parts))
(root-local (file-truename (nth 2 parts)))
(root-remote (nth 3 parts))
- (path-local (file-truename (concat root-local file-name)))
- (path-remote (concat root-remote file-name)))
- (cond ((= section ssh-deploy-diff-mode--section-only-in-a)
- (progn
- (message "Opening file '%s'" path-local)
- (find-file path-local)))
- ((= section ssh-deploy-diff-mode--section-only-in-b)
- (progn
- (message "Opening file '%s'" path-remote)
- (find-file path-remote)))
- (t (message "Open is not available in this section")))))
-
-(defun ssh-deploy-diff-mode ()
+ (path-local (file-truename (expand-file-name file-name root-local)))
+ (path-remote (expand-file-name file-name root-remote)))
+ (pcase section
+ ('only-in-a
+ (message "Opening file '%s'" path-local)
+ (find-file path-local))
+ ('only-in-b
+ (message "Opening file '%s'" path-remote)
+ (find-file path-remote))
+ (_ (message "Open is not available in this section")))))
+
+(define-derived-mode ssh-deploy-diff-mode special-mode "SSH-Deploy-Diff"
"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))
+ (set (make-local-variable 'font-lock-defaults)
+ '(ssh-deploy-diff-mode--font-lock-keywords)))
(provide 'ssh-deploy-diff-mode)
diff --git a/ssh-deploy.el b/ssh-deploy.el
index c965879..1ee612d 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -2,11 +2,11 @@
;; Copyright (C) 2017-2018 Free Software Foundation, Inc.
-;; Author: Christian Johansson <github.com/cjohansson>
+;; Author: Christian Johansson <address@hidden>
;; Maintainer: Christian Johansson <address@hidden>
;; Created: 5 Jul 2016
-;; Modified: 19 Aug 2018
-;; Version: 2.0
+;; Modified: 28 Nov 2018
+;; Version: 3.0
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-ssh-deploy
@@ -40,98 +40,63 @@
;; ssh-deploy-root-local,ssh-deploy-root-remote, ssh-deploy-on-explicit-save
;; you can setup a directory for TRAMP deployment.
;;
-;; For asynchronous transfers you need to setup ~/.netrc, ~/.authinfo or
~/.authinfo.gpg or key-based authorization or equivalent for automatic
authentication.
+;; For asynchronous transfers you need to setup ~/.authinfo.gpg or key-based
authorization or equivalent for automatic authentication.
;;
-;; Example contents of ~/.netrc, ~/.authinfo or ~/.authinfo.gpg for
password-based interaction-free authentication:
+;; Example contents of ~/.authinfo.gpg for password-based interaction-free
authentication:
;; machine myserver.com login myuser port ftp password mypassword
;; machine myserver2.com login myuser2 port ssh password mypassword2
;; machine myserver3.com login myuser3 port sftp password mypassword3
;;
;; Set permissions to this file to 600 with your user as the owner.
;;
-;; - To setup an upload hook on save do this:
-;; (add-hook 'after-save-hook
-;; (lambda () (if (bound-and-true-p ssh-deploy-on-explicit-save)
-;; (ssh-deploy-upload-handler))))
+;; If your not using ~/.netrc for FTP information you need to specify what
file your using with:
+;; (setq ange-ftp-netrc-filename "~/.authinfo.gpg")
+;;
+;; - To setup a upload hook on save do this:
+;; Add to init-script: (ssh-deploy-add-after-save-hook)
;;
;; - To setup automatic storing of base revisions and detection of remote
changes do this:
-;; (add-hook 'find-file-hook
-;; (lambda ()
-;; (if (bound-and-true-p
ssh-deploy-automatically-detect-remote-changes)
-;; (ssh-deploy-remote-changes-handler)) ))
+;; Add to init-script: (ssh-deploy-add-find-file-hook)
+;;
+;; - To enable mode-line feature do this:
+;; (ssh-deploy-line-mode)
;;
-;; - To set key-bindings do something like this:
+;; - To enable menu-bar feature do this:
+;; (ssh-deploy-add-menu)
;;
-;; (global-set-key (kbd "C-c C-z f") 'ssh-deploy-upload-handler-forced)
-;; (global-set-key (kbd "C-c C-z u") 'ssh-deploy-upload-handler)
-;; (global-set-key (kbd "C-c C-z D") 'ssh-deploy-delete-handler)
-;; (global-set-key (kbd "C-c C-z d") 'ssh-deploy-download-handler)
-;; (global-set-key (kbd "C-c C-z x") 'ssh-deploy-diff-handler)
-;; (global-set-key (kbd "C-c C-z t")
'ssh-deploy-remote-terminal-eshell-base-handler)
-;; (global-set-key (kbd "C-c C-z T")
'ssh-deploy-remote-terminal-eshell-handler)
-;; (global-set-key (kbd "C-c C-z h")
'ssh-deploy-remote-terminal-shell-base-handler)
-;; (global-set-key (kbd "C-c C-z H")
'ssh-deploy-remote-terminal-shell-handler)
-;; (global-set-key (kbd "C-c C-z R") 'ssh-deploy-rename-handler)
-;; (global-set-key (kbd "C-c C-z e") 'ssh-deploy-remote-changes-handler)
-;; (global-set-key (kbd "C-c C-z b")
'ssh-deploy-browse-remote-base-handler)
-;; (global-set-key (kbd "C-c C-z B") 'ssh-deploy-browse-remote-handler)
-;; (global-set-key (kbd "C-c C-z o") 'ssh-deploy-open-remote-file-handler)
-;; (global-set-key (kbd "C-c C-z m") 'ssh-deploy-remote-sql-mysql-handler)
-;; (global-set-key (kbd "C-c C-z s") 'ssh-deploy-run-deploy-script-handler)
+;; - To set global key-bindings do something like this:
+;; (global-set-key (kbd "C-c C-z") 'ssh-deploy-prefix-map)
+;;
+;; - To set global key-bindings for the pre-defined hydra do something like
this:
+;; (global-set-key (kbd "C-c C-z") 'ssh-deploy-hydra/body)
;;
;; - To install and set-up using use-package and hydra do this:
;; (use-package ssh-deploy
;; :ensure t
;; :demand
-;; :bind (("C-c C-z" . hydra-ssh-deploy/body))
-;; :hook ((after-save . (lambda () (if (bound-and-true-p
ssh-deploy-on-explicit-save) (ssh-deploy-upload-handler)) ))
-;; (find-file . (lambda () (if (bound-and-true-p
ssh-deploy-automatically-detect-remote-changes)
(ssh-deploy-remote-changes-handler)) )))
+;; :bind (("C-c C-z" . ssh-deploy-hydra/body))
+;; :hook ((after-save . ssh-deploy-after-save)
+;; (find-file . ssh-deploy-find-file))
;; :config
-;; (defhydra hydra-ssh-deploy (:color red :hint nil)
-;; "
-;; _u_: Upload _f_: Force Upload
-;; _d_: Download
-;; _D_: Delete
-;; _x_: Difference
-;; _t_: Eshell Base Terminal _T_: Eshell Relative Terminal
-;; _h_: Shell Base Terminal _H_: Shell Relative Terminal
-;; _e_: Detect Remote Changes
-;; _R_: Rename
-;; _b_: Browse Base _B_: Browse Relative
-;; _o_: Open current file on remote _m_: Open sql-mysql on remote
-;; _s_: Run deploy script
-;; "
-;; ("f" ssh-deploy-upload-handler-forced)
-;; ("u" ssh-deploy-upload-handler)
-;; ("d" ssh-deploy-download-handler)
-;; ("D" ssh-deploy-delete-handler)
-;; ("x" ssh-deploy-diff-handler)
-;; ("t" ssh-deploy-remote-terminal-eshell-base-handler)
-;; ("T" ssh-deploy-remote-terminal-eshell-handler)
-;; ("h" ssh-deploy-remote-terminal-shell-base-handler)
-;; ("H" ssh-deploy-remote-terminal-shell-handler)
-;; ("e" ssh-deploy-remote-changes-handler)
-;; ("R" ssh-deploy-rename-handler)
-;; ("b" ssh-deploy-browse-remote-base-handler)
-;; ("B" ssh-deploy-browse-remote-handler)
-;; ("o" ssh-deploy-open-remote-file-handler)
-;; ("m" ssh-deploy-remote-sql-mysql-handler)
-;; ("s" ssh-deploy-run-deploy-script-handler)))
+;; (ssh-deploy-line-mode) ;; If you want mode-line feature
+;; (ssh-deploy-add-menu) ;; If you want menu-bar feature
+;; )
+;;
;;
;; Here is an example for SSH deployment,
/Users/Chris/Web/Site1/.dir-locals.el:
;; ((nil . (
;; (ssh-deploy-root-local . "/Users/Chris/Web/Site1/")
;; (ssh-deploy-root-remote . "/ssh:address@hidden:/var/www/site1/")
-;; (ssh-deploy-on-explicit-save . t)
-;; (ssh-deploy-async . t)
+;; (ssh-deploy-on-explicit-save . 1)
+;; (ssh-deploy-async . 1)
;; )))
;;
;; Here is an example for SFTP deployment,
/Users/Chris/Web/Site2/.dir-locals.el:
;; ((nil . (
;; (ssh-deploy-root-local . "/Users/Chris/Web/Site2/")
;; (ssh-deploy-root-remote . "/sftp:address@hidden:/var/www/site2/")
-;; (ssh-deploy-on-explicit-save . nil)
-;; (ssh-deploy-async . nil)
+;; (ssh-deploy-on-explicit-save . 0)
+;; (ssh-deploy-async . 0)
;; (ssh-deploy-script . (lambda() (let ((default-directory
ssh-deploy-root-remote))(shell-command "bash compile.sh"))))
;; )))
;;
@@ -142,33 +107,34 @@
;; )))
;;
;;
-;; Now when you are in a directory which is configured for deployment.
-;;
;; 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 TRAMP root that is used for
deployment *(string)*
-;; * `ssh-deploy-debug' - Enables debugging messages *(boolean)*
+;; * `ssh-deploy-debug' - Enables debugging messages *(integer)*
;; * `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-on-explicit-save' - Enabled automatic uploads on save
*(boolean)*
-;; * `ssh-deploy-exclude-list' - A list defining what paths to exclude from
deployment *(list)*
-;; * `ssh-deploy-async' - Enables asynchronous transfers (you need to have
`(make-thread)` or `async.el` available as well) *(boolean)*
+;; * `ssh-deploy-automatically-detect-remote-changes' - Enables automatic
detection of remote changes *(integer)*
+;; * `ssh-deploy-on-explicit-save' - Enabled automatic uploads on save
*(integer)*
+;; * `ssh-deploy-exclude-list' - A list defining what file names to exclude
from deployment *(list)*
+;; * `ssh-deploy-async' - Enables asynchronous transfers (you need to have
`(make-thread)` or `async.el` available as well) *(integer)*
;; * `ssh-deploy-remote-sql-database' - Default database when connecting to
remote SQL database *(string)*
;; * `ssh-deploy-remote-sql-password' - Default password when connecting to
remote SQL database *(string)*
;; * `ssh-deploy-remote-sql-port' - Default port when connecting to remote SQL
database *(integer)*
;; * `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)*
-;; * `ssh-deploy-script' - Our custom lambda function that will be called
using (funcall) when running deploy script
+;; * `ssh-deploy-remote-shell-executable' - Default shell executable when
launching shell on remote host *(string)*
+;; * `ssh-deploy-verbose' - Show messages in message buffer when starting and
ending actions *(integer)*
+;; * `ssh-deploy-script' - Our custom lambda function that will be called
using (funcall) when running deploy script *(function)*
+;; * `ssh-deploy-async-with-threads' - Whether to use threads (make threads)
instead of processes (async-start) for asynchronous operations *(integer)*
+;;
+;; When integers are used as booleans, above zero means true, zero means false
and nil means unset and fallback to global settings.
;;
-;; Please see README.md from the same repository for extended documentation.
+;; Please see README.md from the same repository for more extended
documentation.
;;; Code:
-(autoload 'ssh-deploy-diff-mode "ssh-deploy-diff-mode"
- "Major mode for SSH Deploy interactive directory differences.")
+
+(autoload 'ssh-deploy-diff-mode "ssh-deploy-diff-mode")
(defgroup ssh-deploy nil
"Upload, download, difference, browse and terminal handler for files and
directories on remote hosts via TRAMP."
@@ -187,45 +153,57 @@
(put 'ssh-deploy-root-remote 'permanent-local t)
(put 'ssh-deploy-root-remote 'safe-local-variable 'stringp)
-(defcustom ssh-deploy-on-explicit-save t
- "Boolean variable if deploy should be made on explicit save, t by default."
+(defcustom ssh-deploy-on-explicit-save 1
+ "Boolean variable if deploy should be made on explicit save, 1 by default."
:type 'boolean)
(put 'ssh-deploy-on-explicit-save 'permanent-local t)
-(put 'ssh-deploy-on-explicit-save 'safe-local-variable 'booleanp)
+(put 'ssh-deploy-on-explicit-save 'safe-local-variable 'integerp)
-(defcustom ssh-deploy-debug nil
- "Boolean variable if debug messages should be shown, nil by default."
+(defcustom ssh-deploy-debug 0
+ "Boolean variable if debug messages should be shown, 0 by default."
:type 'boolean)
(put 'ssh-deploy-debug 'permanent-local t)
-(put 'ssh-deploy-debug 'safe-local-variable 'booleanp)
+(put 'ssh-deploy-debug 'safe-local-variable 'integerp)
;; TODO This flag needs to work better, you should not miss any useful
notifications when this is on
-(defcustom ssh-deploy-verbose t
- "Boolean variable if debug messages should be shown, t by default."
+(defcustom ssh-deploy-verbose 1
+ "Boolean variable if debug messages should be shown, 1 by default."
:type 'boolean)
(put 'ssh-deploy-verbose 'permanent-local t)
-(put 'ssh-deploy-verbose 'safe-local-variable 'booleanp)
+(put 'ssh-deploy-verbose 'safe-local-variable 'integerp)
-(defcustom ssh-deploy-async t
- "Boolean variable if asynchronous method for transfers should be used, t by
default."
+(defcustom ssh-deploy-async 0
+ "Boolean variable if asynchronous method for transfers should be used, 0 by
default."
:type 'boolean)
(put 'ssh-deploy-async 'permanent-local t)
-(put 'ssh-deploy-async 'safe-local-variable 'booleanp)
+(put 'ssh-deploy-async 'safe-local-variable 'integerp)
+
+(defcustom ssh-deploy-async-with-threads 0
+ "Boolean variable if asynchronous method should use threads if available, 0
by default."
+ :type 'boolean)
+(put 'ssh-deploy-async-with-threads 'permanent-local t)
+(put 'ssh-deploy-async-with-threads 'safe-local-variable 'integerp)
+
+(defcustom ssh-deploy-async-with-threads 0
+ "Boolean variable if asynchronous method should use threads if available, 0
by default."
+ :type 'boolean)
+(put 'ssh-deploy-async-with-threads 'permanent-local t)
+(put 'ssh-deploy-async-with-threads 'safe-local-variable 'integerp)
(defcustom ssh-deploy-revision-folder "~/.ssh-deploy-revisions/"
- "String variable with path to revisions with trailing slash."
+ "String variable with file name to revisions with trailing slash."
:type 'string)
(put 'ssh-deploy-revision-folder 'permanent-local t)
(put 'ssh-deploy-revision-folder 'safe-local-variable 'stringp)
-(defcustom ssh-deploy-automatically-detect-remote-changes t
- "Detect remote changes and store base revisions automatically, t by default."
+(defcustom ssh-deploy-automatically-detect-remote-changes 1
+ "Detect remote changes and store base revisions automatically, 1 by default."
:type 'boolean)
(put 'ssh-deploy-automatically-detect-remote-changes 'permanent-local t)
-(put 'ssh-deploy-automatically-detect-remote-changes 'safe-local-variable
'booleanp)
+(put 'ssh-deploy-automatically-detect-remote-changes 'safe-local-variable
'integerp)
(defcustom ssh-deploy-exclude-list '(".git/" ".dir-locals.el")
- "List of strings that if found in paths will exclude paths from sync,
'(\"/.git\"/' \".dir-locals.el\") by default."
+ "List of strings that if found in file name will exclude it from sync,
'(\"/.git\"/' \".dir-locals.el\") by default."
:type 'list)
(put 'ssh-deploy-exclude-list 'permanent-local t)
(put 'ssh-deploy-exclude-list 'safe-local-variable 'listp)
@@ -250,7 +228,8 @@
(defcustom ssh-deploy-remote-sql-server nil
"String variable of remote sql server, nil by default."
- :type 'string)
+ :type 'string
+ :group 'ssh-deploy)
(put 'ssh-deploy-remote-sql-server 'permanent-local t)
(put 'ssh-deploy-remote-sql-server 'safe-local-variable 'stringp)
@@ -261,14 +240,14 @@
(put 'ssh-deploy-remote-sql-user 'safe-local-variable 'stringp)
(defcustom ssh-deploy-remote-shell-executable nil
- "String variable of remote shell executable server, nil by default."
+ "String variable of remote server shell executable, nil by default."
:type 'string)
(put 'ssh-deploy-remote-shell-executable 'permanent-local t)
(put 'ssh-deploy-remote-shell-executable 'safe-local-variable 'stringp)
(defcustom ssh-deploy-script nil
"Lambda function to run with `funcall' when
`ssh-deploy-run-deploy-script-handler' is executed."
- :type 'lambda)
+ :type 'function)
(put 'ssh-deploy-script 'permanent-local t)
(put 'ssh-deploy-script 'safe-local-variable 'functionp)
@@ -306,12 +285,27 @@
;; these functions MUST not use module variables in any way.
-(defun ssh-deploy--async-process (start &optional finish)
- "Asynchronously do START and then optionally do FINISH."
- (if (fboundp 'make-thread)
- (make-thread (lambda () (funcall finish (funcall start))))
+(defun ssh-deploy--async-process (start &optional finish async-with-threads)
+ "Asynchronously do START and then optionally do FINISH, use multi-treading
if ASYNC-WITH-THREADS is above 0 otherwise use multi processes via async.el."
+ (if (and (fboundp 'make-thread)
+ async-with-threads
+ (> async-with-threads 0))
+ (make-thread (lambda()
+ (if start
+ (let ((result (funcall start)))
+ (if finish
+ (funcall finish result))))))
(if (fboundp 'async-start)
- (async-start start finish)
+ (if start
+ (let ((ftp-netrc nil))
+ (when (boundp 'ange-ftp-netrc-filename)
+ (setq ftp-netrc ange-ftp-netrc-filename))
+ (async-start
+ (lambda()
+ (if ftp-netrc
+ (defvar ange-ftp-netrc-filename ftp-netrc))
+ (funcall start))
+ finish)))
(display-warning 'ssh-deploy "Neither make-thread nor async-start
functions are available!"))))
(defun ssh-deploy--mode-line-set-status-and-update (status &optional filename)
@@ -320,26 +314,20 @@
(let ((buffer (find-buffer-visiting filename)))
(when buffer
(with-current-buffer buffer
- (unless (listp ssh-deploy--mode-line-status)
- (setq ssh-deploy--mode-line-status '()))
(push status ssh-deploy--mode-line-status)
;; (message "SSH Deploy - Updated status to: %s"
ssh-deploy--mode-line-status)
(ssh-deploy--mode-line-status-refresh))))
(progn
- (unless (listp ssh-deploy--mode-line-status)
- (setq ssh-deploy--mode-line-status '()))
(push status ssh-deploy--mode-line-status)
;; (message "SSH Deploy - Updated status to: %s"
ssh-deploy--mode-line-status)
(ssh-deploy--mode-line-status-refresh))))
(defun ssh-deploy--mode-line-status-refresh ()
"Refresh the status text based on the status variable."
- (unless (listp ssh-deploy--mode-line-status)
- ;; (message "Resetting status: %s" ssh-deploy--mode-line-status)
- (setq ssh-deploy--mode-line-status '()))
(let ((status (pop ssh-deploy--mode-line-status)))
;; (message "SSH Deploy - Refreshing status based on: %s" status)
- (ssh-deploy--mode-line-status-update status)))
+ (when status
+ (ssh-deploy--mode-line-status-update status))))
(defun ssh-deploy--mode-line-status-update (&optional status)
"Update the local status text variable to a text representation based on
STATUS."
@@ -356,7 +344,7 @@
(setq status-text "ul.."))
((= status ssh-deploy--status-deleting)
- (setq status-text ".."))
+ (setq status-text "rm.."))
((= status ssh-deploy--status-renaming)
(setq status-text "mv.."))
@@ -364,6 +352,9 @@
((= status ssh-deploy--status-detecting-remote-changes)
(setq status-text "diff.."))
+ ((and ssh-deploy-root-local ssh-deploy-root-remote)
+ (setq status-text "idle"))
+
(t (setq status-text ""))
)
@@ -377,7 +368,7 @@
"Return a formatted string based on TEXT."
(if (string= text "")
""
- (format " [DPL:%s] " text)))
+ (format " {DPLY:%s} " text)))
(defun ssh-deploy--insert-keyword (text)
"Insert TEXT as bold text."
@@ -388,7 +379,7 @@
"Generate revision-path for PATH in ROOT."
(if (not (file-exists-p root))
(make-directory root))
- (concat root (replace-regexp-in-string "\\(/\\|@\\|:\\)" "_" path)))
+ (expand-file-name (replace-regexp-in-string "\\(/\\|@\\|:\\)" "_" path)
root))
(defun ssh-deploy--file-is-in-path (file path)
"Return non-nil if FILE is in the path PATH."
@@ -412,18 +403,18 @@
(and (not (null string))
(not (zerop (length string)))))
-(defun ssh-deploy--upload-via-tramp-async (path-local path-remote force
revision-folder)
- "Upload PATH-LOCAL to PATH-REMOTE via TRAMP asynchronously and FORCE upload
despite remote change, check for revisions in REVISION-FOLDER."
+(defun ssh-deploy--upload-via-tramp-async (path-local path-remote force
revision-folder async-with-threads)
+ "Upload PATH-LOCAL to PATH-REMOTE via TRAMP asynchronously and FORCE upload
despite remote change, check for revisions in REVISION-FOLDER. Use
multi-treaded async if ASYNC-WITH-THREADS is specified."
(let ((file-or-directory (not (file-directory-p path-local))))
(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)))
(when ssh-deploy-verbose (message "Uploading file '%s' to '%s'..
(asynchronously)" path-local path-remote))
(ssh-deploy--async-process
- (lambda ()
+ (lambda()
(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)))
+ (if (or (> force 0) (not (file-exists-p path-remote)) (and
(file-exists-p revision-path) (ediff-same-file-contents revision-path
path-remote)))
(progn
(if (not (file-directory-p (file-name-directory
path-remote)))
(make-directory (file-name-directory path-remote)
t))
@@ -432,15 +423,16 @@
(list 0 (format "Completed upload of file '%s'.
(asynchronously)" path-remote) path-local))
(list 1 (format "Remote file '%s' has changed please
download or diff. (asynchronously)" path-remote) path-local))
(list 1 "Function 'ediff-same-file-contents' is missing.
(asynchronously)" path-local)))
- (lambda (return)
+ (lambda(return)
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle (nth 2 return))
(if (= (nth 0 return) 0)
(when ssh-deploy-verbose (message (nth 1 return)))
- (display-warning 'ssh-deploy (nth 1 return) :warning)))))
+ (display-warning 'ssh-deploy (nth 1 return) :warning)))
+ async-with-threads))
(progn
(when ssh-deploy-verbose (message "Uploading directory '%s' to '%s'..
(asynchronously)" path-local path-remote))
(ssh-deploy--async-process
- (lambda ()
+ (lambda()
(copy-directory path-local path-remote t t t)
path-local)
(lambda(return-path)
@@ -456,7 +448,7 @@
(progn
(require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
- (if (or (eq t force)
+ (if (or (> force 0)
(not (file-exists-p path-remote))
(and (file-exists-p revision-path)
(ediff-same-file-contents revision-path path-remote)))
(progn
@@ -475,13 +467,13 @@
(ssh-deploy--mode-line-set-status-and-update ssh-deploy--status-idle)
(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."
+(defun ssh-deploy--download-via-tramp-async (path-remote path-local
revision-folder async-with-threads)
+ "Download PATH-REMOTE to PATH-LOCAL via TRAMP asynchronously and make a copy
in REVISION-FOLDER, use multi-threading if ASYNC-WITH-THREADS is above zero."
(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)
(when ssh-deploy-verbose (message "Downloading '%s' to '%s'..
(asynchronously)" path-remote path-local))
(ssh-deploy--async-process
- (lambda ()
+ (lambda()
(let ((file-or-directory (not (file-directory-p path-remote))))
(if file-or-directory
(progn
@@ -497,7 +489,8 @@
(let ((local-buffer (find-buffer-visiting return-path)))
(when local-buffer
(with-current-buffer local-buffer
- (revert-buffer t t t))))))))
+ (revert-buffer t t t)))))
+ async-with-threads)))
(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."
@@ -623,17 +616,10 @@
(display-warning 'ssh-deploy "Both directories need to exist to
perform difference generation." :warning))
(display-warning 'ssh-deploy "Function 'string-remove-prefix' is missing."
:warning)))
-(defun ssh-deploy--diff-directories-present (diff)
- "Present difference data for directories from DIFF."
- (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))
+(defun ssh-deploy--diff-directories-present (diff root-local root-remote
on-explicit-save debug async async-with-threads revision-folder remote-changes
exclude-list)
+ "Present difference data for directories from the DIFF, ROOT-LOCAL defines
local root, ROOT-REMOTE defined remote root, ON-EXPLICIT-SAVE defines automatic
uploads, DEBUG is the debug flag, ASYNC is for asynchronous, ASYNC-WITH-THREADS
for threads instead of processes, REVISION-FOLDER is for revisions,
REMOTE-CHANGES are whether to look for remote change, EXCLUDE-LIST is what
files to exclude."
+
+ (let ((buffer (generate-new-buffer "*SSH Deploy diff*")))
(switch-to-buffer buffer)
(ssh-deploy--insert-keyword "DIRECTORY A: ")
@@ -678,14 +664,15 @@
(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)))
+ (set (make-local-variable 'ssh-deploy-root-local) root-local)
+ (set (make-local-variable 'ssh-deploy-root-remote) root-remote)
+ (set (make-local-variable 'ssh-deploy-on-explicit-save) on-explicit-save)
+ (set (make-local-variable 'ssh-deploy-debug) debug)
+ (set (make-local-variable 'ssh-deploy-async) async)
+ (set (make-local-variable 'ssh-deploy-async-with-threads)
async-with-threads)
+ (set (make-local-variable 'ssh-deploy-revision-folder) revision-folder)
+ (set (make-local-variable 'ssh-deploy-automatically-detect-remote-changes)
remote-changes)
+ (set (make-local-variable 'ssh-deploy-exclude-list) exclude-list)))
;; PUBLIC functions
@@ -707,45 +694,48 @@
(display-warning 'ssh-deploy "Function 'ediff-same-file-contents' is
missing." :warning)))
;;;###autoload
-(defun ssh-deploy-diff-directories (directory-a directory-b &optional
exclude-list async)
- "Find difference between DIRECTORY-A and DIRECTORY-B but exclude paths
matching EXCLUDE-LIST, do it asynchronously is ASYNC is true."
- ;; FIXME: These next 4 lines don't do anything because the optional args
- ;; are always "bound" (to nil if the arg was not passed).
- ;; (if (not (boundp 'async))
- ;; (setq async ssh-deploy-async))
- ;; (if (not (boundp 'exclude-list))
- ;; (setq exclude-list ssh-deploy-exclude-list))
- (if async
- (let ((script-filename (file-name-directory (symbol-file
'ssh-deploy-diff-directories))))
- (message "Calculating differences between directory '%s' and '%s'..
(asynchronously)" directory-a directory-b)
- (ssh-deploy--async-process
- (lambda ()
- (add-to-list 'load-path script-filename)
- (require 'ssh-deploy)
- (ssh-deploy--diff-directories-data directory-a directory-b
exclude-list))
- (lambda(diff)
- (message "Completed calculation of differences between directory
'%s' and '%s'. Result: %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 "Calculating 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 "Completed calculation of differences between directory '%s'
and '%s'. Result: %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))))))
+(defun ssh-deploy-diff-directories (directory-a directory-b &optional
on-explicit-save debug async async-with-threads revision-folder remote-changes
exclude-list)
+ "Find difference between DIRECTORY-A and DIRECTORY-B but exclude,
ON-EXPLICIT-SAVE defines automatic uploads, DEBUG is the debug flag, ASYNC is
for asynchronous, ASYNC-WITH-THREADS for threads instead of processes,
REVISION-FOLDER is for revisions, REMOTE-CHANGES are whether to look for remote
change, EXCLUDE-LIST is what files to exclude."
+ (let ((on-explicit-save (or on-explicit-save ssh-deploy-on-explicit-save))
+ (debug (or debug ssh-deploy-debug))
+ (async (or async ssh-deploy-async))
+ (async-with-threads (or async-with-threads
ssh-deploy-async-with-threads))
+ (revision-folder (or revision-folder ssh-deploy-revision-folder))
+ (remote-changes (or remote-changes
ssh-deploy-automatically-detect-remote-changes))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list)))
+ (if (> async 0)
+ (let ((script-filename (file-name-directory (symbol-file
'ssh-deploy-diff-directories))))
+ (message "Calculating differences between directory '%s' and '%s'..
(asynchronously)" directory-a directory-b)
+ (ssh-deploy--async-process
+ (lambda()
+ (add-to-list 'load-path script-filename)
+ (require 'ssh-deploy)
+ (ssh-deploy--diff-directories-data directory-a directory-b
exclude-list))
+ (lambda(diff)
+ (message "Completed calculation of differences between directory
'%s' and '%s'. Result: %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 directory-a
directory-b on-explicit-save debug async async-with-threads revision-folder
remote-changes exclude-list)))
+ async-with-threads))
+ (progn
+ (message "Calculating 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 "Completed calculation of differences between directory
'%s' and '%s'. Result: %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 directory-a
directory-b on-explicit-save debug async async-with-threads revision-folder
remote-changes exclude-list)))))))
;;;###autoload
-(defun ssh-deploy-remote-changes (path-local &optional root-local root-remote
async revision-folder exclude-list)
- "Check if a local revision for PATH-LOCAL on ROOT-LOCAL and if remote file
has changed on ROOT-REMOTE, do it optionally asynchronously if ASYNC is true,
check for copies in REVISION-FOLDER and skip if path is in EXCLUDE-LIST."
+(defun ssh-deploy-remote-changes (path-local &optional root-local root-remote
async revision-folder exclude-list async-with-threads)
+ "Check if a local revision for PATH-LOCAL on ROOT-LOCAL and if remote file
has changed on ROOT-REMOTE, do it optionally asynchronously if ASYNC is true,
check for copies in REVISION-FOLDER and skip if path is in EXCLUDE-LIST. Use
multi-threading if ASYNC-WITH-THREADS is above zero."
(let ((root-local (or root-local ssh-deploy-root-local))
- (root-remote (or root-remote ssh-deploy-root-remote)))
+ (root-remote (or root-remote ssh-deploy-root-remote))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list)))
;; Is the file inside the local-root and should it not be excluded?
(if (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
(let* ((revision-folder (or revision-folder
ssh-deploy-revision-folder))
(revision-path (ssh-deploy--get-revision-path path-local
revision-folder))
- (path-remote (concat root-remote (ssh-deploy--get-relative-path
root-local path-local))))
+ (path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) root-remote)))
;; Is the file a regular file?
(if (not (file-directory-p path-local))
@@ -755,7 +745,7 @@
(if (file-exists-p revision-path)
;; Local revision exist. Is async enabled?
- (if async
+ (if (> async 0)
(progn
;; Update buffer status
@@ -774,7 +764,7 @@
(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. (asynchronously)" path-remote path-local) path-local))
- (list 1 (format "Remote file '%s'
has changed, please download or diff. (asynchronously)" path-remote)
path-local)))
+ (list 1 (format "Remote file '%s'
has changed please download or diff. (asynchronously)" path-remote)
path-local)))
(list 1 "Function
'ediff-same-file-contents' is missing. (asynchronously)" path-local)))
(list 0 (format "Remote file '%s' doesn't
exist. (asynchronously)" path-remote) path-local)))
(lambda(return)
@@ -784,7 +774,8 @@
(if (= (nth 0 return) 0)
(when ssh-deploy-verbose (message (nth 1
return)))
- (display-warning 'ssh-deploy (nth 1 return)
:warning)))))
+ (display-warning 'ssh-deploy (nth 1 return)
:warning)))
+ async-with-threads))
;; Async is not enabled - synchronous logic here
(progn
@@ -807,7 +798,7 @@
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle)))
;; Does not have local revision. Is async enabled?
- (if async
+ (if (> async 0)
(progn
;; Update buffer status
@@ -815,7 +806,8 @@
;; Asynchronous logic here
(ssh-deploy--async-process
- (lambda ()
+ (lambda()
+
;; Does remote file exist?
(if (file-exists-p path-remote)
(progn
@@ -825,7 +817,7 @@
(progn
(copy-file path-local revision-path
t t t t)
(list 0 (format "Remote file '%s'
has not changed, created base revision. (asynchronously)" path-remote)
path-local))
- (list 1 (format "Remote file '%s' has
changed, please download or diff. (asynchronously)" path-remote) path-local))
+ (list 1 (format "Remote file '%s' has
changed please download or diff. (asynchronously)" path-remote) path-local))
(list 1 "Function ediff-file-same-contents
is missing. (asynchronously)" path-local)))
(list 0 (format "Remote file '%s' doesn't exist.
(asynchronously)" path-remote) path-local)))
(lambda(return)
@@ -835,7 +827,8 @@
(if (= (nth 0 return) 0)
(when ssh-deploy-verbose (message (nth 1
return)))
- (display-warning 'ssh-deploy (nth 1 return)
:warning)))))
+ (display-warning 'ssh-deploy (nth 1 return)
:warning)))
+ async-with-threads))
;; Async is not enabled - synchronous logic here
(progn
@@ -860,81 +853,81 @@
(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 0) (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 0) (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."
- (if async
- (progn
- (when buffer
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting buffer))
- (ssh-deploy--async-process
- (lambda ()
- (if (file-exists-p path)
- (let ((file-or-directory (not (file-directory-p path))))
- (progn
- (if file-or-directory
- (delete-file path t)
- (delete-directory path t t))
- (list path 0 buffer)))
- (list path 1 buffer)))
- (lambda(response)
- (when (nth 2 response)
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle (nth 2 response))
- (let ((local-buffer (find-buffer-visiting (nth 2 response))))
- (when local-buffer
- (kill-buffer local-buffer))))
- (cond ((= 0 (nth 1 response)) (message "Completed deletion of '%s'.
(asynchronously)" (nth 0 response)))
- (t (display-warning 'ssh-deploy (format "Did not find '%s'
for deletion. (asynchronously)" (nth 0 response)) :warning))))))
- (if (file-exists-p path)
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting buffer)
- (let ((file-or-directory (not (file-directory-p path))))
- (when buffer
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting buffer))
+(defun ssh-deploy-delete (path &optional async async-with-threads)
+ "Delete PATH and use flags ASYNC. Use multi-threading if ASYNC-WITH-THREADS
is above zero."
+ (let ((async (or async ssh-deploy-async))
+ (async-with-threads (or async-with-threads
ssh-deploy-async-with-threads)))
+ (if (> async 0)
(progn
- (if file-or-directory
- (delete-file path t)
- (delete-directory path t t))
- (when buffer
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle buffer)
- (let ((local-buffer (find-buffer-visiting buffer)))
- (when local-buffer
- (kill-buffer local-buffer))))
- (message "Completed deletion of '%s'. (synchronously)" path)))
- (display-warning 'ssh-deploy (format "Did not find '%s' for deletion.
(synchronously)" path) :warning))))
+ (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting path)
+ (ssh-deploy--async-process
+ (lambda()
+ (if (file-exists-p path)
+ (let ((file-or-directory (not (file-directory-p path))))
+ (progn
+ (if file-or-directory
+ (delete-file path t)
+ (delete-directory path t t))
+ (list path 0)))
+ (list path 1)))
+ (lambda(response)
+ (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle (nth 0 response))
+ (let ((local-buffer (find-buffer-visiting (nth 0 response))))
+ (when local-buffer
+ (kill-buffer local-buffer)))
+ (cond ((= 0 (nth 1 response)) (message "Completed deletion of
'%s'. (asynchronously)" (nth 0 response)))
+ (t (display-warning 'ssh-deploy (format "Did not find '%s'
for deletion. (asynchronously)" (nth 0 response)) :warning))))
+ async-with-threads))
+ (if (file-exists-p path)
+ (let ((file-or-directory (not (file-directory-p path))))
+ (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting path)
+ (progn
+ (if file-or-directory
+ (delete-file path t)
+ (delete-directory path t t))
+ (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle path)
+ (let ((local-buffer (find-buffer-visiting path)))
+ (when local-buffer
+ (kill-buffer local-buffer)))
+ (message "Completed deletion of '%s'. (synchronously)" path)))
+ (display-warning 'ssh-deploy (format "Did not find '%s' for deletion.
(synchronously)" path) :warning)))))
;;;###autoload
-(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."
+(defun ssh-deploy-delete-both (path-local &optional root-local root-remote
async debug exclude-list async-with-threads)
+ "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. Use async threads is ASYNC-WITH-THREADS is above
zero."
(let ((root-local (or root-local ssh-deploy-root-local))
- (root-remote (or root-remote ssh-deploy-root-remote)))
+ (root-remote (or root-remote ssh-deploy-root-remote))
+ (async (or async ssh-deploy-async))
+ (debug (or debug ssh-deploy-debug))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list))
+ (async-with-threads (or async async-with-threads)))
(if (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
- ;; FIXME: Why `concat' instead of `expand-file-name'?
- (let ((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))
- (when debug (message "Path '%s' is not in the root '%s' or is excluded
from it." path-local root-local)))))
+ (let ((path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) root-remote)))
+ (ssh-deploy-delete path-local async async-with-threads)
+ (ssh-deploy-delete path-remote async async-with-threads))
+ (when (> debug 0) (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)
- "Rename OLD-PATH-LOCAL to NEW-PATH-LOCAL under ROOT-LOCAL as well as on
ROOT-REMOTE, do it asynchronously if ASYNC is non-nil, debug if DEBUG is
non-nil but check if path is excluded in EXCLUDE-LIST first."
- ;; FIXME: Next 4 lines don't do anything!
- ;; (if (not (boundp 'debug))
- ;; (setq debug ssh-deploy-debug))
- ;; (if (not (boundp 'async))
- ;; (setq async ssh-deploy-async))
+(defun ssh-deploy-rename (old-path-local new-path-local &optional root-local
root-remote async debug exclude-list async-with-threads)
+ "Rename OLD-PATH-LOCAL to NEW-PATH-LOCAL under ROOT-LOCAL as well as on
ROOT-REMOTE, do it asynchronously if ASYNC is non-nil, debug if DEBUG is
non-nil but check if path is excluded in EXCLUDE-LIST first. Use
multi-threading if ASYNC-WITH-THREADS is above zero."
(let ((root-local (or root-local ssh-deploy-root-local))
- (root-remote (or root-remote ssh-deploy-root-remote)))
+ (root-remote (or root-remote ssh-deploy-root-remote))
+ (async (or async ssh-deploy-async))
+ (debug (or debug ssh-deploy-debug))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list))
+ (async-with-threads (or async-with-threads
ssh-deploy-async-with-threads)))
(if (and (ssh-deploy--file-is-in-path old-path-local root-local)
(ssh-deploy--file-is-in-path new-path-local root-local)
(ssh-deploy--file-is-included old-path-local exclude-list)
(ssh-deploy--file-is-included new-path-local exclude-list))
- (let ((old-path-remote (concat root-remote
(ssh-deploy--get-relative-path root-local old-path-local)))
- (new-path-remote (concat root-remote
(ssh-deploy--get-relative-path root-local new-path-local))))
+ (let ((old-path-remote (expand-file-name
(ssh-deploy--get-relative-path root-local old-path-local) root-remote))
+ (new-path-remote (expand-file-name
(ssh-deploy--get-relative-path root-local new-path-local) root-remote)))
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-renaming)
(rename-file old-path-local new-path-local t)
(if (not (file-directory-p new-path-local))
@@ -944,19 +937,20 @@
(set-buffer-modified-p nil))
(dired new-path-local))
(message "Renamed '%s' to '%s'." old-path-local new-path-local)
- (if async
+ (if (> async 0)
(ssh-deploy--async-process
- (lambda ()
+ (lambda()
(rename-file old-path-remote new-path-remote t)
(list old-path-remote new-path-remote new-path-local))
(lambda(files)
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle (nth 2 files))
- (message "Renamed '%s' to '%s'. (asynchronously)" (nth 0
files) (nth 1 files))))
+ (message "Renamed '%s' to '%s'. (asynchronously)" (nth 0
files) (nth 1 files)))
+ async-with-threads)
(progn
(rename-file old-path-remote new-path-remote t)
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle)
(message "Renamed '%s' to '%s'. (synchronously)" old-path-remote
new-path-remote))))
- (if debug
+ (if (> debug 0)
(message "Path '%s' or '%s' is not in the root '%s' or is excluded
from it." old-path-local new-path-local root-local)))))
;;;###autoload
@@ -986,24 +980,24 @@
;;;###autoload
(defun ssh-deploy-browse-remote (path-local &optional root-local root-remote
exclude-list)
"Browse PATH-LOCAL in `dired-mode' on remote where it is inside ROOT-LOCAL
and mirrored on ROOT-REMOTE and not in EXCLUDE-LIST."
- (let ((exclude-list (or exclude-list ssh-deploy-exclude-list))
- (root-local (or root-local ssh-deploy-root-local))
- (root-remote (or root-remote ssh-deploy-root-remote)))
+ (let ((root-local (or root-local ssh-deploy-root-local))
+ (root-remote (or root-remote ssh-deploy-root-remote))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list)))
(if (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
- (let ((path-remote (concat root-remote (ssh-deploy--get-relative-path
root-local path-local))))
+ (let ((path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) root-remote)))
(message "Opening '%s' for browsing on remote host.." path-remote)
(dired path-remote)))))
;;;###autoload
(defun ssh-deploy-remote-terminal-eshell (path-local &optional root-local
root-remote exclude-list)
"Browse PATH-LOCAL inside ROOT-LOCAL on ROOT-REMOTE in `eshell-mode' if not
in EXCLUDE-LIST."
- (let ((exclude-list (or exclude-list ssh-deploy-exclude-list))
- (root-local (or root-local ssh-deploy-root-local))
- (root-remote (or root-remote ssh-deploy-root-remote)))
+ (let ((root-local (or root-local ssh-deploy-root-local))
+ (root-remote (or root-remote ssh-deploy-root-remote))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list)))
(when (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
- (let ((path-remote (concat root-remote (ssh-deploy--get-relative-path
root-local path-local))))
+ (let ((path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) root-remote)))
(require 'eshell)
(message "Opening eshell on '%s'.." path-remote)
(let ((default-directory path-remote))
@@ -1014,18 +1008,18 @@
;;;###autoload
(defun ssh-deploy-remote-terminal-shell (path-local &optional root-local
root-remote exclude-list)
"Browse PATH-LOCAL inside ROOT-LOCAL on ROOT-REMOTE in `eshell-mode' if not
in EXCLUDE-LIST."
- (let ((exclude-list (or exclude-list ssh-deploy-exclude-list))
- (root-local (or root-local ssh-deploy-root-local))
- (root-remote (or root-remote ssh-deploy-root-remote)))
+ (let ((root-local (or root-local ssh-deploy-root-local))
+ (root-remote (or root-remote ssh-deploy-root-remote))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list)))
(when (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
- (let ((path-remote (concat root-remote (ssh-deploy--get-relative-path
root-local path-local))))
+ (let ((path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) root-remote)))
(require 'shell)
- (defvar explicit-shell-file-name)
(message "Opening eshell on '%s'.." path-remote)
(let ((default-directory path-remote)
(explicit-shell-file-name ssh-deploy-remote-shell-executable))
- (shell path-remote))))))
+ (when explicit-shell-file-name ;; NOTE This is only to trick
flycheck to ignore unused error
+ (shell path-remote)))))))
;;;###autoload
(defun ssh-deploy-store-revision (path &optional root)
@@ -1037,46 +1031,43 @@
(copy-file path revision-path t t t t))))
;;;###autoload
-(defun ssh-deploy-diff (path-local path-remote &optional root-local debug
exclude-list async)
- "Find differences between PATH-LOCAL and PATH-REMOTE, where PATH-LOCAL is
inside ROOT-LOCAL. DEBUG enables feedback message, check if PATH-LOCAL is not
in EXCLUDE-LIST. ASYNC make the process work asynchronously."
+(defun ssh-deploy-diff (path-local path-remote &optional root-local debug
exclude-list async async-with-threads on-explicit-save revision-folder
remote-changes)
+ "Find differences between PATH-LOCAL and PATH-REMOTE, where PATH-LOCAL is
inside ROOT-LOCAL. DEBUG enables feedback message, check if PATH-LOCAL is not
in EXCLUDE-LIST. ASYNC make the process work asynchronously, if
ASYNC-WITH-THREADS is above zero use threads, ON-EXPLICIT-SAVE for automatic
uploads, REVISION-FOLDER for revision-folder, REMOTE-CHANGES for automatic
notification of remote change."
(let ((file-or-directory (not (file-directory-p path-local)))
- (exclude-list (or exclude-list ssh-deploy-exclude-list)))
- ;; FIXME: next 6 lines don't do anything!
- ;; (if (not (boundp 'root-local))
- ;; (setq root-local ssh-deploy-root-local))
- ;; (if (not (boundp 'debug))
- ;; (setq debug ssh-deploy-debug))
- ;; (if (not (boundp 'async))
- ;; (setq async ssh-deploy-async))
+ (root-local (or root-local ssh-deploy-root-local))
+ (debug (or debug ssh-deploy-debug))
+ (exclude-list (or exclude-list ssh-deploy-exclude-list))
+ (async (or async ssh-deploy-async))
+ (async-with-threads (or async-with-threads
ssh-deploy-async-with-threads))
+ (on-explicit-save (or on-explicit-save ssh-deploy-on-explicit-save))
+ (revision-folder (or revision-folder ssh-deploy-revision-folder))
+ (remote-changes (or remote-changes
ssh-deploy-automatically-detect-remote-changes)))
(if (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
(if file-or-directory
(ssh-deploy-diff-files path-local path-remote)
- (ssh-deploy-diff-directories path-local path-remote exclude-list
async))
+ (ssh-deploy-diff-directories path-local path-remote on-explicit-save
debug async async-with-threads revision-folder remote-changes exclude-list))
(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)
- "Upload PATH-LOCAL to PATH-REMOTE and ROOT-LOCAL via TRAMP, FORCE uploads
despite remote change, ASYNC determines if transfer should be asynchronously,
check version in REVISION-FOLDER."
- ;; FIXME: Next 4 lines don't do anything!
- ;; (if (not (boundp 'async))
- ;; (setq async ssh-deploy-async))
- ;; (if (not (boundp 'force))
- ;; (setq force nil))
- (let ((revision-folder (or revision-folder ssh-deploy-revision-folder)))
- (if async
- (ssh-deploy--upload-via-tramp-async path-local path-remote force
revision-folder)
+(defun ssh-deploy-upload (path-local path-remote &optional force async
revision-folder async-with-threads)
+ "Upload PATH-LOCAL to PATH-REMOTE and ROOT-LOCAL via TRAMP, FORCE uploads
despite remote change, ASYNC determines if transfer should be asynchronously,
check version in REVISION-FOLDER. If you want asynchronous threads pass
ASYNC-WITH-THREADS above zero."
+ (let ((force (or force 0))
+ (async (or async ssh-deploy-async))
+ (revision-folder (or revision-folder ssh-deploy-revision-folder))
+ (async-with-threads (or async-with-threads
ssh-deploy-async-with-threads)))
+ (if (> async 0)
+ (ssh-deploy--upload-via-tramp-async path-local path-remote force
revision-folder async-with-threads)
(ssh-deploy--upload-via-tramp path-local path-remote force
revision-folder))))
;;;###autoload
-(defun ssh-deploy-download (path-remote path-local &optional async
revision-folder)
- "Download PATH-REMOTE to PATH-LOCAL via TRAMP, ASYNC determines if transfer
should be asynchrous or not, check for revisions in REVISION-FOLDER."
- ;; FIXME: Next 2 lines don't do anything!
- ;; (if (not (boundp 'async))
- ;; (setq async ssh-deploy-async))
- (let ((revision-folder (or revision-folder ssh-deploy-revision-folder)))
- (if async
- (ssh-deploy--download-via-tramp-async path-remote path-local
revision-folder)
+(defun ssh-deploy-download (path-remote path-local &optional async
revision-folder async-with-threads)
+ "Download PATH-REMOTE to PATH-LOCAL via TRAMP, ASYNC determines if transfer
should be asynchrous or not, check for revisions in REVISION-FOLDER. If you
want asynchronous threads pass ASYNC-WITH-THREADS above zero."
+ (let ((async (or async ssh-deploy-async))
+ (revision-folder (or revision-folder ssh-deploy-revision-folder))
+ (async-with-threads (or async-with-threads
ssh-deploy-async-with-threads)))
+ (if (> async 0)
+ (ssh-deploy--download-via-tramp-async path-remote path-local
revision-folder async-with-threads)
(ssh-deploy--download-via-tramp path-remote path-local
revision-folder))))
@@ -1093,10 +1084,8 @@
(if (and (ssh-deploy--is-not-empty-string ssh-deploy-root-local)
(ssh-deploy--is-not-empty-string ssh-deploy-root-remote))
(let ((root-local (file-truename ssh-deploy-root-local))
+ (force (or force 0))
path-local)
- ;; FIXME: Next 2 lines don't do anything!
- ;; (if (not (boundp 'force))
- ;; (setq force nil))
(if (and (ssh-deploy--is-not-empty-string buffer-file-name)
(file-exists-p buffer-file-name))
(setq path-local (file-truename buffer-file-name))
@@ -1106,15 +1095,15 @@
(if (and (ssh-deploy--is-not-empty-string path-local)
(ssh-deploy--file-is-in-path path-local root-local)
(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))
- (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))))))
+ (let ((path-remote (expand-file-name
(ssh-deploy--get-relative-path root-local path-local) ssh-deploy-root-remote)))
+ (ssh-deploy-upload path-local path-remote force ssh-deploy-async
ssh-deploy-revision-folder ssh-deploy-async-with-threads))
+ (when (> ssh-deploy-debug 0) (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 ()
"Upload current path to remote host if it is configured for deployment."
(interactive)
- (ssh-deploy-upload-handler t))
+ (ssh-deploy-upload-handler 1))
;;;###autoload
(defun ssh-deploy-remote-changes-handler()
@@ -1124,9 +1113,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.."))
- (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 0) (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
ssh-deploy-async-with-threads))
+ (when (> ssh-deploy-debug 0) (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()
@@ -1135,6 +1124,7 @@
(when (ssh-deploy--is-not-empty-string ssh-deploy-root-remote)
(ssh-deploy-remote-sql ssh-deploy-root-remote "mysql")))
+;;;###autoload
(defun ssh-deploy-remote-sql-postgres-handler()
"Open `sql-postgres' on remote path if path is configured for deployment."
(interactive)
@@ -1150,7 +1140,7 @@
(ssh-deploy--is-not-empty-string buffer-file-name))
(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))))
+ (path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) ssh-deploy-root-remote)))
(when ssh-deploy-verbose (message "Opening file on remote '%s'"
path-remote))
(find-file path-remote))))
@@ -1171,9 +1161,9 @@
(if (and (ssh-deploy--is-not-empty-string path-local)
(ssh-deploy--file-is-in-path path-local root-local)
(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))
- (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))))))
+ (let ((path-remote (expand-file-name
(ssh-deploy--get-relative-path root-local path-local) ssh-deploy-root-remote)))
+ (ssh-deploy-download path-remote path-local ssh-deploy-async
ssh-deploy-revision-folder ssh-deploy-async-with-threads))
+ (when (> ssh-deploy-debug 0) (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 ()
@@ -1185,14 +1175,14 @@
(file-exists-p buffer-file-name))
(let* ((path-local (file-truename buffer-file-name))
(root-local (file-truename ssh-deploy-root-local))
- (path-remote (concat ssh-deploy-root-remote
(ssh-deploy--get-relative-path root-local path-local))))
- (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list ssh-deploy-async))
+ (path-remote (expand-file-name (ssh-deploy--get-relative-path
root-local path-local) ssh-deploy-root-remote)))
+ (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list ssh-deploy-async
ssh-deploy-async-with-threads ssh-deploy-on-explicit-save
ssh-deploy-revision-folder ssh-deploy-automatically-detect-remote-changes))
(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))
- (path-remote (concat ssh-deploy-root-remote
(ssh-deploy--get-relative-path root-local path-local))))
- (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list ssh-deploy-async))))))
+ (path-remote (expand-file-name
(ssh-deploy--get-relative-path root-local path-local) ssh-deploy-root-remote)))
+ (ssh-deploy-diff path-local path-remote root-local
ssh-deploy-debug ssh-deploy-exclude-list ssh-deploy-async
ssh-deploy-async-with-threads ssh-deploy-on-explicit-save
ssh-deploy-revision-folder ssh-deploy-automatically-detect-remote-changes))))))
;;;###autoload
(defun ssh-deploy-delete-handler ()
@@ -1206,14 +1196,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-both 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
ssh-deploy-exclude-list ssh-deploy-async-with-threads)))
(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-both 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 ssh-deploy-async-with-threads)))))))
;;;###autoload
(defun ssh-deploy-rename-handler ()
@@ -1229,7 +1219,7 @@
(new-path-local-tmp (read-file-name "New file name:"
(file-name-directory old-path-local) basename nil basename))
(new-path-local (file-truename new-path-local-tmp)))
(if (not (string= old-path-local new-path-local))
- (ssh-deploy-rename old-path-local new-path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug)))
+ (ssh-deploy-rename old-path-local new-path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug
ssh-deploy-exclude-list ssh-deploy-async-with-threads)))
(if (and (ssh-deploy--is-not-empty-string default-directory)
(file-exists-p default-directory))
(let* ((old-path-local (file-truename default-directory))
@@ -1238,7 +1228,7 @@
(new-path-local-tmp (read-file-name "New directory name:"
(file-name-directory old-path-local) basename nil basename))
(new-path-local (file-truename new-path-local-tmp)))
(if (not (string= old-path-local new-path-local))
- (ssh-deploy-rename old-path-local new-path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug
ssh-deploy-exclude-list)))))))
+ (ssh-deploy-rename old-path-local new-path-local root-local
ssh-deploy-root-remote ssh-deploy-async ssh-deploy-debug
ssh-deploy-exclude-list ssh-deploy-async-with-threads)))))))
;;;###autoload
(defun ssh-deploy-remote-terminal-eshell-handler ()
@@ -1305,23 +1295,20 @@
"Run `ssh-deploy-script' with `funcall'."
(interactive)
(if ssh-deploy-script
- (if ssh-deploy-async
+ (if (> ssh-deploy-async 0)
(progn
(message "Executing of deployment-script starting...
(asynchronously)")
(ssh-deploy--async-process
- (let ((local ssh-deploy-root-local)
- (remote ssh-deploy-root-remote)
- (script ssh-deploy-script))
- (lambda ()
- (let ((ssh-deploy-root-local local)
- (ssh-deploy-root-remote remote))
- (funcall script))))
- (lambda(result) (message "Completed execution of
deployment-script. '%s'(asynchronously)" result))))
+ `(lambda() (let ((ssh-deploy-root-local ,ssh-deploy-root-local)
+ (ssh-deploy-root-remote ,ssh-deploy-root-remote))
+ (funcall ,ssh-deploy-script)))
+ (lambda(result) (message "Completed execution of
deployment-script. Return: '%s' (asynchronously)" result))
+ ssh-deploy-async-with-threads))
(progn
(message "Executing of deployment-script starting...
(synchronously)")
- (funcall ssh-deploy-script)
- (message "Completed execution of deployment-script.
(synchronously)")))
- (display-warning 'ssh-deploy (format "ssh-deploy-script lacks
definition!") :warning)))
+ (let ((ret (funcall ssh-deploy-script)))
+ (message "Completed execution of deployment-script. Return: '%s'
(synchronously)" ret))))
+ (display-warning 'ssh-deploy "ssh-deploy-script lacks definition!"
:warning)))
;;; Menu-bar
@@ -1330,64 +1317,45 @@
;; This is particularly useful when key-bindings are not working because of
some mode
;; overriding them.
+
(defvar ssh-deploy-menu-map
(let ((map (make-sparse-keymap "Menu for SSH Deploy")))
- (define-key map [pq]
- '("PostgreSQL" . ssh-deploy-remote-sql-postgres-handler))
- (define-key map [mq]
- '("MySQL" . ssh-deploy-remote-sql-mysql-handler))
+ (define-key map [pq] '("PostgreSQL" .
ssh-deploy-remote-sql-postgres-handler))
+ (define-key map [mq] '("MySQL" . ssh-deploy-remote-sql-mysql-handler))
(define-key map [sep1] '("--"))
-
- (define-key map [sb]
- '("Shell Base" . ssh-deploy-remote-terminal-shell-base-handler))
- (define-key map [ss]
- '("Shell" . ssh-deploy-remote-terminal-shell-handler))
+ (define-key map [sb] '("Shell Base" .
ssh-deploy-remote-terminal-shell-base-handler))
+ (define-key map [ss] '("Shell" . ssh-deploy-remote-terminal-shell-handler))
(define-key map [sep2] '("--"))
-
- (define-key map [eb]
- '("Eshell Base" . ssh-deploy-remote-terminal-eshell-base-handler))
- (define-key map [es]
- '("Eshell" . ssh-deploy-remote-terminal-eshell-handler))
- (define-key map [sep3]
- '("--"))
-
- (define-key map [bb]
- '("Browse Base" . ssh-deploy-browse-remote-base-handler))
- (define-key map [br]
- '("Browse" . ssh-deploy-browse-remote-handler))
+ (define-key map [eb] '("Eshell Base" .
ssh-deploy-remote-terminal-eshell-base-handler))
+ (define-key map [es] '("Eshell" .
ssh-deploy-remote-terminal-eshell-handler))
+ (define-key map [sep3] '("--"))
+ (define-key map [bb] '("Browse Base" .
ssh-deploy-browse-remote-base-handler))
+ (define-key map [br] '("Browse" . ssh-deploy-browse-remote-handler))
(define-key map [sep4] '("--"))
-
- (define-key map [df]
- '("Difference" . ssh-deploy-diff-handler))
- (define-key map [rc]
- '("Detect Remote Changes" . ssh-deploy-remote-changes-handler))
+ (define-key map [df] '("Difference" . ssh-deploy-diff-handler))
+ (define-key map [rc] '("Detect Remote Changes" .
ssh-deploy-remote-changes-handler))
(define-key map [sep5] '("--"))
-
- (define-key map [de]
- '("Delete" . ssh-deploy-delete-handler))
- (define-key map [rn]
- '("Rename" . ssh-deploy-rename-handler))
- (define-key map [op]
- '("Open" . ssh-deploy-open-remote-file-handler))
+ (define-key map [de] '("Delete" . ssh-deploy-delete-handler))
+ (define-key map [rn] '("Rename" . ssh-deploy-rename-handler))
+ (define-key map [op] '("Open" . ssh-deploy-open-remote-file-handler))
(define-key map [sep6] '("--"))
-
- (define-key map [sc]
- '("Run script" . ssh-deploy-run-deploy-script-handler))
+ (define-key map [sc] '("Run script" .
ssh-deploy-run-deploy-script-handler))
(define-key map [sep7] '("--"))
-
- (define-key map [ulf]
- '("Forced Upload" . ssh-deploy-upload-handler-forced))
- (define-key map [ul]
- '("Upload" . ssh-deploy-upload-handler))
- (define-key map [dl]
- '("Download" . ssh-deploy-download-handler))
+ (define-key map [ulf] '("Forced Upload" .
ssh-deploy-upload-handler-forced))
+ (define-key map [ul] '("Upload" . ssh-deploy-upload-handler))
+ (define-key map [dl] '("Download" . ssh-deploy-download-handler))
map))
-(define-key-after
- global-map
- [menu-bar sshdeploy]
- (cons "Deployment" ssh-deploy-menu-map)
- 'tools)
+(defun ssh-deploy-menu-map-update ()
+ "Update menu map and only show menu if deployment is active."
+ (if (and ssh-deploy-root-local ssh-deploy-root-remote)
+ (define-key-after global-map [menu-bar sshdeploy] (cons "Deployment"
ssh-deploy-menu-map) 'tools)
+ (define-key-after global-map [menu-bar sshdeploy] 'undefined 'tools)))
+
+(defun ssh-deploy-add-menu ()
+ "Add menu-bar support."
+ (add-hook 'menu-bar-update-hook 'ssh-deploy-menu-map-update))
+
;;; Mode Line
@@ -1395,15 +1363,83 @@
(define-minor-mode ssh-deploy-line-mode
"Show SSH Deploy status in mode line"
:global t
+ :group 'ssh-deploy
(add-to-list 'global-mode-string 'ssh-deploy--mode-line-status-text t))
+
(ssh-deploy--mode-line-status-refresh)
-;; Start mode line by default
-;; FIXME: By convention, loading an Elisp file should not affect
-;; Emacs's behavior!
-(ssh-deploy-line-mode)
+
+;;; Usability shortcuts
+
+
+(defun ssh-deploy-after-save () "Logic for automatic uploads."
+ (when (and (boundp 'ssh-deploy-on-explicit-save)
ssh-deploy-on-explicit-save (> ssh-deploy-on-explicit-save 0))
(ssh-deploy-upload-handler)))
+
+(defun ssh-deploy-add-after-save-hook () "Add the `after-save-hook'."
+ (when (fboundp 'ssh-deploy-after-save)
+ (add-hook 'after-save-hook 'ssh-deploy-after-save)))
+
+(defun ssh-deploy-find-file () "Logic for detecting remote change."
+ (when (and (boundp 'ssh-deploy-automatically-detect-remote-changes)
ssh-deploy-automatically-detect-remote-changes (>
ssh-deploy-automatically-detect-remote-changes 0))
(ssh-deploy-remote-changes-handler)))
+
+(defun ssh-deploy-add-find-file-hook () "Add the `find-file-hook'."
+ (when (fboundp 'ssh-deploy-find-file) (add-hook 'find-file-hook
'ssh-deploy-find-file)))
+
+(when (fboundp 'defhydra)
+ (defhydra ssh-deploy-hydra (:color red :hint nil)
+ "
+ SSH Deploy Menu
+
+ _u_: Upload _f_: Force Upload
+ _d_: Download
+ _D_: Delete
+ _x_: Difference
+ _t_: Eshell Base Terminal _T_: Eshell Relative Terminal
+ _h_: Shell Base Terminal _H_: Shell Relative Terminal
+ _e_: Detect Remote Changes
+ _R_: Rename
+ _b_: Browse Base _B_: Browse Relative
+ _o_: Open current file on remote _m_: Open sql-mysql on remote
+ _s_: Run deploy script
+ "
+ ("f" ssh-deploy-upload-handler-forced)
+ ("u" ssh-deploy-upload-handler)
+ ("d" ssh-deploy-download-handler)
+ ("D" ssh-deploy-delete-handler)
+ ("x" ssh-deploy-diff-handler)
+ ("t" ssh-deploy-remote-terminal-eshell-base-handler)
+ ("T" ssh-deploy-remote-terminal-eshell-handler)
+ ("h" ssh-deploy-remote-terminal-shell-base-handler)
+ ("H" ssh-deploy-remote-terminal-shell-handler)
+ ("e" ssh-deploy-remote-changes-handler)
+ ("R" ssh-deploy-rename-handler)
+ ("b" ssh-deploy-browse-remote-base-handler)
+ ("B" ssh-deploy-browse-remote-handler)
+ ("o" ssh-deploy-open-remote-file-handler)
+ ("m" ssh-deploy-remote-sql-mysql-handler)
+ ("s" ssh-deploy-run-deploy-script-handler)))
+
+(defvar ssh-deploy-prefix-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "f" 'ssh-deploy-upload-handler-force)
+ (define-key map "u" 'ssh-deploy-upload-handle)
+ (define-key map "D" 'ssh-deploy-delete-handler)
+ (define-key map "d" 'ssh-deploy-download-handler)
+ (define-key map "x" 'ssh-deploy-diff-handler)
+ (define-key map "t" 'ssh-deploy-remote-terminal-eshell-base-handler)
+ (define-key map "T" 'ssh-deploy-remote-terminal-eshell-handler)
+ (define-key map "h" 'ssh-deploy-remote-terminal-shell-base-handler)
+ (define-key map "H" 'ssh-deploy-remote-terminal-shell-handler)
+ (define-key map "R" 'ssh-deploy-rename-handler)
+ (define-key map "e" 'ssh-deploy-remote-changes-handler)
+ (define-key map "b" 'ssh-deploy-browse-remote-base-handler)
+ (define-key map "B" 'ssh-deploy-browse-remote-handler)
+ (define-key map "o" 'ssh-deploy-open-remote-file-handler)
+ (define-key map "m" 'ssh-deploy-remote-sql-mysql-handler)
+ (define-key map "s" 'ssh-deploy-run-deploy-script-handler)
+ map))
+(fset 'ssh-deploy-prefix-map ssh-deploy-prefix-map)
(provide 'ssh-deploy)
;;; ssh-deploy.el ends here
-
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/ssh-deploy b692b66: Merged changes from GitHub,
Christian Johansson <=