-
-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathssh-deploy-diff-mode.el
235 lines (209 loc) · 10.5 KB
/
ssh-deploy-diff-mode.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
;;; ssh-deploy-diff-mode.el --- Mode for interactive directory differences -*- lexical-binding:t -*-
;; Copyright (C) 2017-2023 Free Software Foundation, Inc.
;; 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 3, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Please see README.md from the same repository for extended documentation.
;;; Code:
(require 'ssh-deploy)
(defconst ssh-deploy-diff-mode--keywords
'(
"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.")
(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.")
(defvar ssh-deploy-diff-mode-map
(let ((map (make-keymap)))
(define-key map "C" 'ssh-deploy-diff-mode-copy-handler)
(define-key map "a" 'ssh-deploy-diff-mode-copy-a-handler)
(define-key map "b" 'ssh-deploy-diff-mode-copy-b-handler)
(define-key map "D" 'ssh-deploy-diff-mode-delete-handler)
(define-key map (kbd "<tab>") 'ssh-deploy-diff-mode-difference-handler)
(define-key map "g" 'ssh-deploy-diff-mode-refresh-handler)
(define-key map (kbd "<return>") 'ssh-deploy-diff-mode-open-handler)
(define-key map (kbd "<RET>") 'ssh-deploy-diff-mode-open-handler)
map)
"Key-map for SSH Deploy Diff major mode.")
(defun ssh-deploy-diff-mode-copy-handler() "Start the copy action." (interactive)(ssh-deploy-diff-mode--action-handler #'ssh-deploy-diff-mode--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."
(interactive)
(save-excursion
(beginning-of-line)
(let ((file nil))
(when (looking-at "^- ")
(let* ((start (+ 2 (line-beginning-position)))
(end (line-end-position)))
(setq file (buffer-substring-no-properties start end))))
(while (and (> (line-number-at-pos) 1)
(not (looking-at "^[A-Z]+")))
(forward-line -1))
(when (looking-at "^[A-Z]")
(let* ((start (line-beginning-position))
(end (line-end-position))
(section (buffer-substring-no-properties start end)))
(setq section (replace-regexp-in-string ": ([0-9]+)\\'" "" section))
(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))
(when (looking-at "^DIRECTORY B:")
(let* ((start (line-beginning-position))
(end (line-end-position))
(directory-b (buffer-substring-no-properties start end)))
(setq directory-b (replace-regexp-in-string "DIRECTORY B: " "" directory-b))
(while (and (> (line-number-at-pos) 1)
(not (looking-at "^DIRECTORY A:")))
(forward-line -1))
(when (looking-at "^DIRECTORY A:")
(let* ((start (line-beginning-position))
(end (line-end-position))
(directory-a (buffer-substring-no-properties start end)))
(setq directory-a (replace-regexp-in-string "DIRECTORY A: " "" directory-a))
(list file section directory-a directory-b))))))))))
(defun ssh-deploy-diff-mode--action-handler (action)
"Route valid ACTION to their functions."
(interactive)
(let ((parts (ssh-deploy-diff-mode--get-parts)))
(unless (eq parts nil)
(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)
(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."
(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))
(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."
(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 (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."
(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 (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."
(let* ((section (nth 1 parts))
(file-name (nth 0 parts))
(root-local (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)))
(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))))
(when (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."
(let ((section (nth 1 parts)))
(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."
(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 (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."
(set (make-local-variable 'font-lock-defaults)
'(ssh-deploy-diff-mode--font-lock-keywords)))
(provide 'ssh-deploy-diff-mode)
;;; ssh-deploy-diff-mode.el ends here