;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;;
-;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
-;;
-;; Created: 2013-11-1l
+;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
+;;
+;; Created: 2013-11-11
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
(defconst ztree-diff-hidden-files-regexp "^\\."
"Hidden files regexp.
-By default all filest starting with dot '.', including . and ..")
+By default all filest starting with dot `.', including . and ..")
(defface ztreep-diff-header-face
'((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
:group 'Ztree-diff :group 'font-lock-highlighting-faces)
(defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face)
+(defface ztreep-diff-model-ignored-face
+ '((((type tty pc) (class color) (min-colors 256)) :foreground "#2f2f2f")
+ (((type tty pc) (class color) (min-colors 8)) :foreground "white")
+ (t (:foreground "#7f7f7f" :strike-through t)))
+ "*Face used for non-modified files in Ztree-diff."
+ :group 'Ztree-diff :group 'font-lock-highlighting-faces)
+(defvar ztreep-diff-model-ignored-face 'ztreep-diff-model-ignored-face)
+
(defface ztreep-diff-model-normal-face
- '((t (:foreground "#7f7f7f")))
+ '((((type tty pc) (class color) (min-colors 8)) :foreground "white")
+ (t (:foreground "#7f7f7f")))
"*Face used for non-modified files in Ztree-diff."
:group 'Ztree-diff :group 'font-lock-highlighting-faces)
(defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
-(defvar ztree-diff-filter-list (list ztree-diff-hidden-files-regexp)
+(defvar-local ztree-diff-filter-list (list ztree-diff-hidden-files-regexp)
"List of regexp file names to filter out.
By default paths starting with dot (like .git) are ignored")
-(make-variable-buffer-local 'ztree-diff-filter-list)
-(defvar ztree-diff-dirs-pair nil
+(defvar-local ztree-diff-dirs-pair nil
"Pair of the directories stored. Used to perform the full rescan.")
-(make-variable-buffer-local 'ztree-diff-dirs-pair)
-(defvar ztree-diff-show-equal-files t
+(defvar-local ztree-diff-show-equal-files t
"Show or not equal files/directories on both sides.")
-(make-variable-buffer-local 'ztree-diff-show-equal-files)
-(defvar ztree-diff-show-filtered-files nil
+(defvar-local ztree-diff-show-filtered-files nil
"Show or not files from the filtered list.")
+(defvar-local ztree-diff-wait-message nil
+ "Message showing while constructing the diff tree.")
+
+
;;;###autoload
(define-minor-mode ztreediff-mode
"A minor mode for displaying the difference of the directory trees in text mode."
(,(kbd "v") . ztree-diff-view-file)
(,(kbd "d") . ztree-diff-simple-diff-files)
(,(kbd "r") . ztree-diff-partial-rescan)
+ (,(kbd "R") . ztree-diff-full-rescan)
([f5] . ztree-diff-full-rescan)))
(defun ztree-diff-node-face (node)
"Return the face for the NODE depending on diff status."
(let ((diff (ztree-diff-node-different node)))
- (cond ((eq diff 'diff) ztreep-diff-model-diff-face)
+ (cond ((eq diff 'ignore) ztreep-diff-model-ignored-face)
+ ((eq diff 'diff) ztreep-diff-model-diff-face)
((eq diff 'new) ztreep-diff-model-add-face)
- (t ztreep-diff-model-normal-face))))
+ ((eq diff 'same) ztreep-diff-model-normal-face))))
(defun ztree-diff-insert-buffer-header ()
"Insert the header to the ztree buffer."
(insert "\n")
(ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
(ztree-insert-with-face "- different from other side" ztreep-diff-header-small-face)
+ (insert "\n ")
+ (ztree-insert-with-face "Ignored file" ztreep-diff-model-ignored-face)
+ (ztree-insert-with-face " - ignored from comparison" ztreep-diff-header-small-face)
(insert "\n")
+
(ztree-insert-with-face "==============" ztreep-diff-header-face)
(insert "\n"))
(if (not parent)
(when ztree-diff-dirs-pair
(ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))
- (progn
- (ztree-diff-model-partial-rescan common)
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos))))))
+ (ztree-diff-update-wait-message
+ (concat "Updating " (ztree-diff-node-short-name common) " ..."))
+ (ztree-diff-model-partial-rescan common)
+ (message "Done")
+ (ztree-refresh-buffer (line-number-at-pos)))))
(defun ztree-diff-partial-rescan ()
;; FIXME: The GNU convention is to only use "path" for lists of
;; directories as in load-path.
(open-f #'(lambda (path) (if hard (find-file path)
- (let ((split-width-threshold nil))
- (view-file-other-window path))))))
+ (let ((split-width-threshold nil))
+ (view-file-other-window path))))))
(cond ((and left right)
- (if (not (ztree-diff-node-different node))
+ (if (eql (ztree-diff-node-different node) 'same)
(funcall open-f left)
(if hard
(ediff left right)
(error error-trap))))
;; error message if failed
(if err (message (concat "Error: " (nth 2 err)))
- (progn ; otherwise:
- ;; assuming all went ok when left and right nodes are the same
- ;; set both as not different
- (setf (ztree-diff-node-different node) nil)
- ;; update left/right paths
- (if copy-to-right
- (setf (ztree-diff-node-right-path node) target-path)
- (setf (ztree-diff-node-left-path node) target-path))
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos)))))))
+ ;; otherwise:
+ ;; assuming all went ok when left and right nodes are the same
+ ;; set both as not different if they were not ignored
+ (unless (eq (ztree-diff-node-different node) 'ignore)
+ (setf (ztree-diff-node-different node) 'same))
+ ;; update left/right paths
+ (if copy-to-right
+ (setf (ztree-diff-node-right-path node) target-path)
+ (setf (ztree-diff-node-left-path node) target-path))
+ (ztree-diff-node-update-all-parents-diff node)
+ (ztree-refresh-buffer (line-number-at-pos))))))
(defun ztree-diff-copy-dir (node source-path destination-path copy-to-right)
nil)
(error error-trap))))
;; error message if failed
- (if err (message (concat "Error: " (nth 1 err)))
- (progn
- (message target-full-path)
- (if copy-to-right
- (setf (ztree-diff-node-right-path node)
- target-full-path)
- (setf (ztree-diff-node-left-path node)
- target-full-path))
- (ztree-diff-model-update-node node)
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos)))))))
+ (if err
+ (progn
+ (message (concat "Error: " (nth 1 err)))
+ ;; and do rescan of the node
+ (ztree-diff-do-partial-rescan node))
+ ;; if everything is ok, update statuses
+ (message target-full-path)
+ (if copy-to-right
+ (setf (ztree-diff-node-right-path node) target-full-path)
+ (setf (ztree-diff-node-left-path node) target-full-path))
+ (ztree-diff-update-wait-message
+ (concat "Updating " (ztree-diff-node-short-name node) " ..."))
+ ;; TODO: do not rescan the node. Use some logic like in delete
+ (ztree-diff-model-update-node node)
+ (message "Done.")
+ (ztree-diff-node-update-all-parents-diff node)
+ (ztree-refresh-buffer (line-number-at-pos))))))
(defun ztree-diff-copy ()
(let* ((node (car found))
(side (cdr found))
(node-side (ztree-diff-node-side node))
- (delete-from-left t)
- (remove-path nil)
- (parent (ztree-diff-node-parent node)))
- (when parent ; do not delete the root node
- ;; algorithm for determining what to delete similar to copy:
- ;; 1. if the file is present on both sides, delete
- ;; from the side currently selected
- (setq delete-from-left (if (eq node-side 'both)
- (eq side 'left)
- ;; 2) if one of sides is absent, delete
- ;; from the side where the file is present
- (eq node-side 'left)))
- (setq remove-path (if delete-from-left
- (ztree-diff-node-left-path node)
- (ztree-diff-node-right-path node)))
- (when (yes-or-no-p (format "Delete the file [%s]%s ?"
- (if delete-from-left "LEFT" "RIGHT")
- remove-path))
- (let* ((delete-command
- (if (file-directory-p remove-path)
- #'delete-directory
- #'delete-file))
- (children (ztree-diff-node-children parent))
- (err
- (condition-case error-trap
- (progn
- (funcall delete-command remove-path t)
- nil)
- (error error-trap))))
- (if err
- (progn
- (message (concat "Error: " (nth 2 err)))
- ;; when error happened while deleting the
- ;; directory, rescan the node
- ;; and update the parents with a new status
- ;; of this node
- (when (file-directory-p remove-path)
- (ztree-diff-model-partial-rescan node)
- (ztree-diff-node-update-all-parents-diff node)))
- ;; if everything ok
+ (parent (ztree-diff-node-parent node))
+ ;; algorithm for determining what to delete similar to copy:
+ ;; 1. if the file is present on both sides, delete
+ ;; from the side currently selected
+ ;; 2. if one of sides is absent, delete
+ ;; from the side where the file is present
+ (delete-from-left
+ (or (eql node-side 'left)
+ (and (eql node-side 'both)
+ (eql side 'left))))
+ (remove-path (if delete-from-left
+ (ztree-diff-node-left-path node)
+ (ztree-diff-node-right-path node))))
+ (when (and parent ; do not delete the root node
+ (yes-or-no-p (format "Delete the file [%s]%s ?"
+ (if delete-from-left "LEFT" "RIGHT")
+ remove-path)))
+ (let* ((delete-command
+ (if (file-directory-p remove-path)
+ #'delete-directory
+ #'delete-file))
+ (children (ztree-diff-node-children parent))
+ (err
+ (condition-case error-trap
+ (progn
+ (funcall delete-command remove-path t)
+ nil)
+ (error error-trap))))
+ (if err
(progn
- ;; remove the node from children
- (setq children (ztree-filter
- #'(lambda (x) (not (ztree-diff-node-equal x node)))
- children))
- (setf (ztree-diff-node-children parent) children))
- (ztree-diff-node-update-all-parents-diff node)
- ;;(ztree-diff-model-partial-rescan node)
- (ztree-refresh-buffer (line-number-at-pos))))))))))
+ (message (concat "Error: " (nth 2 err)))
+ ;; when error happened while deleting the
+ ;; directory, rescan the node
+ ;; and update the parents with a new status
+ ;; of this node
+ (when (file-directory-p remove-path)
+ (ztree-diff-model-partial-rescan node)))
+ ;; if everything ok
+ ;; if was only on one side
+ ;; remove the node from children
+ (if (or (and (eql node-side 'left)
+ delete-from-left)
+ (and (eql node-side 'right)
+ (not delete-from-left)))
+ (setf (ztree-diff-node-children parent)
+ (ztree-filter
+ (lambda (x) (not (ztree-diff-node-equal x node)))
+ children))
+ ;; otherwise update only one side
+ (mapc (if delete-from-left
+ (lambda (x) (setf (ztree-diff-node-left-path x) nil))
+ (lambda (x) (setf (ztree-diff-node-right-path x) nil)))
+ (cons node (ztree-diff-node-children node)))
+ ;; and update diff status
+ ;; if was ignored keep the old status
+ (unless (eql (ztree-diff-node-different node) 'ignore)
+ (setf (ztree-diff-node-different node) 'new))
+ ;; finally update all children statuses
+ (ztree-diff-node-update-diff-from-parent node)))
+ (ztree-diff-node-update-all-parents-diff node)
+ (ztree-refresh-buffer (line-number-at-pos))))))))
(defun ztree-node-is-visible (node)
"Determine if the NODE should be visible."
- ;; visible then
- ;; 1) either it is a parent
- (or (not (ztree-diff-node-parent node)) ; parent is always visible
- (and
- ;; 2.1) or it is not in ignore list and
- (or ztree-diff-show-filtered-files ; show filtered files regardless
- (not (ztree-diff-node-ignore-p node)))
- ;; 2.2) it has different status
- (or ztree-diff-show-equal-files ; show equal files regardless
- (ztree-diff-node-different node)))))
+ (let ((diff (ztree-diff-node-different node)))
+ ;; visible then
+ ;; either it is a root. root have no parent
+ (or (not (ztree-diff-node-parent node)) ; parent is always visible
+ ;; or the files are different or orphan
+ (or (eql diff 'new)
+ (eql diff 'diff))
+ ;; or it is ignored but we show ignored for now
+ (and (eql diff 'ignore)
+ ztree-diff-show-filtered-files)
+ ;; or they are same but we show same for now
+ (and (eql diff 'same)
+ ztree-diff-show-equal-files))))
(defun ztree-diff-toggle-show-equal-files ()
"Toggle visibility of the equal files."
(interactive)
(setq ztree-diff-show-equal-files (not ztree-diff-show-equal-files))
+ (message (concat (if ztree-diff-show-equal-files "Show" "Hide") " equal files"))
(ztree-refresh-buffer))
(defun ztree-diff-toggle-show-filtered-files ()
"Toggle visibility of the filtered files."
(interactive)
(setq ztree-diff-show-filtered-files (not ztree-diff-show-filtered-files))
+ (message (concat (if ztree-diff-show-filtered-files "Show" "Hide") " filtered files"))
(ztree-refresh-buffer))
+(defun ztree-diff-update-wait-message (&optional msg)
+ "Update the wait mesage with one more `.' progress indication."
+ (if msg
+ (setq ztree-diff-wait-message msg)
+ (when ztree-diff-wait-message
+ (setq ztree-diff-wait-message (concat ztree-diff-wait-message "."))))
+ (message ztree-diff-wait-message))
+
;;;###autoload
(defun ztree-diff (dir1 dir2)
"Create an interactive buffer with the directory tree of the path given.
Argument DIR1 left directory.
Argument DIR2 right directory."
(interactive "DLeft directory \nDRight directory ")
- (let* ((difference (ztree-diff-model-create dir1 dir2 #'ztree-diff-node-ignore-p))
+ (unless (and dir1 (file-directory-p dir1))
+ (error "Path %s is not a directory" dir1))
+ (unless (file-exists-p dir1)
+ (error "Path %s does not exist" dir1))
+ (unless (and dir2 (file-directory-p dir2))
+ (error "Path %s is not a directory" dir2))
+ (unless (file-exists-p dir2)
+ (error "Path %s does not exist" dir2))
+ (let* ((model
+ (ztree-diff-node-create nil dir1 dir2 nil))
(buf-name (concat "*"
- (ztree-diff-node-short-name difference)
+ (ztree-diff-node-short-name model)
" <--> "
- (ztree-diff-node-right-short-name difference)
+ (ztree-diff-node-right-short-name model)
"*")))
+ ;; after this command we are in a new buffer,
+ ;; so all buffer-local vars are valid
(ztree-view buf-name
- difference
+ model
'ztree-node-is-visible
'ztree-diff-insert-buffer-header
'ztree-diff-node-short-name-wrapper
'ztree-diff-node-action
'ztree-diff-node-side)
(ztreediff-mode)
+ (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p)
+ (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message)
(setq ztree-diff-dirs-pair (cons dir1 dir2))
+ (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
+ (ztree-diff-node-recreate model)
+ (message "Done.")
+
(ztree-refresh-buffer)))
+
+
(provide 'ztree-diff)
;;; ztree-diff.el ends here