1 ;;; ztree-diff-model.el --- diff model for directory trees
3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
5 ;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
9 ;; Keywords: files tools
10 ;; URL: https://github.com/fourier/ztree
11 ;; Compatibility: GNU Emacs 24.x
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
35 (defvar ztree-diff-model-wait-message nil
36 "Message showing while constructing the diff tree.")
37 (make-variable-buffer-local 'ztree-diff-model-wait-message)
40 (defun ztree-diff-model-update-wait-message ()
41 "Update the wait mesage with one more '.' progress indication."
42 (when ztree-diff-model-wait-message
43 (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message "."))
44 (message ztree-diff-model-wait-message)))
48 ;; Create a record ztree-diff-node with defined fielsd and getters/setters
50 ;; parent - parent node
51 ;; left-path is the full path on the left side of the diff window,
52 ;; right-path is the full path of the right side,
53 ;; short-name - is the file or directory name
54 ;; children - list of nodes - files or directories if the node is a directory
55 ;; different = {nil, 'new, 'diff} - means comparison status
56 (defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different))
58 (defun ztree-diff-node-to-string (node)
59 "Construct the string with contents of the NODE given."
60 (let* ((string-or-nil #'(lambda (x) (if x
63 ((eq x 'diff) "different")
64 (t (ztree-diff-node-short-name x)))
66 (children (ztree-diff-node-children node))
69 (setq ch-str (concat ch-str "\n * " (ztree-diff-node-short-name x))))
70 (concat "Node: " (ztree-diff-node-short-name node)
72 ;; " * Parent: " (let ((parent (ztree-diff-node-parent node)))
73 ;; (if parent (ztree-diff-node-short-name parent) "nil"))
74 " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
76 " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path node))
78 " * Right path: " (funcall string-or-nil (ztree-diff-node-right-path node))
80 " * Children: " ch-str
84 (defun ztree-diff-node-short-name-wrapper (node &optional right-side)
85 "Return the short name of the NODE given.
86 If the RIGHT-SIDE is true, take the right leaf"
88 (ztree-diff-node-short-name node)
89 (ztree-diff-node-right-short-name node)))
92 (defun ztree-diff-node-is-directory (node)
93 "Determines if the NODE is a directory."
94 (let ((left (ztree-diff-node-left-path node))
95 (right (ztree-diff-node-right-path node)))
97 (file-directory-p left)
98 (file-directory-p right))))
100 (defun ztree-diff-node-side (node)
101 "Determine the side there the file is present for NODE.
102 Return BOTH if the file present on both sides;
103 LEFT if only on the left side and
104 RIGHT if only on the right side."
105 (let ((left (ztree-diff-node-left-path node))
106 (right (ztree-diff-node-right-path node)))
107 (if (and left right) 'both
108 (if left 'left 'right))))
110 (defun ztree-diff-node-equal (node1 node2)
111 "Determines if NODE1 and NODE2 are equal."
112 (and (string-equal (ztree-diff-node-short-name node1)
113 (ztree-diff-node-short-name node2))
114 (string-equal (ztree-diff-node-left-path node1)
115 (ztree-diff-node-left-path node2))
116 (string-equal (ztree-diff-node-right-path node1)
117 (ztree-diff-node-right-path node1))))
119 (defun ztree-diff-untrampify-filename (file)
120 "Return FILE as the local file name."
122 (if (not (tramp-tramp-file-p file))
124 (tramp-file-name-localname (tramp-dissect-file-name file))))
126 (defun ztree-diff-modef-quotify-string (x)
127 "Surround string X with quotes."
128 (concat "\"" x "\""))
130 (defun ztree-diff-model-files-equal (file1 file2)
131 "Compare files FILE1 and FILE2 using external diff.
133 (let* ((file1-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file1)))
134 (file2-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file2)))
135 (diff-command (concat "diff -q" " " file1-untrampified " " file2-untrampified))
136 (diff-output (shell-command-to-string diff-command)))
137 (not (> (length diff-output) 2))))
139 (defun ztree-directory-files (dir)
140 "Return the list of full paths of files in a directory DIR.
141 Filters out . and .."
142 (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file)))
143 (not (or (string-equal simple-name ".")
144 (string-equal simple-name "..")))))
145 (directory-files dir 'full)))
147 (defun ztree-diff-model-partial-rescan (node)
149 ;; assuming what parent is always exists
150 ;; otherwise the UI shall force the full rescan
151 (let ((parent (ztree-diff-node-parent node))
152 (isdir (ztree-diff-node-is-directory node))
153 (left (ztree-diff-node-left-path node))
154 (right (ztree-diff-node-right-path node)))
155 ;; if node is a directory - traverse
156 (when (and left right
158 (file-exists-p right))
160 (let ((traverse (ztree-diff-node-traverse
164 (ztree-diff-node-set-different node (car traverse))
165 (ztree-diff-node-set-children node (cdr traverse)))
167 (ztree-diff-node-set-different
169 (if (ztree-diff-model-files-equal left right)
173 (defun ztree-diff-model-subtree (parent path side)
174 "Create a subtree with given PARENT for the given PATH.
175 Argument SIDE either 'left or 'right side."
176 (let ((files (ztree-directory-files path))
179 (if (file-directory-p file)
180 (let* ((node (ztree-diff-node-create
182 (when (eq side 'left) file)
183 (when (eq side 'right) file)
184 (file-short-name file)
185 (file-short-name file)
188 (children (ztree-diff-model-subtree node file side)))
189 (ztree-diff-node-set-children node children)
191 (push (ztree-diff-node-create
193 (when (eq side 'left) file)
194 (when (eq side 'right) file)
195 (file-short-name file)
196 (file-short-name file)
202 (defun ztree-diff-node-update-diff-from-children (node)
203 "Set the diff status for the NODE based on its children."
204 (let ((children (ztree-diff-node-children node))
206 (dolist (child children)
208 (ztree-diff-model-update-diff
210 (ztree-diff-node-different child))))
211 (ztree-diff-node-set-different node diff)))
213 (defun ztree-diff-node-update-all-parents-diff (node)
214 "Recursively update all parents diff status for the NODE."
216 (while (setq parent (ztree-diff-node-parent parent))
217 (ztree-diff-node-update-diff-from-children parent))))
220 (defun ztree-diff-model-update-diff (old new)
221 "Get the diff status depending if OLD or NEW is not nil."
229 (defun ztree-diff-node-traverse (parent path1 path2)
230 "Traverse 2 paths creating the list nodes with PARENT defined and diff status.
231 Function traversing 2 paths PATH1 and PATH2 returning the list where the
232 first element is the difference status (nil, 'diff, 'new') and
233 the rest is the combined list of nodes."
234 (let ((list1 (ztree-directory-files path1))
235 (list2 (ztree-directory-files path2))
238 (ztree-diff-model-update-wait-message)
239 ;; first - adding all entries from left directory
240 (dolist (file1 list1)
241 ;; for every entry in the first directory
242 ;; we are creating the node
243 (let* ((simple-name (file-short-name file1))
244 (isdir (file-directory-p file1))
247 ;; create the current node to be set as parent to
249 (node (ztree-diff-node-create parent file1 nil simple-name simple-name nil nil))
250 ;; 1. find if the file is in the second directory and the type
251 ;; is the same - i.e. both are directories or both are files
252 (file2 (ztree-find list2
253 #'(lambda (x) (and (string-equal (file-short-name x)
255 (eq isdir (file-directory-p x)))))))
256 ;; 2. if it is not in the second directory, add it as a node
259 ;; 2.1 if it is a directory, add the whole subtree
260 (when (file-directory-p file1)
261 (setq children (ztree-diff-model-subtree node file1 'left)))
262 ;; 2.2 update the difference status for this entry
263 (setq different 'new))
264 ;; 3. if it is found in second directory and of the same type
265 ;; 3.1 if it is a file
266 (if (not (file-directory-p file1))
267 ;; 3.1.1 set difference status to this entry
268 (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
269 ;; 3.2 if it is the directory
270 ;; 3.2.1 get the result of the directories comparison together with status
271 (let ((traverse (ztree-diff-node-traverse node file1 file2)))
272 ;; 3.2.2 update the difference status for whole comparison from
273 ;; difference result from the 2 subdirectories comparison
274 (setq different (car traverse))
275 ;; 3.2.3 set the children list from the 2 subdirectories comparison
276 (setq children (cdr traverse)))))
277 ;; 2.3 update difference status for the whole comparison
278 (setq different-dir (ztree-diff-model-update-diff different-dir different))
279 ;; update calculated parameters of the node
280 (ztree-diff-node-set-right-path node file2)
281 (ztree-diff-node-set-children node children)
282 (ztree-diff-node-set-different node different)
283 ;; push the created node to the result list
285 ;; second - adding entries from the right directory which are not present
286 ;; in the left directory
287 (dolist (file2 list2)
288 ;; for every entry in the second directory
289 ;; we are creating the node
290 (let* ((simple-name (file-short-name file2))
291 (isdir (file-directory-p file2))
293 ;; create the node to be added to the results list
294 (node (ztree-diff-node-create parent nil file2 simple-name simple-name nil 'new))
295 ;; 1. find if the file is in the first directory and the type
296 ;; is the same - i.e. both are directories or both are files
297 (file1 (ztree-find list1
298 #'(lambda (x) (and (string-equal (file-short-name x)
300 (eq isdir (file-directory-p x)))))))
301 ;; if it is not in the first directory, add it as a node
303 ;; if it is a directory, set the whole subtree to children
304 (when (file-directory-p file2)
305 (setq children (ztree-diff-model-subtree node file2 'right)))
306 ;; update the different status for the whole comparison
307 (setq different-dir (ztree-diff-model-update-diff different-dir 'new))
308 ;; set calculated children to the node
309 (ztree-diff-node-set-children node children)
310 ;; push the created node to the result list
311 (push node result))))
312 ;; result is a pair: difference status and nodes list
313 (cons different-dir result)))
315 (defun ztree-diff-model-create (dir1 dir2)
316 "Create a node based on DIR1 and DIR2."
317 (when (not (file-directory-p dir1))
318 (error "Path %s is not a directory" dir1))
319 (when (not (file-directory-p dir2))
320 (error "Path %s is not a directory" dir2))
321 (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
323 (ztree-diff-node-create nil dir1 dir2
324 (file-short-name dir1)
325 (file-short-name dir2)
328 (traverse (ztree-diff-node-traverse model dir1 dir2)))
329 (ztree-diff-node-set-children model (cdr traverse))
330 (ztree-diff-node-set-different model (car traverse))
334 (defun ztree-diff-model-update-node (node)
336 (setq ztree-diff-model-wait-message
337 (concat "Updating " (ztree-diff-node-short-name node) " ..."))
338 (let ((traverse (ztree-diff-node-traverse node
339 (ztree-diff-node-left-path node)
340 (ztree-diff-node-right-path node))))
341 (ztree-diff-node-set-children node (cdr traverse))
342 (ztree-diff-node-set-different node (car traverse))
347 (provide 'ztree-diff-model)
349 ;;; ztree-diff-model.el ends here