-;;; 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 "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 the header to the ztree buffer."
+ (ztree-insert-with-face "Differences tree" ztreep-diff-header-face)
+ (insert "\n")
(when ztree-diff-dirs-pair
- (insert-with-face (concat "Left: " (car ztree-diff-dirs-pair))
- ztreep-diff-header-small-face)
- (newline)
- (insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair))
- ztreep-diff-header-small-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))
+ (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 ()
- "Forces full rescan of the directory trees"
+ "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-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)))
+ (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"
+ "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
(defun ztree-diff-simple-diff-files ()
- "Create a simple diff buffer for files from left and right panels"
+ "Create a simple diff buffer for files from left and right panels."
(interactive)
(let ((found (ztree-find-node-at-point)))
(when 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)))
- (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"))
- (if hard
- (ediff left right)
- (ztree-diff-simple-diff 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
(defun ztree-diff-copy ()
+ "Copy the file under the cursor to other side."
(interactive)
(let ((found (ztree-find-node-at-point)))
(when found
copy-to-right))))))))
(defun ztree-diff-view-file ()
- "View file at point, depending on side"
+ "View file at point, depending on side."
(interactive)
(let ((found (ztree-find-node-at-point)))
(when found
((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
(when (yes-or-no-p (format "Delete the file [%s]%s ?"
(if delete-from-left "LEFT" "RIGHT")
remove-path))
- (let* ((delete-command
+ (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
+ (err
(condition-case error-trap
(progn
(eval delete-command)
nil)
(error error-trap))))
(if err (message (concat "Error: " (nth 2 err)))
- (progn
+ (progn
(setq children (ztree-filter
#'(lambda (x) (not (ztree-diff-node-equal x node)))
children))
(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)
+ "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-right-short-name difference)
"*")))
- (setq ztree-diff-filter-list (list ztree-diff-hidden-files-regexp))
(ztree-view buf-name
difference
'ztree-node-is-visible
(ztreediff-mode)
(setq ztree-diff-dirs-pair (cons dir1 dir2))
(ztree-refresh-buffer)))
-
+