-;;; ztree-diff.el --- Text mode diff for directory trees
+;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*-
-;; Copyright (C) 2013 Alexey Veretennikov
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;;
;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;;
;; Created: 2013-11-1l
-;; Version: 1.0.0
-;; Keywords: files
+;;
+;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs GNU Emacs 24.x
+;; Compatibility: GNU Emacs 24.x
;;
-;; This file is NOT part of GNU Emacs.
+;; This file is 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
-;; of the License, or (at your option) any later version.
+;; GNU Emacs 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 of the License, or
+;; (at your option) any later version.
;;
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs 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 this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;
;;; Commentary:
+;;; Code:
(require 'ztree-view)
(require 'ztree-diff-model)
(defconst ztree-diff-hidden-files-regexp "^\\."
- "Hidden files regexp. By default all filest starting with dot '.',
-including . and ..")
+ "Hidden files regexp.
+By default all filest starting with dot '.', including . and ..")
(defface ztreep-diff-header-face
'((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
(defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
-(defvar ztree-diff-filter-list nil
- "List of regexp file names to filter out")
+(defvar 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
- "Pair of the directories stored. Used to perform the full rescan")
+ "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
- "Show or not equal files/directories on both sides")
+ "Show or not equal files/directories on both sides.")
(make-variable-buffer-local 'ztree-diff-show-equal-files)
;;;###autoload
`(
(,(kbd "C") . ztree-diff-copy)
(,(kbd "h") . ztree-diff-toggle-show-equal-files)
+ (,(kbd "D") . ztree-diff-delete-file)
+ (,(kbd "v") . ztree-diff-view-file)
+ (,(kbd "d") . ztree-diff-simple-diff-files)
+ (,(kbd "r") . ztree-diff-partial-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)
((eq diff 'new) ztreep-diff-model-add-face)
- (t ztreep-diff-model-normal-face))))
+ (t ztreep-diff-model-normal-face))))
(defun ztree-diff-insert-buffer-header ()
- (insert-with-face "Differences tree" ztreep-diff-header-face)
- (newline)
- (insert-with-face"Legend:" ztreep-diff-header-small-face)
- (newline)
- (insert-with-face " Normal file " ztreep-diff-model-normal-face)
- (insert-with-face "- same on both sides" ztreep-diff-header-small-face)
- (newline)
- (insert-with-face " Orphan file " ztreep-diff-model-add-face)
- (insert-with-face "- does not exist on other side" ztreep-diff-header-small-face)
- (newline)
- (insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
- (insert-with-face "- different from other side" ztreep-diff-header-small-face)
- (newline)
- (insert-with-face "==============" ztreep-diff-header-face)
- (newline))
+ "Insert the header to the ztree buffer."
+ (ztree-insert-with-face "Differences tree" ztreep-diff-header-face)
+ (insert "\n")
+ (when ztree-diff-dirs-pair
+ (ztree-insert-with-face (concat "Left: " (car ztree-diff-dirs-pair))
+ ztreep-diff-header-small-face)
+ (insert "\n")
+ (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair))
+ ztreep-diff-header-small-face)
+ (insert "\n"))
+ (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face)
+ (insert "\n")
+ (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face)
+ (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face)
+ (insert "\n")
+ (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face)
+ (ztree-insert-with-face "- does not exist on other side" ztreep-diff-header-small-face)
+ (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 "==============" ztreep-diff-header-face)
+ (insert "\n"))
(defun ztree-diff-full-rescan ()
+ "Force full rescan of the directory trees."
(interactive)
(when (and ztree-diff-dirs-pair
(yes-or-no-p (format "Force full rescan?")))
(ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))))
-(defun ztree-diff-node-action (node)
+
+(defun ztree-diff-existing-common (node)
+ "Return the NODE if both left and right sides exist."
(let ((left (ztree-diff-node-left-path node))
(right (ztree-diff-node-right-path node)))
- (when (and left right)
- (if (not (ztree-diff-node-different node))
- (message (concat "Files "
- (substring-no-properties
- (ztree-diff-node-short-name node))
- " on left and right side are identical"))
- (ediff left right)))))
+ (if (and left right
+ (file-exists-p left)
+ (file-exists-p right))
+ node
+ nil)))
+
+(defun ztree-diff-existing-common-parent (node)
+ "Return the first node in up in hierarchy of the NODE which has both sides."
+ (let ((common (ztree-diff-existing-common node)))
+ (if common
+ common
+ (ztree-diff-existing-common-parent (ztree-diff-node-parent node)))))
+
+(defun ztree-diff-do-partial-rescan (node)
+ "Partly rescan the NODE."
+ (let* ((common (ztree-diff-existing-common-parent node))
+ (parent (ztree-diff-node-parent common)))
+ (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))))))
+
+
+(defun ztree-diff-partial-rescan ()
+ "Perform partial rescan on the current node."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (ztree-diff-do-partial-rescan (car found)))))
+
+
+(defun ztree-diff-simple-diff (node)
+ "Create a simple diff buffer for files from left and right panels.
+Argument NODE node containing paths to files to call a diff on."
+ (let* ((node-left (ztree-diff-node-left-path node))
+ (node-right (ztree-diff-node-right-path node)))
+ (when (and
+ node-left
+ node-right
+ (not (file-directory-p node-left)))
+ ;; show the diff window on the bottom
+ ;; to not to crush tree appearance
+ (let ((split-width-threshold nil))
+ (diff node-left node-right)))))
+
+
+(defun ztree-diff-simple-diff-files ()
+ "Create a simple diff buffer for files from left and right panels."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (let ((node (car found)))
+ (ztree-diff-simple-diff node)))))
+
+(defun ztree-diff-node-action (node hard)
+ "Perform action on NODE:
+1 if both left and right sides present:
+ 1.1 if they are differend
+ 1.1.1 if HARD ediff
+ 1.1.2 simple diff otherwiste
+ 1.2 if they are the same - view left
+2 if left or right present - view left or rigth"
+ (let ((left (ztree-diff-node-left-path node))
+ (right (ztree-diff-node-right-path node))
+ (open-f #'(lambda (path) (if hard (find-file path)
+ (let ((split-width-threshold nil))
+ (view-file-other-window path))))))
+ (cond ((and left right)
+ (if (not (ztree-diff-node-different node))
+ (funcall open-f left)
+ (if hard
+ (ediff left right)
+ (ztree-diff-simple-diff node))))
+ (left (funcall open-f left))
+ (right (funcall open-f right))
+ (t nil))))
+
(defun ztree-diff-copy-file (node source-path destination-path copy-to-right)
+ "Update the NODE status and copy the file.
+File copied from SOURCE-PATH to DESTINATION-PATH.
+COPY-TO-RIGHT specifies which side of the NODE to update."
(let ((target-path (concat
(file-name-as-directory destination-path)
(file-name-nondirectory
(defun ztree-diff-copy-dir (node source-path destination-path copy-to-right)
+ "Update the NODE status and copy the directory.
+Directory copied from SOURCE-PATH to DESTINATION-PATH.
+COPY-TO-RIGHT specifies which side of the NODE to update."
(let* ((src-path (file-name-as-directory source-path))
(target-path (file-name-as-directory destination-path))
(target-full-path (concat
(ztree-diff-node-set-right-path node
target-full-path)
(ztree-diff-node-set-left-path node
- target-full-path))
+ target-full-path))
(ztree-diff-model-update-node node)
- (ztree-diff-node-update-all-parents-diff node)
- (ztree-refresh-buffer (line-number-at-pos)))))))
+ (ztree-diff-node-update-all-parents-diff node)
+ (ztree-refresh-buffer (line-number-at-pos)))))))
(defun ztree-diff-copy ()
+ "Copy the file under the cursor to other side."
(interactive)
(let ((found (ztree-find-node-at-point)))
(when found
(source-path nil)
(destination-path nil)
(parent (ztree-diff-node-parent node)))
- (when parent
+ (when parent ; do not copy the root node
;; determine a side to copy from/to
;; algorithm:
;; 1) if both side are present, use the side
destination-path
copy-to-right))))))))
+(defun ztree-diff-view-file ()
+ "View file at point, depending on side."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (let* ((node (car found))
+ (side (cdr found))
+ (node-side (ztree-diff-node-side node))
+ (node-left (ztree-diff-node-left-path node))
+ (node-right (ztree-diff-node-right-path node)))
+ (when (or (eq node-side 'both)
+ (eq side node-side))
+ (cond ((and (eq side 'left)
+ node-left)
+ (view-file node-left))
+ ((and (eq side 'right)
+ node-right)
+ (view-file node-right))))))))
+
+
+(defun ztree-diff-delete-file ()
+ "Delete the file under the cursor."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (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 remove-path t)
+ '(delete-file remove-path t)))
+ (children (ztree-diff-node-children parent))
+ (err
+ (condition-case error-trap
+ (progn
+ (eval delete-command)
+ nil)
+ (error error-trap))))
+ (if err (message (concat "Error: " (nth 2 err)))
+ (progn
+ (setq children (ztree-filter
+ #'(lambda (x) (not (ztree-diff-node-equal x node)))
+ children))
+ (ztree-diff-node-set-children parent children))
+ (ztree-diff-node-update-all-parents-diff node)
+ (ztree-refresh-buffer (line-number-at-pos))))))))))
+
+
(defun ztree-node-is-in-filter-list (node)
- "Determine if the node is in filter list (and therefore
-apparently shall not be visible"
+ "Determine if the NODE is in filter list.
+If the node is in the filter list it shall not be visible"
(ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx node))))
(defun ztree-node-is-visible (node)
- (and (not (ztree-node-is-in-filter-list (ztree-diff-node-short-name node)))
+ "Determine if the NODE should be visible."
+ (and (ztree-diff-node-parent node) ; parent is always visible
+ (not (ztree-node-is-in-filter-list (ztree-diff-node-short-name node)))
(or ztree-diff-show-equal-files
(ztree-diff-node-different node))))
(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))
(ztree-refresh-buffer))
-
+;;;###autoload
(defun ztree-diff (dir1 dir2)
- "Creates an interactive buffer with the directory tree of the path given"
+ "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))
- (buf-name (concat "*" (ztree-diff-node-short-name difference) "*")))
- (setq ztree-diff-dirs-pair (cons dir1 dir2))
- (setq ztree-diff-filter-list (list ztree-diff-hidden-files-regexp))
+ (buf-name (concat "*"
+ (ztree-diff-node-short-name difference)
+ " <--> "
+ (ztree-diff-node-right-short-name difference)
+ "*")))
(ztree-view buf-name
difference
'ztree-node-is-visible
'ztree-diff-insert-buffer-header
- 'ztree-diff-node-short-name
+ 'ztree-diff-node-short-name-wrapper
'ztree-diff-node-is-directory
'ztree-diff-node-equal
'ztree-diff-node-children
'ztree-diff-node-face
'ztree-diff-node-action
'ztree-diff-node-side)
- (ztreediff-mode)))
+ (ztreediff-mode)
+ (setq ztree-diff-dirs-pair (cons dir1 dir2))
+ (ztree-refresh-buffer)))
+
+
(provide 'ztree-diff)