[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ssh-deploy 6fbc09f 010/133: Various changes relating to
From: |
Stefan Monnier |
Subject: |
[elpa] externals/ssh-deploy 6fbc09f 010/133: Various changes relating to changing optional boolean argument to |
Date: |
Sat, 27 Mar 2021 14:48:33 -0400 (EDT) |
branch: externals/ssh-deploy
commit 6fbc09fa5d815244f62bb004a0ac2bd394474e25
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>
Various changes relating to changing optional boolean argument to
optional integer
---
README.md | 39 ++-
ssh-deploy-diff-mode.el | 2 +-
ssh-deploy.el | 790 ++++++++++++++++++++++--------------------------
3 files changed, 391 insertions(+), 440 deletions(-)
diff --git a/README.md b/README.md
index b5ebf4f..7929a0f 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,5 @@
-# `emacs-ssh-deploy`
[![MELPA](http://melpa.org/packages/ssh-deploy-badge.svg)](http://melpa.org/#/ssh-deploy)
[![MELPA
Stable](http://stable.melpa.org/packages/ssh-deploy-badge.svg)](http://stable.melpa.org/#/ssh-deploy)
+# `emacs-ssh-deploy`
+[![License GPL
3](https://img.shields.io/badge/license-GPL_3-green.svg)](https://www.gnu.org/licenses/gpl-3.0.txt)
[![MELPA](https://melpa.org/packages/ssh-deploy-badge.svg)](https://melpa.org/#/ssh-deploy)
[![MELPA
Stable](https://stable.melpa.org/packages/ssh-deploy-badge.svg)](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 `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.
`~/.netrc`, `~/.authinfo` or `~/.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,24 +29,27 @@ 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
`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, default t *(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, default nil
*(integer)*
+
+When integers are used as booleans, above zero equals true and otherwise it's
false.
## 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.
@@ -149,6 +153,7 @@ 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)
+(ssh-deploy-line-mode) ;; If you want mode-line feature
(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) ))
@@ -178,6 +183,7 @@ By combining a `~/.netrc`, `~/.authinfo` or
`~/.authinfo.gpg` setup and a `publi
: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)) )))
:config
+ (ssh-deploy-line-mode) ;; If you want mode-line feature
(defhydra hydra-ssh-deploy (:color red :hint nil)
"
_u_: Upload _f_: Force Upload
@@ -210,7 +216,7 @@ By combining a `~/.netrc`, `~/.authinfo` or
`~/.authinfo.gpg` setup and a `publi
("s" ssh-deploy-run-deploy-script-handler)))
```
-(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*
@@ -248,9 +254,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 9331850..e6d3f99 100644
--- a/ssh-deploy-diff-mode.el
+++ b/ssh-deploy-diff-mode.el
@@ -1,4 +1,4 @@
-;;; ssh-deploy-diff-mode.el --- Mode for interactive directory differences
+;;; ssh-deploy-diff-mode.el --- Mode for interactive directory differences -*-
lexical-binding: t -*-
;; Author: Christian Johansson <github.com/cjohansson>
;; Maintainer: Christian Johansson <github.com/cjohansson>
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 7ff218e..55e3e78 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -1,22 +1,20 @@
-;;; ssh-deploy.el --- Deployment via TRAMP, global or per directory.
+;;; ssh-deploy.el --- Deployment via TRAMP, global or per directory. -*-
lexical-binding: t -*-
-;; Author: Christian Johansson <github.com/cjohansson>
-;; Maintainer: Christian Johansson <github.com/cjohansson>
+;; Author: Christian Johansson <christian@cvj.se>
+;; Maintainer: Christian Johansson <christian@cvj.se>
;; Created: 5 Jul 2016
-;; Modified: 19 Aug 2018
-;; Version: 1.98
+;; Modified: 24 Oct 2018
+;; Version: 2.01
;; Keywords: tools, convenience
;; URL: https://github.com/cjohansson/emacs-ssh-deploy
;; Package-Requires: ((emacs "24"))
-;; Copyright (C) 2017 - 2018 Christian Johansson
-
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
+;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
@@ -26,7 +24,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Spathoftware Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
@@ -36,7 +34,7 @@
;; detection of remote changes, remote directory browsing, remote SQL database
sessions and
;; running custom deployment scripts via TRAMP.
;;
-;; For asynchronous operations it uses package `async.el'.
+;; For asynchronous operations it uses package '`make-thread' or if not
available '`async.el'.
;;
;; By setting the variables (globally, per directory or per file):
;; ssh-deploy-root-local,ssh-deploy-root-remote, ssh-deploy-on-explicit-save
@@ -51,38 +49,45 @@
;;
;; Set permissions to this file to 600 with your user as the owner.
;;
+;; 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-hook 'after-save-hook (lambda() (if (and (boundp
'ssh-deploy-on-explicit-save) ssh-deploy-on-explicit-save)
(ssh-deploy-upload-handler)) ))
+;; (add-hook 'after-save-hook (lambda() (if (and (boundp
'ssh-deploy-on-explicit-save) (> ssh-deploy-on-explicit-save 0))
(ssh-deploy-upload-handler)) ))
;;
;; - To setup automatic storing of base revisions and detection of remote
changes do this:
-;; (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)) ))
+;; (add-hook 'find-file-hook (lambda() (if (and (boundp
'ssh-deploy-automatically-detect-remote-changes) (>
ssh-deploy-automatically-detect-remote-changes 0))
(ssh-deploy-remote-changes-handler)) ))
+;;
+;; - To enable mode line to this:
+;; (ssh-deploy-line-mode)
;;
;; - To set key-bindings do something like this:
-;; (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 B") (lambda()
(interactive)(ssh-deploy-browse-remote-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) ))
+;; (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 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 (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)) )))
+;; :hook ((after-save . (lambda() (if (and (boundp
'ssh-deploy-on-explicit-save) (> ssh-deploy-on-explicit-save 0)
(ssh-deploy-upload-handler)) )))
+;; (find-file . (lambda() (if (and (boundp
'ssh-deploy-automatically-detect-remote-changes) (>
ssh-deploy-automatically-detect-remote-changes 0))
(ssh-deploy-remote-changes-handler)) )))
;; :config
+;; (ssh-deploy-line-mode) ;; If you want mode-line feature
;; (defhydra hydra-ssh-deploy (:color red :hint nil)
;; "
;; _u_: Upload _f_: Force Upload
@@ -145,27 +150,30 @@
;; * `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
`async.el` installed 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, default t *(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, default nil
*(integer)*
+;;
+;; When integers are used as booleans, above zero equals true and otherwise
it's false.
;;
;; Please see README.md from the same repository for extended documentation.
;;; Code:
-(require 'ssh-deploy-diff-mode) ;; FIXME flycheck complains.. but why?
+(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."
@@ -174,86 +182,80 @@
(defcustom ssh-deploy-root-local nil
"String variable of local root, nil by default."
- :type 'string
- :group 'ssh-deploy)
+ :type 'string)
(put 'ssh-deploy-root-local 'permanent-local t)
(put 'ssh-deploy-root-local 'safe-local-variable 'stringp)
(defcustom ssh-deploy-root-remote nil
"String variable of remote root, nil by default."
- :type 'string
- :group 'ssh-deploy)
+ :type 'string)
(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."
- :type 'boolean
- :group 'ssh-deploy)
+(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."
- :type 'boolean
- :group 'ssh-deploy)
+(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."
- :type 'boolean
- :group 'ssh-deploy)
+(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."
- :type 'boolean
- :group 'ssh-deploy)
+(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-revision-folder "~/.ssh-deploy-revisions/"
- "String variable with path to revisions with trailing slash."
- :type 'string
- :group 'ssh-deploy)
+ "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."
- :type 'boolean
- :group 'ssh-deploy)
+(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."
- :type 'list
- :group 'ssh-deploy)
+ "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)
(defcustom ssh-deploy-remote-sql-database nil
"String variable of remote sql database, nil by default."
- :type 'string
- :group 'ssh-deploy)
+ :type 'string)
(put 'ssh-deploy-remote-sql-database 'permanent-local t)
(put 'ssh-deploy-remote-sql-database 'safe-local-variable 'stringp)
(defcustom ssh-deploy-remote-sql-password nil
"String variable of remote sql password, nil by default."
- :type 'string
- :group 'ssh-deploy)
+ :type 'string)
(put 'ssh-deploy-remote-sql-password 'permanent-local t)
(put 'ssh-deploy-remote-sql-password 'safe-local-variable 'stringp)
(defcustom ssh-deploy-remote-sql-port nil
"Integer variable of remote sql port, nil by default."
- :type 'number
- :group 'ssh-deploy)
+ :type 'number)
(put 'ssh-deploy-remote-sql-port 'permanent-local t)
(put 'ssh-deploy-remote-sql-port 'safe-local-variable 'integerp)
@@ -266,22 +268,19 @@
(defcustom ssh-deploy-remote-sql-user nil
"String variable of remote sql user, nil by default."
- :type 'string
- :group 'ssh-deploy)
+ :type 'string)
(put 'ssh-deploy-remote-sql-user 'permanent-local t)
(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."
- :type 'string
- :group 'ssh-deploy)
+ "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
- :group 'ssh-deploy)
+ :type 'function)
(put 'ssh-deploy-script 'permanent-local t)
(put 'ssh-deploy-script 'safe-local-variable 'functionp)
@@ -316,13 +315,35 @@
;; PRIVATE FUNCTIONS
;;
;; these functions are only used internally and should be of no value to
outside public and handler functions.
-;; these functions MUST not use module variables.
-
+;; these functions MUST not use module variables in any way.
+
+
+(defun ssh-deploy--async-process (start &optional finish with-threads)
+ "Asynchronously do START and then optionally do FINISH, use multi-treading
if WITH-THREADS is above 0 otherwise use multi processes via async.el."
+ (if (and (fboundp 'make-thread)
+ with-threads
+ (> with-threads 0))
+ (make-thread (lambda()
+ (if start
+ (let ((result (funcall start)))
+ (if finish
+ (funcall finish result))))))
+ (if (fboundp 'async-start)
+ (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)
"Set the mode line STATUS in optionally in buffer visiting FILENAME."
- (if (and (boundp 'filename)
- filename)
+ (if filename
(let ((buffer (find-buffer-visiting filename)))
(when buffer
(with-current-buffer buffer
@@ -349,8 +370,7 @@
(defun ssh-deploy--mode-line-status-update (&optional status)
"Update the local status text variable to a text representation based on
STATUS."
- (unless (and (boundp 'status)
- status)
+ (unless status
;; (message "SSH Deploy -Resetting status: %s" status)
(setq status ssh-deploy--status-undefined))
(let ((status-text ""))
@@ -363,7 +383,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.."))
@@ -384,7 +404,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."
@@ -419,42 +439,41 @@
(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."
- (if (fboundp 'async-start)
- (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))
- (async-start
- `(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)))
- (progn
- (if (not (file-directory-p (file-name-directory
,path-remote)))
- (make-directory (file-name-directory
,path-remote) t))
- (copy-file ,path-local ,path-remote t t t t)
- (copy-file ,path-local ,revision-path t t t t)
- (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)
- (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)))))
- (progn
- (when ssh-deploy-verbose (message "Uploading directory '%s' to
'%s'.. (asynchronously)" path-local path-remote))
- (async-start
- `(lambda()
- (copy-directory ,path-local ,path-remote t t t)
- ,path-local)
- (lambda(return-path)
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle return-path)
- (when ssh-deploy-verbose (message "Completed upload of
directory '%s'. (asynchronously)" return-path)))))))
- (display-warning 'ssh-deploy "async.el is not installed" :warning)))
+(defun ssh-deploy--upload-via-tramp-async (path-local path-remote force
revision-folder 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 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()
+ (require 'ediff-util)
+ (if (fboundp 'ediff-same-file-contents)
+ (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))
+ (copy-file path-local path-remote t t t t)
+ (copy-file path-local revision-path t t t t)
+ (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)
+ (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)))
+ with-threads))
+ (progn
+ (when ssh-deploy-verbose (message "Uploading directory '%s' to '%s'..
(asynchronously)" path-local path-remote))
+ (ssh-deploy--async-process
+ (lambda()
+ (copy-directory path-local path-remote t t t)
+ path-local)
+ (lambda(return-path)
+ (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle return-path)
+ (when ssh-deploy-verbose (message "Completed upload of directory
'%s'. (asynchronously)" return-path))))))))
(defun ssh-deploy--upload-via-tramp (path-local path-remote force
revision-folder)
"Upload PATH-LOCAL to PATH-REMOTE via TRAMP synchronously and FORCE despite
remote change compared with copy in REVISION-FOLDER."
@@ -484,31 +503,30 @@
(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."
- (if (fboundp 'async-start)
- (let ((revision-path (ssh-deploy--get-revision-path path-local
revision-folder)))
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-downloading path-local)
- (when ssh-deploy-verbose (message "Downloading '%s' to '%s'..
(asynchronously)" path-remote path-local))
- (async-start
- `(lambda()
- (let ((file-or-directory (not (file-directory-p ,path-remote))))
- (if file-or-directory
- (progn
- (if (not (file-directory-p (file-name-directory
,path-local)))
- (make-directory (file-name-directory ,path-local) t))
- (copy-file ,path-remote ,path-local t t t t)
- (copy-file ,path-local ,revision-path t t t t))
- (copy-directory ,path-remote ,path-local t t t))
- ,path-local))
- (lambda(return-path)
- (ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle return-path)
- (when ssh-deploy-verbose (message "Completed download of '%s'.
(asynchronously)" return-path))
- (let ((local-buffer (find-buffer-visiting return-path)))
- (when local-buffer
- (with-current-buffer local-buffer
- (revert-buffer t t t)))))))
- (display-warning 'ssh-deploy "async.el is not installed" :warning)))
+(defun ssh-deploy--download-via-tramp-async (path-remote path-local
revision-folder with-threads)
+ "Download PATH-REMOTE to PATH-LOCAL via TRAMP asynchronously and make a copy
in REVISION-FOLDER, use multi-threading if 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()
+ (let ((file-or-directory (not (file-directory-p path-remote))))
+ (if file-or-directory
+ (progn
+ (if (not (file-directory-p (file-name-directory path-local)))
+ (make-directory (file-name-directory path-local) t))
+ (copy-file path-remote path-local t t t t)
+ (copy-file path-local revision-path t t t t))
+ (copy-directory path-remote path-local t t t))
+ path-local))
+ (lambda(return-path)
+ (ssh-deploy--mode-line-set-status-and-update ssh-deploy--status-idle
return-path)
+ (when ssh-deploy-verbose (message "Completed download of '%s'.
(asynchronously)" return-path))
+ (let ((local-buffer (find-buffer-visiting return-path)))
+ (when local-buffer
+ (with-current-buffer local-buffer
+ (revert-buffer t t t)))))
+ 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."
@@ -707,7 +725,7 @@
;; these functions MUST only use module variables as fall-backs for missing
arguments.
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-diff-files (file-a file-b)
"Find difference between FILE-A and FILE-B."
(require 'ediff-util)
@@ -719,25 +737,26 @@
(ediff file-a file-b)))
(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."
- (if (not (boundp 'async))
+;;;###autoload
+(defun ssh-deploy-diff-directories (directory-a directory-b &optional
exclude-list async with-threads)
+ "Find difference between DIRECTORY-A and DIRECTORY-B but exclude paths
matching EXCLUDE-LIST, do it asynchronously is ASYNC is true, use
multi-threading if WITH-THREADS is above zero.."
+ (if (not async)
(setq async ssh-deploy-async))
- (if (not (boundp 'exclude-list))
+ (if (not exclude-list)
(setq exclude-list ssh-deploy-exclude-list))
- (if (and async (fboundp 'async-start))
+ (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)
- (async-start
- `(lambda()
- (add-to-list 'load-path ,script-filename)
+ (ssh-deploy--async-process
+ (lambda()
+ (add-to-list 'load-path script-filename)
(require 'ssh-deploy)
- (ssh-deploy--diff-directories-data ,directory-a ,directory-b (list
,@exclude-list)))
+ (ssh-deploy--diff-directories-data directory-a directory-b (list
@exclude-list))) ;; Flycheck complains - why?
(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)))
+ (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)))))
+ (ssh-deploy--diff-directories-present diff)))
+ 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)))
@@ -745,9 +764,9 @@
(if (or (> (length (nth 4 diff)) 0) (> (length (nth 5 diff)) 0) (>
(length (nth 7 diff)) 0))
(ssh-deploy--diff-directories-present diff))))))
-;;;### 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."
+;;;###autoload
+(defun ssh-deploy-remote-changes (path-local &optional root-local root-remote
async revision-folder exclude-list 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 WITH-THREADS is above zero."
(let ((root-local (or root-local ssh-deploy-root-local))
(root-remote (or root-remote ssh-deploy-root-remote)))
@@ -766,31 +785,29 @@
;; Does a local revision of the file exist?
(if (file-exists-p revision-path)
- ;; Local revision exist. Is async.el installed?
- (if (and async (fboundp 'async-start))
-
- ;; Async.el is installed
+ ;; Local revision exist. Is async enabled?
+ (if (> async 0)
(progn
;; Update buffer status
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-detecting-remote-changes)
;; Asynchronous logic here
- (async-start
- `(lambda()
- (if (file-exists-p ,path-remote)
+ (ssh-deploy--async-process
+ (lambda()
+ (if (file-exists-p path-remote)
(progn
(require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
- (if (ediff-same-file-contents
,revision-path ,path-remote)
- (list 0 (format "Remote file '%s'
has not changed. (asynchronously)" ,path-remote) ,path-local)
- (if (ediff-same-file-contents
,path-local ,path-remote)
+ (if (ediff-same-file-contents
revision-path path-remote)
+ (list 0 (format "Remote file '%s'
has not changed. (asynchronously)" path-remote) path-local)
+ (if (ediff-same-file-contents
path-local path-remote)
(progn
- (copy-file ,path-local
,revision-path t t t t)
- (list 0 (format "Remote file
'%s' is identical to local file '%s' but different to local revision. Updated
local revision. (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 "Function
'ediff-same-file-contents' is missing. (asynchronously)" ,path-local)))
- (list 0 (format "Remote file '%s' doesn't
exist. (asynchronously)" ,path-remote) ,path-local)))
+ (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 "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)
;; Update buffer status to idle
@@ -798,9 +815,10 @@
(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)))
+ with-threads))
- ;; Async.el is not installed - synchronous logic here
+ ;; Async is not enabled - synchronous logic here
(progn
;; Update buffer status
@@ -820,31 +838,29 @@
;; Update buffer status to idle
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-idle)))
- ;; Does not have local revision. Is async.el installed?
- (if (and async (fboundp 'async-start))
-
- ;; Async.el is installed
+ ;; Does not have local revision. Is async enabled?
+ (if (> async 0)
(progn
;; Update buffer status
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-detecting-remote-changes)
;; Asynchronous logic here
- (async-start
- `(lambda()
+ (ssh-deploy--async-process
+ (lambda()
;; Does remote file exist?
- (if (file-exists-p ,path-remote)
+ (if (file-exists-p path-remote)
(progn
(require 'ediff-util)
(if (fboundp 'ediff-same-file-contents)
- (if (ediff-same-file-contents
,path-local ,path-remote)
+ (if (ediff-same-file-contents path-local
path-remote)
(progn
- (copy-file ,path-local
,revision-path t t t t)
- (list 0 (format "Remote file '%s'
has not changed, created base revision. (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)))
+ (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 "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)
;; Update buffer status to idle
@@ -852,9 +868,10 @@
(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)))
+ with-threads))
- ;; Async.el is not installed - synchronous logic here
+ ;; Async is not enabled - synchronous logic here
(progn
;; Update buffer status
@@ -882,23 +899,22 @@
;; 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)))))
-(defun ssh-deploy-delete (path &optional async debug buffer)
- "Delete PATH and use flags ASYNC and DEBUG, set status in BUFFER."
- (if (and async (fboundp 'async-start))
+(defun ssh-deploy-delete (path &optional async buffer with-threads)
+ "Delete PATH and use flags ASYNC, set status in BUFFER. Use multi-threading
if WITH-THREADS is above zero."
+ (if (> async 0)
(progn
- (when (and (boundp 'buffer)
- buffer)
+ (when buffer
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting buffer))
- (async-start
- `(lambda()
- (if (file-exists-p ,path)
- (let ((file-or-directory (not (file-directory-p ,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 ,buffer)))
- (list ,path 1 ,buffer)))
+ (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))
@@ -906,19 +922,18 @@
(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))))))
+ (t (display-warning 'ssh-deploy (format "Did not find '%s'
for deletion. (asynchronously)" (nth 0 response)) :warning))))
+ with-threads))
(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 (and (boundp 'buffer)
- buffer)
+ (when buffer
(ssh-deploy--mode-line-set-status-and-update
ssh-deploy--status-deleting buffer))
(progn
(if file-or-directory
(delete-file path t)
(delete-directory path t t))
- (when (and (boundp 'buffer)
- buffer)
+ (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
@@ -926,26 +941,27 @@
(message "Completed deletion of '%s'. (synchronously)" path)))
(display-warning 'ssh-deploy (format "Did not find '%s' for deletion.
(synchronously)" path) :warning))))
-;;;### autoload
+;;;###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."
(let ((root-local (or root-local ssh-deploy-root-local))
(root-remote (or root-remote ssh-deploy-root-remote)))
+ (if (not exclude-list)
+ (setq 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 ((exclude-list (or exclude-list ssh-deploy-exclude-list))
- (file-or-directory (not (file-directory-p path-local)))
- (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)))))
-
-;;;### 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."
- (if (not (boundp 'debug))
+ (let ((path-remote (concat root-remote (ssh-deploy--get-relative-path
root-local path-local))))
+ (ssh-deploy-delete path-local async path-local)
+ (ssh-deploy-delete path-remote async path-local))
+ (when (> debug 0) (message "Path '%s' is not in the root '%s' or is
excluded from it." path-local root-local)))))
+
+;; TODO Should check if file is excluded here?
+;;;###autoload
+(defun ssh-deploy-rename (old-path-local new-path-local &optional root-local
root-remote async debug exclude-list 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 WITH-THREADS is above zero."
+ (if (not debug)
(setq debug ssh-deploy-debug))
- (if (not (boundp 'async))
+ (if (not async)
(setq async ssh-deploy-async))
(let ((root-local (or root-local ssh-deploy-root-local))
(root-remote (or root-remote ssh-deploy-root-remote)))
@@ -966,22 +982,23 @@
(set-buffer-modified-p nil))
(dired new-path-local))
(message "Renamed '%s' to '%s'." old-path-local new-path-local)
- (if (and async (fboundp 'async-start))
- (async-start
- `(lambda()
- (rename-file ,old-path-remote ,new-path-remote t)
- (list ,old-path-remote ,new-path-remote ,new-path-local))
+ (if (> async 0)
+ (ssh-deploy--async-process
+ (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)))
+ 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
+;;;###autoload
(defun ssh-deploy-remote-sql (remote-path &optional type)
"Open remote sql on REMOTE-PATH, TYPE determines type and defaults to mysql."
(let ((sql-type (or type "mysql"))
@@ -1005,7 +1022,7 @@
((string= sql-type "postgres") (sql-postgres remote-path))
(t (display-warning 'ssh-deploy (format "SQL type %s not supported"
type) :warning)))))
-;;;### autoload
+;;;###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))
@@ -1017,7 +1034,7 @@
(message "Opening '%s' for browsing on remote host.." path-remote)
(dired path-remote)))))
-;;;### autoload
+;;;###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))
@@ -1026,15 +1043,14 @@
(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 ((old-directory default-directory))
- (require 'eshell)
- (message "Opening eshell on '%s'.." path-remote)
- (let ((default-directory path-remote))
- (defvar eshell-buffer-name)
- (setq eshell-buffer-name path-remote)
- (eshell)))))))
-
-;;;### autoload
+ (require 'eshell)
+ (message "Opening eshell on '%s'.." path-remote)
+ (let ((default-directory path-remote))
+ (defvar eshell-buffer-name)
+ (setq eshell-buffer-name path-remote)
+ (eshell))))))
+
+;;;###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))
@@ -1043,14 +1059,13 @@
(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 ((old-directory default-directory))
- (require 'shell)
- (message "Opening eshell on '%s'.." path-remote)
- (let ((default-directory path-remote)
- (explicit-shell-file-name ssh-deploy-remote-shell-executable))
- (shell path-remote)))))))
-
-;;;### autoload
+ (require 'shell)
+ (message "Opening eshell on '%s'.." path-remote)
+ (let ((default-directory path-remote)
+ (explicit-shell-file-name ssh-deploy-remote-shell-executable))
+ (shell path-remote))))))
+
+;;;###autoload
(defun ssh-deploy-store-revision (path &optional root)
"Store PATH in revision-folder ROOT."
(if (not (file-directory-p path))
@@ -1059,16 +1074,16 @@
(when ssh-deploy-verbose (message "Storing revision of '%s' at '%s'.."
path revision-path))
(copy-file path revision-path t t t t))))
-;;;### autoload
+;;;###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."
(let ((file-or-directory (not (file-directory-p path-local)))
(exclude-list (or exclude-list ssh-deploy-exclude-list)))
- (if (not (boundp 'root-local))
+ (if (not root-local)
(setq root-local ssh-deploy-root-local))
- (if (not (boundp 'debug))
+ (if (not debug)
(setq debug ssh-deploy-debug))
- (if (not (boundp 'async))
+ (if (not async)
(setq async ssh-deploy-async))
(if (and (ssh-deploy--file-is-in-path path-local root-local)
(ssh-deploy--file-is-included path-local exclude-list))
@@ -1077,26 +1092,30 @@
(ssh-deploy-diff-directories path-local path-remote exclude-list
async))
(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."
- (if (not (boundp 'async))
+;;;###autoload
+(defun ssh-deploy-upload (path-local path-remote &optional force async
revision-folder 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
WITH-THREADS above zero."
+ (if (not async)
(setq async ssh-deploy-async))
- (if (not (boundp 'force))
- (setq force nil))
+ (if (not force)
+ (setq force 0))
+ (if (not with-threads)
+ (setq with-threads 0))
(let ((revision-folder (or revision-folder ssh-deploy-revision-folder)))
- (if (and async (fboundp 'async-start))
- (ssh-deploy--upload-via-tramp-async path-local path-remote force
revision-folder)
+ (if (> async 0)
+ (ssh-deploy--upload-via-tramp-async path-local path-remote force
revision-folder 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."
- (if (not (boundp 'async))
+;;;###autoload
+(defun ssh-deploy-download (path-remote path-local &optional async
revision-folder 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 WITH-THREADS above zero."
+ (if (not async)
(setq async ssh-deploy-async))
+ (if (not with-threads)
+ (setq with-threads 0))
(let ((revision-folder (or revision-folder ssh-deploy-revision-folder)))
- (if (and async (fboundp 'async-start))
- (ssh-deploy--download-via-tramp-async path-remote path-local
revision-folder)
+ (if (> async 0)
+ (ssh-deploy--download-via-tramp-async path-remote path-local
revision-folder with-threads)
(ssh-deploy--download-via-tramp path-remote path-local
revision-folder))))
@@ -1106,7 +1125,7 @@
;; these functions MUST depend on module variables.
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-upload-handler (&optional force)
"Upload current path to remote if it is configured for deployment and if
remote version hasn't changed or FORCE is specified."
(interactive)
@@ -1114,8 +1133,8 @@
(ssh-deploy--is-not-empty-string ssh-deploy-root-remote))
(let ((root-local (file-truename ssh-deploy-root-local))
path-local)
- (if (not (boundp 'force))
- (setq force nil))
+ (if (not force)
+ (setq force 0))
(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))
@@ -1129,13 +1148,13 @@
(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))))))
-;;;### autoload
+;;;###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
+;;;###autoload
(defun ssh-deploy-remote-changes-handler()
"Check if local revision exists or remote file has changed if path is
configured for deployment."
(interactive)
@@ -1147,20 +1166,21 @@
(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."))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-remote-sql-mysql-handler()
"Open `sql-mysql' on remote path if path is configured for deployment."
(interactive)
(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)
(when (ssh-deploy--is-not-empty-string ssh-deploy-root-remote)
(ssh-deploy-remote-sql ssh-deploy-root-remote "postgres")))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-open-remote-file-handler()
"Check if local revision exists or remote file has changed if path is
configured for deployment."
(interactive)
@@ -1173,7 +1193,7 @@
(when ssh-deploy-verbose (message "Opening file on remote '%s'"
path-remote))
(find-file path-remote))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-download-handler ()
"Download current path from remote if it is configured for deployment."
(interactive)
@@ -1194,7 +1214,7 @@
(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))))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-diff-handler ()
"Compare current path with remote host if it is configured for deployment."
(interactive)
@@ -1213,7 +1233,7 @@
(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))))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-delete-handler ()
"Delete current file or directory."
(interactive)
@@ -1234,7 +1254,7 @@
(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)))))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-rename-handler ()
"Rename current file or directory."
(interactive)
@@ -1259,7 +1279,7 @@
(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)))))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-remote-terminal-eshell-handler ()
"Open current relative path on remote host in `eshell' but only if it's
configured for deployment."
(interactive)
@@ -1270,7 +1290,7 @@
(root-local (file-truename ssh-deploy-root-local)))
(ssh-deploy-remote-terminal-eshell path-local root-local
ssh-deploy-root-remote ssh-deploy-exclude-list))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-remote-terminal-eshell-base-handler ()
"Open base path on remote host in `eshell' but only if it's configured for
deployment."
(interactive)
@@ -1279,7 +1299,7 @@
(let ((root-local (file-truename ssh-deploy-root-local)))
(ssh-deploy-remote-terminal-eshell root-local root-local
ssh-deploy-root-remote ssh-deploy-exclude-list))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-remote-terminal-shell-handler ()
"Open current relative path on remote host in `eshell' but only if it's
configured for deployment."
(interactive)
@@ -1290,7 +1310,7 @@
(root-local (file-truename ssh-deploy-root-local)))
(ssh-deploy-remote-terminal-shell path-local root-local
ssh-deploy-root-remote ssh-deploy-exclude-list))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-remote-terminal-shell-base-handler ()
"Open base path on remote host in `eshell' but only if it's configured for
deployment."
(interactive)
@@ -1299,7 +1319,7 @@
(let ((root-local (file-truename ssh-deploy-root-local)))
(ssh-deploy-remote-terminal-shell root-local root-local
ssh-deploy-root-remote ssh-deploy-exclude-list))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-browse-remote-handler ()
"Open current relative path on remote host in `dired-mode' if it is
configured for deployment."
(interactive)
@@ -1310,7 +1330,7 @@
(root-local (file-truename ssh-deploy-root-local)))
(ssh-deploy-browse-remote path-local root-local ssh-deploy-root-remote
ssh-deploy-exclude-list))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-browse-remote-base-handler ()
"Open base path on remote host in `dired-mode' if it is configured for
deployment."
(interactive)
@@ -1319,28 +1339,25 @@
(let ((root-local (file-truename ssh-deploy-root-local)))
(ssh-deploy-browse-remote root-local root-local ssh-deploy-root-remote
ssh-deploy-exclude-list))))
-;;;### autoload
+;;;###autoload
(defun ssh-deploy-run-deploy-script-handler ()
"Run `ssh-deploy-script' with `funcall'."
(interactive)
- (if (and (boundp 'ssh-deploy-script)
- ssh-deploy-script)
- (if ssh-deploy-async
- (if (fboundp 'async-start)
- (progn
- (message "Executing of deployment-script starting...
(asynchronously)")
- (async-start
- `(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. '%s'(asynchronously)" result))))
- (display-warning 'ssh-deploy "async.el is not installed" :warning))
+ (if ssh-deploy-script
+ (if (> ssh-deploy-async 0)
+ (progn
+ (message "Executing of deployment-script starting...
(asynchronously)")
+ (ssh-deploy--async-process
+ `(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!"
type) :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
@@ -1349,115 +1366,36 @@
;; This is particularly useful when key-bindings are not working because of
some mode
;; overriding them.
-(define-key-after
- global-map
- [menu-bar sshdeploy]
- (cons "Deployment" (make-sparse-keymap "Menu for SSH Deploy"))
- 'tools)
-
-(define-key
- global-map
- [menu-bar sshdeploy pq]
- '("PostgreSQL" . ssh-deploy-remote-sql-postgres-handler))
-(define-key
- global-map
- [menu-bar sshdeploy mq]
- '("MySQL" . ssh-deploy-remote-sql-mysql-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep1]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy sb]
- '("Shell Base" . ssh-deploy-remote-terminal-shell-base-handler))
-(define-key
- global-map
- [menu-bar sshdeploy ss]
- '("Shell" . ssh-deploy-remote-terminal-shell-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep2]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy eb]
- '("Eshell Base" . ssh-deploy-remote-terminal-eshell-base-handler))
-(define-key
- global-map
- [menu-bar sshdeploy es]
- '("Eshell" . ssh-deploy-remote-terminal-eshell-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep3]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy bb]
- '("Browse Base" . ssh-deploy-browse-remote-base-handler))
-(define-key
- global-map
- [menu-bar sshdeploy br]
- '("Browse" . ssh-deploy-browse-remote-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep4]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy df]
- '("Difference" . ssh-deploy-diff-handler))
-(define-key
- global-map
- [menu-bar sshdeploy rc]
- '("Detect Remote Changes" . ssh-deploy-remote-changes-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep5]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy de]
- '("Delete" . ssh-deploy-delete-handler))
-(define-key
- global-map
- [menu-bar sshdeploy rn]
- '("Rename" . ssh-deploy-rename-handler))
-(define-key
- global-map
- [menu-bar sshdeploy op]
- '("Open" . ssh-deploy-open-remote-file-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep6]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy sc]
- '("Run script" . ssh-deploy-run-deploy-script-handler))
-(define-key
- global-map
- [menu-bar sshdeploy sep7]
- '("--"))
-
-(define-key
- global-map
- [menu-bar sshdeploy ulf]
- '("Forced Upload" . ssh-deploy-upload-handler-forced))
-(define-key
- global-map
- [menu-bar sshdeploy ul]
- '("Upload" . ssh-deploy-upload-handler))
-(define-key
- global-map
- [menu-bar sshdeploy dl]
- '("Download" . ssh-deploy-download-handler))
+
+(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 [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 [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 [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 [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 [sep6] '("--"))
+ (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))
+ map))
+
+(define-key-after global-map [menu-bar sshdeploy] (cons "Deployment"
ssh-deploy-menu-map) 'tools)
;;; Mode Line
@@ -1468,10 +1406,8 @@
: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
-(ssh-deploy-line-mode)
+(ssh-deploy--mode-line-status-refresh)
(provide 'ssh-deploy)
- [elpa] externals/ssh-deploy updated (9efc523 -> fce4ea3), Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 364a99f 003/133: Added lexical-binding as file-local variable, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy df87f38 005/133: Optimized menu-bar code, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 64e049b 001/133: Added license badge, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy b8468ec 004/133: Added flag for using threads or not, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 2af7bec 007/133: Mode-line working again after changes, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy ad12e19 008/133: Run deployment script working again after lexical-binding, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy cb792e8 002/133: Added ELPA to description and changed http references to https, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 71796c3 006/133: Optimization for menu-code completed, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 6fbc09f 010/133: Various changes relating to changing optional boolean argument to,
Stefan Monnier <=
- [elpa] externals/ssh-deploy b93b944 009/133: Updated README for optional threading and mode-line, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy d934ef8 017/133: More work on optional booleans to integers, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy edee8df 019/133: Improved documentation, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 4073f79 014/133: Updated documentation to suggest ~/.authinfo.gpg usage, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 2048399 021/133: Passing async-with-threads to directory diff, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 54ec0d2 023/133: Updated mode-line logic for deletions, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy fbc6e85 025/133: Created predefined hydra, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 947a3c7 024/133: Improved usability with pre-defined hooks, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy 20ce7f2 026/133: Created a pred-fined prefix map and hydra map, Stefan Monnier, 2021/03/27
- [elpa] externals/ssh-deploy a12e59f 027/133: Updated comments, Stefan Monnier, 2021/03/27