code.delx.au - gnu-emacs-elpa/blob - ztree-diff.el

   1 ;;; ztree-diff.el --- Text mode diff for directory trees
   2
   3 ;; Copyright (C) 2013 Alexey Veretennikov
   4 ;;
   5 ;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
   6 ;; Created: 2013-11-1l
   7 ;; Version: 1.0.0
   8 ;; Keywords: files
   9 ;; URL: https://github.com/fourier/ztree
  10 ;; Compatibility: GNU Emacs GNU Emacs 24.x
  11 ;;
  12 ;; This file is NOT part of GNU Emacs.
  13 ;;
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License
  16 ;; as published by the Free Software Foundation; either version 2
  17 ;; of the License, or (at your option) any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  26 ;;
  27 ;;; Commentary:
  28
  29 (require 'ztree-view)
  30 (require 'ztree-diff-model)
  31
  32 (defconst ztree-diff-hidden-files-regexp "^\\."
  33   "Hidden files regexp. By default all filest starting with dot '.',
  34 including . and ..")
  35
  36 (defface ztreep-diff-header-face
  37   '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
  38     (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
  39     (t :height 1.2 :foreground "darkblue" :weight bold))
  40   "*Face used for the header in Ztree Diff buffer."
  41   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  42 (defvar ztreep-diff-header-face 'ztreep-diff-header-face)
  43
  44 (defface ztreep-diff-header-small-face
  45   '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
  46     (((background dark)) (:foreground "lightblue" :weight bold))
  47     (t :weight bold :foreground "darkblue"))
  48   "*Face used for the header in Ztree Diff buffer."
  49   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  50 (defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face)
  51
  52 (defface ztreep-diff-model-diff-face
  53   '((t                   (:foreground "red")))
  54   "*Face used for different files in Ztree-diff."
  55   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  56 (defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face)
  57
  58 (defface ztreep-diff-model-add-face
  59   '((t                   (:foreground "blue")))
  60   "*Face used for added files in Ztree-diff."
  61   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  62 (defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face)
  63
  64 (defface ztreep-diff-model-normal-face
  65   '((t                   (:foreground "#7f7f7f")))
  66   "*Face used for non-modified files in Ztree-diff."
  67   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  68 (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
  69
  70
  71 (defun ztree-diff-node-face (node)
  72   (let ((diff (ztree-diff-node-different node)))
  73     (cond ((eq diff 'diff) ztreep-diff-model-diff-face)
  74           ((eq diff 'new)  ztreep-diff-model-add-face)
  75           (t ztreep-diff-model-normal-face))))
  76
  77 (defun ztree-diff-insert-buffer-header ()
  78   (insert-with-face "Differences tree" ztreep-diff-header-face)
  79   (newline)
  80   (insert-with-face"Legend:" ztreep-diff-header-small-face)
  81   (newline)
  82   (insert-with-face " Normal file " ztreep-diff-model-normal-face)
  83   (insert-with-face "- same on both sides" ztreep-diff-header-small-face)
  84   (newline)
  85   (insert-with-face " Orphan file " ztreep-diff-model-add-face)
  86   (insert-with-face "- does not exist on other side" ztreep-diff-header-small-face)
  87   (newline)
  88   (insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
  89   (insert-with-face "- different from other side" ztreep-diff-header-small-face)
  90   (newline)
  91   (insert-with-face "==============" ztreep-diff-header-face)
  92   (newline))
  93
  94 (defun ztree-diff-node-action (node)
  95   (let ((left (ztree-diff-node-left-path node))
  96         (right (ztree-diff-node-right-path node)))
  97     (when (and left right)
  98       (ediff left right))))
  99
 100 (defun ztree-diff (dir1 dir2)
 101   "Creates an interactive buffer with the directory tree of the path given"
 102   (interactive "DLeft directory \nDRight directory ")
 103   (let* ((difference (ztree-diff-model-create dir1 dir2))
 104          (buf-name (concat "*" (ztree-diff-node-short-name difference) "*")))
 105     (ztree-view buf-name
 106                 difference
 107                 (list ztree-diff-hidden-files-regexp)
 108                 'ztree-diff-insert-buffer-header
 109                 'ztree-diff-node-short-name
 110                 'ztree-diff-node-is-directory
 111                 'equal
 112                 'ztree-diff-node-children
 113                 'ztree-diff-node-face
 114                 'ztree-diff-node-action
 115                 'ztree-diff-node-side)))
 116
 117
 118 (provide 'ztree-diff)
 119 ;;; ztree-diff.el ends here