mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 76bbd07de7add0f9d13c6914f158d19630fe2f62
commit | author | age
5cb5f7 1 ;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2013-2016  Free Software Foundation, Inc.
4 ;;
5 ;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
6 ;;
7 ;; Created: 2013-11-11
8 ;;
9 ;; Keywords: files tools
10 ;; URL: https://github.com/fourier/ztree
11 ;; Compatibility: GNU Emacs 24.x
12 ;;
13 ;; This file is part of GNU Emacs.
14 ;;
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.
19 ;;
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.
24 ;;
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/>.
27 ;;
28 ;;; Commentary:
29
30 ;;; Code:
31 (eval-when-compile (require 'cl))
32 (require 'ztree-view)
33 (require 'ztree-diff-model)
34
35 (defconst ztree-diff-hidden-files-regexp "^\\."
36   "Hidden files regexp.
37 By default all filest starting with dot `.', including . and ..")
38
39 (defface ztreep-diff-header-face
40   '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
41     (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
42     (t :height 1.2 :foreground "darkblue" :weight bold))
43   "*Face used for the header in Ztree Diff buffer."
44   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
45 (defvar ztreep-diff-header-face 'ztreep-diff-header-face)
46
47 (defface ztreep-diff-header-small-face
48   '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
49     (((background dark)) (:foreground "lightblue" :weight bold))
50     (t :weight bold :foreground "darkblue"))
51   "*Face used for the header in Ztree Diff buffer."
52   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
53 (defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face)
54
55 (defface ztreep-diff-model-diff-face
56   '((t                   (:foreground "red")))
57   "*Face used for different files in Ztree-diff."
58   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
59 (defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face)
60
61 (defface ztreep-diff-model-add-face
62   '((t                   (:foreground "blue")))
63   "*Face used for added files in Ztree-diff."
64   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
65 (defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face)
66
67 (defface ztreep-diff-model-ignored-face
68   '((((type tty pc) (class color) (min-colors 256)) :foreground "#2f2f2f")
69     (((type tty pc) (class color) (min-colors 8))   :foreground "white")
70     (t                   (:foreground "#7f7f7f" :strike-through t)))
71   "*Face used for non-modified files in Ztree-diff."
72   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
73 (defvar ztreep-diff-model-ignored-face 'ztreep-diff-model-ignored-face)
74
75 (defface ztreep-diff-model-normal-face
76   '((((type tty pc) (class color) (min-colors 8)) :foreground "white")
77     (t                   (:foreground "#7f7f7f")))
78   "*Face used for non-modified files in Ztree-diff."
79   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
80 (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
81
82
83 (defvar-local ztree-diff-filter-list (list ztree-diff-hidden-files-regexp)
84   "List of regexp file names to filter out.
85 By default paths starting with dot (like .git) are ignored")
86
87 (defvar-local ztree-diff-dirs-pair nil
88   "Pair of the directories stored.  Used to perform the full rescan.")
89
90 (defvar-local ztree-diff-show-equal-files t
91   "Show or not equal files/directories on both sides.")
92
93 (defvar-local ztree-diff-show-filtered-files nil
94   "Show or not files from the filtered list.")
95
96 (defvar-local ztree-diff-show-right-orphan-files t
97   "Show or not orphan files/directories on right side.")
98
99 (defvar-local ztree-diff-show-left-orphan-files t
100   "Show or not orphan files/directories on left side.")
101
102 (defvar-local ztree-diff-wait-message nil
103   "Message showing while constructing the diff tree.")
104
105 (defvar ztree-diff-ediff-previous-window-configurations nil
106   "Window configurations prior to calling `ediff'.
107 A queue of window configurations, allowing
108 to restore last configuration even if there were a couple of ediff sessions")
109
110 ;;;###autoload
111 (define-minor-mode ztreediff-mode
112   "A minor mode for displaying the difference of the directory trees in text mode."
113   ;; initial value
114   nil
115   ;; modeline name
116   " Diff"
117   ;; The minor mode keymap
118   `(
119     (,(kbd "C") . ztree-diff-copy)
120     (,(kbd "h") . ztree-diff-toggle-show-equal-files)
121     (,(kbd "H") . ztree-diff-toggle-show-filtered-files)
122     (,(kbd "D") . ztree-diff-delete-file)
123     (,(kbd "v") . ztree-diff-view-file)
124     (,(kbd "d") . ztree-diff-simple-diff-files)
125     (,(kbd "r") . ztree-diff-partial-rescan)
126     (,(kbd "R") . ztree-diff-full-rescan)
127     ([f5] . ztree-diff-full-rescan)))
128
129
130 (defun ztree-diff-node-face (node)
131   "Return the face for the NODE depending on diff status."
132   (let ((diff (ztree-diff-node-different node)))
133     (cond ((eq diff 'ignore) ztreep-diff-model-ignored-face)
134           ((eq diff 'diff) ztreep-diff-model-diff-face)
135           ((eq diff 'new)  ztreep-diff-model-add-face)
136           ((eq diff 'same) ztreep-diff-model-normal-face))))
137
138 (defun ztree-diff-insert-buffer-header ()
139   "Insert the header to the ztree buffer."
140   (ztree-insert-with-face "Differences tree" ztreep-diff-header-face)
141   (insert "\n")
142   (when ztree-diff-dirs-pair
143     (ztree-insert-with-face (concat "Left:  " (car ztree-diff-dirs-pair))
144                             ztreep-diff-header-small-face)
145     (insert "\n")
146     (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair))
147                             ztreep-diff-header-small-face)
148     (insert "\n"))
149   (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face)
150   (insert "\n")
151   (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face)
152   (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face)
153   (insert "\n")
154   (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face)
155   (ztree-insert-with-face "- does not exist on other side" ztreep-diff-header-small-face)
156   (insert "\n")
157   (ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
158   (ztree-insert-with-face "- different from other side" ztreep-diff-header-small-face)
159   (insert "\n ")
160   (ztree-insert-with-face "Ignored file" ztreep-diff-model-ignored-face)
161   (ztree-insert-with-face " - ignored from comparison" ztreep-diff-header-small-face)
162   (insert "\n")
163
164   (ztree-insert-with-face "==============" ztreep-diff-header-face)
165   (insert "\n"))
166
167 (defun ztree-diff-full-rescan ()
168   "Force full rescan of the directory trees."
169   (interactive)
170   (when (and ztree-diff-dirs-pair
171              (yes-or-no-p (format "Force full rescan?")))
172     (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))))
173
174
175
176 (defun ztree-diff-existing-common (node)
177   "Return the NODE if both left and right sides exist."
178   (let ((left (ztree-diff-node-left-path node))
179         (right (ztree-diff-node-right-path node)))
180     (if (and left right
181              (file-exists-p left)
182              (file-exists-p right))
183         node
184       nil)))
185
186 (defun ztree-diff-existing-common-parent (node)
187   "Return the first node in up in hierarchy of the NODE which has both sides."
188   (let ((common (ztree-diff-existing-common node)))
189     (if common
190         common
191       (ztree-diff-existing-common-parent (ztree-diff-node-parent node)))))
192
193 (defun ztree-diff-do-partial-rescan (node)
194   "Partly rescan the NODE."
195   (let* ((common (ztree-diff-existing-common-parent node))
196          (parent (ztree-diff-node-parent common)))
197     (if (not parent)
198         (when ztree-diff-dirs-pair
199           (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))
200       (ztree-diff-update-wait-message
201            (concat "Updating " (ztree-diff-node-short-name common) " ..."))
202       (ztree-diff-model-partial-rescan common)
203       (message "Done")
204       (ztree-refresh-buffer (line-number-at-pos)))))
205
206
207 (defun ztree-diff-partial-rescan ()
208   "Perform partial rescan on the current node."
209   (interactive)
210   (let ((found (ztree-find-node-at-point)))
211     (when found
212       (ztree-diff-do-partial-rescan (car found)))))
213
214
215 (defun ztree-diff-simple-diff (node)
216   "Create a simple diff buffer for files from left and right panels.
217 Argument NODE node containing paths to files to call a diff on."
218   (let* ((node-left (ztree-diff-node-left-path node))
219          (node-right (ztree-diff-node-right-path node)))
220     (when (and
221            node-left
222            node-right
223            (not (file-directory-p node-left)))
224       ;; show the diff window on the bottom
225       ;; to not to crush tree appearance
226       (let ((split-width-threshold nil))
227         (diff node-left node-right)))))
228
229
230 (defun ztree-diff-simple-diff-files ()
231   "Create a simple diff buffer for files from left and right panels."
232   (interactive)
233   (let ((found (ztree-find-node-at-point)))
234     (when found
235       (let ((node (car found)))
236         (ztree-diff-simple-diff node)))))
237
238 (defun ztree-diff-ediff-before-setup-hook-function ()
239   "Hook function for `ediff-before-setup-hook'.
240
241 See the Info node `(ediff) hooks'.
242
243 This hook function removes itself."
244   (push (current-window-configuration) ztree-diff-ediff-previous-window-configurations)
245   (ztree-save-current-position)
246   (remove-hook 'ediff-before-setup-hook #'ztree-diff-ediff-before-setup-hook-function))
247
248 (defun ztree-diff-ediff-quit-hook-function ()
249   "Hook function for `ediff-quit-hook'.
250
251 See the Info node `(ediff) hooks'.
252
253 This hook function removes itself."
254   (set-window-configuration (pop ztree-diff-ediff-previous-window-configurations))
255   (ztree-refresh-buffer)
256   (remove-hook 'ediff-quit-hook #'ztree-diff-ediff-quit-hook-function))
257
258 (defun ztree-diff-ediff (file-a file-b &optional startup-hooks)
259   "Ediff that cleans up after itself.
260
261 Ediff-related buffers are killed and the pre-Ediff window
262 configuration is restored."
263   (add-hook 'ediff-before-setup-hook #'ztree-diff-ediff-before-setup-hook-function)
264   (add-hook 'ediff-quit-hook #'ztree-diff-ediff-quit-hook-function t)
265   (ediff file-a file-b startup-hooks))
266
267 (defun ztree-diff-node-action (node hard)
268   "Perform action on NODE:
269 1 if both left and right sides present:
270    1.1 if they are differend
271       1.1.1 if HARD ediff
272       1.1.2 simple diff otherwiste
273    1.2 if they are the same - view left
274 2 if left or right present - view left or rigth"
275   ;; save current position in case if the window
276   ;; configuration will change
277   (ztree-save-current-position)
278   (let ((left (ztree-diff-node-left-path node))
279         (right (ztree-diff-node-right-path node))
280         ;; FIXME: The GNU convention is to only use "path" for lists of
281         ;; directories as in load-path.
282         (open-f #'(lambda (path) (if hard (find-file path)
283                                   (let ((split-width-threshold nil))
284                                     (view-file-other-window path))))))
285     (cond ((and left right)
286            (if (eql (ztree-diff-node-different node) 'same)
287                (funcall open-f left)
288              (if hard
289                  (ztree-diff-ediff left right)
290                (ztree-diff-simple-diff node))))
291           (left (funcall open-f left))
292           (right (funcall open-f right))
293           (t nil))))
294
295
296
297 (defun ztree-diff-copy-file (node source-path destination-path copy-to-right)
298   "Update the NODE status and copy the file.
299 File copied from SOURCE-PATH to DESTINATION-PATH.
300 COPY-TO-RIGHT specifies which side of the NODE to update."
301   (let ((target-path (concat
302                       (file-name-as-directory destination-path)
303                       (file-name-nondirectory
304                        (directory-file-name source-path)))))
305     (let ((err (condition-case error-trap
306                    (progn
307                      ;; don't ask for overwrite
308                      ;; keep time stamp
309                      (copy-file source-path target-path t t)
310                      nil)
311                  (error error-trap))))
312       ;; error message if failed
313       (if err (message (concat "Error: " (nth 2 err)))
314         ;; otherwise:
315         ;; assuming all went ok when left and right nodes are the same
316         ;; set both as not different if they were not ignored
317         (unless (eq (ztree-diff-node-different node) 'ignore)
318           (setf (ztree-diff-node-different node) 'same))
319         ;; update left/right paths
320         (if copy-to-right
321             (setf (ztree-diff-node-right-path node) target-path)
322           (setf (ztree-diff-node-left-path node) target-path))
323         (ztree-diff-node-update-all-parents-diff node)
324         (ztree-refresh-buffer (line-number-at-pos))))))
325
326
327 (defun ztree-diff-copy-dir (node source-path destination-path copy-to-right)
328   "Update the NODE status and copy the directory.
329 Directory copied from SOURCE-PATH to DESTINATION-PATH.
330 COPY-TO-RIGHT specifies which side of the NODE to update."
331   (let* ((src-path (file-name-as-directory source-path))
332          (target-path (file-name-as-directory destination-path))
333          (target-full-path (concat
334                             target-path
335                             (file-name-nondirectory
336                              (directory-file-name source-path)))))
337     (let ((err (condition-case error-trap
338                    (progn
339                      ;; keep time stamp
340                      ;; ask for overwrite
341                      (copy-directory src-path target-path t t)
342                      nil)
343                  (error error-trap))))
344       ;; error message if failed
345       (if err
346           (progn
347             (message (concat "Error: " (nth 1 err)))
348             ;; and do rescan of the node
349             (ztree-diff-do-partial-rescan node))
350         ;; if everything is ok, update statuses
351         (message target-full-path)
352         (if copy-to-right
353             (setf (ztree-diff-node-right-path node) target-full-path)
354           (setf (ztree-diff-node-left-path node) target-full-path))
355         (ztree-diff-update-wait-message
356          (concat "Updating " (ztree-diff-node-short-name node) " ..."))
357         ;; TODO: do not rescan the node. Use some logic like in delete
358         (ztree-diff-model-update-node node)
359         (message "Done.")
360         (ztree-diff-node-update-all-parents-diff node)
361         (ztree-refresh-buffer (line-number-at-pos))))))
362
363
364 (defun ztree-diff-copy ()
365   "Copy the file under the cursor to other side."
366   (interactive)
367   (let ((found (ztree-find-node-at-point)))
368     (when found
369       (let* ((node (car found))
370              (side (cdr found))
371              (node-side (ztree-diff-node-side node))
372              (copy-to-right t)           ; copy from left to right
373              (node-left (ztree-diff-node-left-path node))
374              (node-right (ztree-diff-node-right-path node))
375              (source-path nil)
376              (destination-path nil)
377              (parent (ztree-diff-node-parent node)))
378         (when parent                ; do not copy the root node
379           ;; determine a side to copy from/to
380           ;; algorithm:
381           ;; 1) if both side are present, use the side
382           ;;    variable
383           (setq copy-to-right (if (eq node-side 'both)
384                                   (eq side 'left)
385                                 ;; 2) if one of sides is absent, copy from
386                                 ;;    the side where the file is present
387                                 (eq node-side 'left)))
388           ;; 3) in both cases determine if the destination
389           ;;    directory is in place
390           (setq source-path (if copy-to-right node-left node-right)
391                 destination-path (if copy-to-right
392                                      (ztree-diff-node-right-path parent)
393                                    (ztree-diff-node-left-path parent)))
394           (when (and source-path destination-path
395                      (yes-or-no-p (format "Copy [%s]%s to [%s]%s/ ?"
396                                           (if copy-to-right "LEFT" "RIGHT")
397                                           (ztree-diff-node-short-name node)
398                                           (if copy-to-right "RIGHT" "LEFT")
399                                           destination-path)))
400             (if (file-directory-p source-path)
401                 (ztree-diff-copy-dir node
402                                      source-path
403                                      destination-path
404                                      copy-to-right)
405               (ztree-diff-copy-file node
406                                     source-path
407                                     destination-path
408                                     copy-to-right))))))))
409
410 (defun ztree-diff-view-file ()
411   "View file at point, depending on side."
412   (interactive)
413   (let ((found (ztree-find-node-at-point)))
414     (when found
415       (let* ((node (car found))
416              (side (cdr found))
417              (node-side (ztree-diff-node-side node))
418              (node-left (ztree-diff-node-left-path node))
419              (node-right (ztree-diff-node-right-path node)))
420         (when (or (eq node-side 'both)
421                   (eq side node-side))
422           (cond ((and (eq side 'left)
423                       node-left)
424                  (view-file node-left))
425                 ((and (eq side 'right)
426                       node-right)
427                  (view-file node-right))))))))
428
429
430 (defun ztree-diff-delete-file ()
431   "Delete the file under the cursor."
432   (interactive)
433   (let ((found (ztree-find-node-at-point)))
434     (when found
435       (let* ((node (car found))
436              (side (cdr found))
437              (node-side (ztree-diff-node-side node))
438              (parent (ztree-diff-node-parent node))
439              ;; algorithm for determining what to delete similar to copy:
440              ;; 1. if the file is present on both sides, delete
441              ;;    from the side currently selected
442              ;; 2. if one of sides is absent, delete
443              ;;    from the side where the file is present
444              (delete-from-left
445               (or (eql node-side 'left)
446                   (and (eql node-side 'both)
447                        (eql side 'left))))
448              (remove-path (if delete-from-left
449                               (ztree-diff-node-left-path node)
450                             (ztree-diff-node-right-path node))))
451         (when (and parent                    ; do not delete the root node
452                    (yes-or-no-p (format "Delete the file [%s]%s ?"
453                                         (if delete-from-left "LEFT" "RIGHT")
454                                         remove-path)))
455           (let* ((delete-command
456                   (if (file-directory-p remove-path)
457                       #'delete-directory
458                     #'delete-file))
459                  (children (ztree-diff-node-children parent))
460                  (err
461                   (condition-case error-trap
462                       (progn
463                         (funcall delete-command remove-path t)
464                         nil)
465                     (error error-trap))))
466             (if err
467                 (progn
468                   (message (concat "Error: " (nth 2 err)))
469                   ;; when error happened while deleting the
470                   ;; directory, rescan the node
471                   ;; and update the parents with a new status
472                   ;; of this node
473                   (when (file-directory-p remove-path)
474                     (ztree-diff-model-partial-rescan node)))
475               ;; if everything ok
476               ;; if was only on one side
477               ;; remove the node from children
478               (if (or (and (eql node-side 'left)
479                            delete-from-left)
480                       (and (eql node-side 'right)
481                            (not delete-from-left)))
482                   (setf (ztree-diff-node-children parent)
483                         (ztree-filter
484                          (lambda (x) (not (ztree-diff-node-equal x node)))
485                          children))
486                 ;; otherwise update only one side
487                 (mapc (if delete-from-left
488                           (lambda (x) (setf (ztree-diff-node-left-path x) nil))
489                         (lambda (x) (setf (ztree-diff-node-right-path x) nil)))
490                       (cons node (ztree-diff-node-children node)))
491                 ;; and update diff status
492                 ;; if was ignored keep the old status
493                 (unless (eql (ztree-diff-node-different node) 'ignore)
494                   (setf (ztree-diff-node-different node) 'new))
495                 ;; finally update all children statuses
496                 (ztree-diff-node-update-diff-from-parent node)))
497             (ztree-diff-node-update-all-parents-diff node)
498             (ztree-refresh-buffer (line-number-at-pos))))))))
499
500
501
502 (defun ztree-diff-node-ignore-p (node)
503   "Determine if the NODE is in filter list.
504 If the node is in the filter list it shall not be visible,
505 unless it is a parent node."
506   (let ((name (ztree-diff-node-short-name node)))
507     ;; ignore then
508     ;; not a root and is in filter list
509     (and (ztree-diff-node-parent node)
510          (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx name))))))
511
512
513 (defun ztree-node-is-visible (node)
514   "Determine if the NODE should be visible."
515   (let ((diff (ztree-diff-node-different node)))
516     ;; visible then
517     ;; either it is a root. root have no parent
518     (or (not (ztree-diff-node-parent node))    ; parent is always visible
519         ;; or the files are different
520         (eql diff 'diff)
521         ;; or it is orphaned, but show orphaned files for now
522         (and (eql diff 'new)
523              (if (ztree-diff-node-left-path node)
524                  ztree-diff-show-left-orphan-files
525                ztree-diff-show-right-orphan-files))
526         ;; or it is ignored but we show ignored for now
527         (and (eql diff 'ignore)
528              ztree-diff-show-filtered-files)
529         ;; or they are same but we show same for now
530         (and (eql diff 'same)
531              ztree-diff-show-equal-files))))
532
533 (defmacro ztree-diff-define-toggle-show (what)
534   (let ((funcsymbol (intern (concat "ztree-diff-toggle-show-" what "-files")))
535         (variable (intern (concat "ztree-diff-show-" what "-files")))
536         (fundesc (concat "Toggle visibility of the " what " files/directories")))
537     `(defun ,funcsymbol ()
538        ,fundesc
539        (interactive)
540        (setq ,variable (not ,variable))
541        (message (concat (if ,variable "Show " "Hide ") ,what " files"))
542        (ztree-refresh-buffer))))
543
544 (ztree-diff-define-toggle-show "equal")
545 (ztree-diff-define-toggle-show "filtered")
546 (ztree-diff-define-toggle-show "left-orphan")
547 (ztree-diff-define-toggle-show "right-orphan")
548
549 (defun ztree-diff-toggle-show-orphan-files ()
550   "Toggle visibility of left and right orphan files."
551   (interactive)
552   (let ((show (not ztree-diff-show-left-orphan-files)))
553     (setq ztree-diff-show-left-orphan-files show)
554     (setq ztree-diff-show-right-orphan-files show)
555     (message (concat (if show "Show" "Hide") " orphan files"))
556     (ztree-refresh-buffer)))
557
558 (defun ztree-diff-update-wait-message (&optional msg)
559   "Update the wait message MSG with one more `.' progress indication."
560   (if msg
561       (setq ztree-diff-wait-message msg)
562     (when ztree-diff-wait-message
563       (setq ztree-diff-wait-message (concat ztree-diff-wait-message "."))))
564   (message ztree-diff-wait-message))
565
566 ;;;###autoload
567 (defun ztree-diff (dir1 dir2)
568   "Create an interactive buffer with the directory tree of the path given.
569 Argument DIR1 left directory.
570 Argument DIR2 right directory."
571   (interactive "DLeft directory \nDRight directory ")
572   (unless (and dir1 (file-directory-p dir1))
573     (error "Path %s is not a directory" dir1))
574   (unless (file-exists-p dir1)
575     (error "Path %s does not exist" dir1))
576   (unless (and dir2 (file-directory-p dir2))
577     (error "Path %s is not a directory" dir2))
578   (unless (file-exists-p dir2)
579     (error "Path %s does not exist" dir2))
580   (unless (ztree-same-host-p dir1 dir2)
581     (error "Compared directories are not on the same host"))
582   (let* ((model
583           (ztree-diff-node-create nil dir1 dir2 nil))
584          (buf-name (concat "*"
585                            (ztree-diff-node-short-name model)
586                            " <--> "
587                            (ztree-diff-node-right-short-name model)
588                            "*")))
589     ;; after this command we are in a new buffer,
590     ;; so all buffer-local vars are valid
591     (ztree-view buf-name
592                 model
593                 'ztree-node-is-visible
594                 'ztree-diff-insert-buffer-header
595                 'ztree-diff-node-short-name-wrapper
596                 'ztree-diff-node-is-directory
597                 'ztree-diff-node-equal
598                 'ztree-diff-node-children
599                 'ztree-diff-node-face
600                 'ztree-diff-node-action
601                 'ztree-diff-node-side)
602     (ztreediff-mode)
603     (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p)
604     (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message)
605     (setq ztree-diff-dirs-pair (cons dir1 dir2))
606     (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
607     (ztree-diff-node-recreate model)
608     (message "Done.")
609
610     (ztree-refresh-buffer)))
611
612
613
614
615
616
617 (provide 'ztree-diff)
618 ;;; ztree-diff.el ends here