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

   1 ;;; ztree-diff-model.el --- diff model 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 ;; Diff model
  30
  31 (require 'ztree-util)
  32
  33 (defvar ztree-diff-model-wait-message nil
  34   "Message showing while constructing the diff tree")
  35 (make-variable-buffer-local 'ztree-diff-model-wait-message)
  36
  37
  38 (defun ztree-diff-model-update-wait-message ()
  39   (when ztree-diff-model-wait-message
  40     (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message "."))
  41     (message ztree-diff-model-wait-message)))
  42
  43
  44
  45 ;; Create a record ztree-diff-node with defined fielsd and getters/setters
  46 ;; here:
  47 ;; parent - parent node
  48 ;; left-path is the full path on the left side of the diff window,
  49 ;; right-path is the full path of the right side,
  50 ;; short-name - is the file or directory name
  51 ;; children - list of nodes - files or directories if the node is a directory
  52 ;; different = {nil, 'new, 'diff} - means comparison status
  53 (defrecord ztree-diff-node (parent left-path right-path short-name children different))
  54
  55
  56 (defun ztree-diff-node-is-directory (node)
  57   (let ((left (ztree-diff-node-left-path node))
  58         (right (ztree-diff-node-right-path node)))
  59     (if left
  60         (file-directory-p left)
  61       (file-directory-p right))))
  62
  63 (defun ztree-diff-node-side (node)
  64   (let ((left (ztree-diff-node-left-path node))
  65         (right (ztree-diff-node-right-path node)))
  66     (if (and left right) 'both
  67       (if left 'left 'right))))
  68
  69 (defun ztree-diff-node-equal (node1 node2)
  70   (and (string-equal (ztree-diff-node-short-name node1)
  71                      (ztree-diff-node-short-name node2))
  72        (string-equal (ztree-diff-node-left-path node1)
  73                      (ztree-diff-node-left-path node2))
  74        (string-equal (ztree-diff-node-right-path node1)
  75                      (ztree-diff-node-right-path node1))))
  76
  77 (defun ztree-diff-model-files-equal (file1 file2)
  78   "Compare files using external diff. Returns t if equal"
  79   (let ((diff-output (shell-command-to-string (concat "diff -q" " " file1 " " file2))))
  80     (not (> (length diff-output) 2))))
  81
  82
  83 (defun ztree-directory-files (dir)
  84   "Returns the list of full paths of files in a directory, filtering out . and .."
  85   (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file)))
  86                                    (not (or (string-equal simple-name ".")
  87                                             (string-equal simple-name "..")))))
  88                 (directory-files dir 'full)))
  89
  90 (defun ztree-diff-model-subtree (parent path side)
  91   "Creates a subtree for the given path for either 'left or 'right sides"
  92   (let ((files (ztree-directory-files path))
  93         (result nil))
  94     (dolist (file files)
  95       (if (file-directory-p file)
  96           (let* ((node (ztree-diff-node-create
  97                         parent
  98                         (when (eq side 'left) file)
  99                         (when (eq side 'right) file)
 100                         (file-short-name file)
 101                         nil
 102                         'new))
 103                  (children (ztree-diff-model-subtree node file side)))
 104             (ztree-diff-node-set-children node children)
 105             (push node result))
 106         (push (ztree-diff-node-create
 107                parent
 108                (when (eq side 'left) file)
 109                (when (eq side 'right) file)
 110                (file-short-name file)
 111                nil
 112                'new)
 113               result)))
 114     result))
 115
 116 (defun ztree-diff-node-update-diff-from-children (node)
 117   (let ((children (ztree-diff-node-children node))
 118         (diff nil))
 119     (dolist (child children)
 120       (setq diff
 121             (ztree-diff-model-update-diff
 122              diff
 123              (ztree-diff-node-different child))))
 124     (ztree-diff-node-set-different node diff)))
 125
 126 (defun ztree-diff-node-update-all-parents-diff (node)
 127   (let ((parent node))
 128     (while (setq parent (ztree-diff-node-parent parent))
 129       (ztree-diff-node-update-diff-from-children parent))))
 130
 131
 132 (defun ztree-diff-model-update-diff (old new)
 133   (if new
 134       (if (or (not old)
 135               (eq old 'new))
 136           new
 137         old)
 138     old))
 139
 140 (defun ztree-diff-node-traverse (parent path1 path2)
 141   "Function traversing 2 paths returning the list where the
 142 first element is the difference status (nil, 'diff, 'new') and
 143 the rest is the combined list of nodes"
 144   (let ((list1 (ztree-directory-files path1))
 145         (list2 (ztree-directory-files path2))
 146         (different-dir nil)
 147         (result nil))
 148     (ztree-diff-model-update-wait-message)
 149     ;; first - adding all entries from left directory
 150     (dolist (file1 list1)
 151       ;; for every entry in the first directory
 152       ;; we are creating the node
 153       (let* ((simple-name (file-short-name file1))
 154              (isdir (file-directory-p file1))
 155              (children nil)
 156              (different nil)
 157              ;; create the current node to be set as parent to
 158              ;; subdirectories
 159              (node (ztree-diff-node-create parent file1 nil simple-name nil nil))
 160              ;; 1. find if the file is in the second directory and the type
 161              ;;    is the same - i.e. both are directories or both are files
 162              (file2 (ztree-find list2
 163                                 #'(lambda (x) (and (string-equal (file-short-name x)
 164                                                                  simple-name)
 165                                                    (eq isdir (file-directory-p x)))))))
 166         ;; 2. if it is not in the second directory, add it as a node
 167         (if (not file2)
 168             (progn
 169               ;; 2.1 if it is a directory, add the whole subtree
 170               (when (file-directory-p file1)
 171                 (setq children (ztree-diff-model-subtree node file1 'left)))
 172               ;; 2.2 update the difference status for this entry
 173               (setq different 'new))
 174           ;; 3. if it is found in second directory and of the same type
 175           ;; 3.1 if it is a file
 176           (if (not (file-directory-p file1))
 177               ;; 3.1.1 set difference status to this entry
 178               (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
 179             ;; 3.2 if it is the directory
 180             ;; 3.2.1 get the result of the directories comparison together with status
 181             (let ((traverse (ztree-diff-node-traverse node file1 file2)))
 182               ;; 3.2.2 update the difference status for whole comparison from
 183               ;;       difference result from the 2 subdirectories comparison
 184               (setq different (car traverse))
 185               ;; 3.2.3 set the children list from the 2 subdirectories comparison
 186               (setq children (cdr traverse)))))
 187         ;; 2.3 update difference status for the whole comparison
 188         (setq different-dir (ztree-diff-model-update-diff different-dir different))
 189         ;; update calculated parameters of the node
 190         (ztree-diff-node-set-right-path node file2)
 191         (ztree-diff-node-set-children node children)
 192         (ztree-diff-node-set-different node different)
 193         ;; push the created node to the result list
 194         (push node result)))
 195     ;; second - adding entries from the right directory which are not present
 196     ;; in the left directory
 197     (dolist (file2 list2)
 198       ;; for every entry in the second directory
 199       ;; we are creating the node
 200       (let* ((simple-name (file-short-name file2))
 201              (isdir (file-directory-p file2))
 202              (children nil)
 203              ;; create the node to be added to the results list
 204              (node (ztree-diff-node-create parent nil file2 simple-name nil 'new))
 205              ;; 1. find if the file is in the first directory and the type
 206              ;;    is the same - i.e. both are directories or both are files
 207              (file1 (ztree-find list1
 208                                 #'(lambda (x) (and (string-equal (file-short-name x)
 209                                                                  simple-name)
 210                                                    (eq isdir (file-directory-p x)))))))
 211         ;; if it is not in the first directory, add it as a node
 212         (when (not file1)
 213           ;; if it is a directory, set the whole subtree to children
 214           (when (file-directory-p file2)
 215             (setq children (ztree-diff-model-subtree node file2 'right)))
 216           ;; update the different status for the whole comparison
 217           (setq different-dir (ztree-diff-model-update-diff different-dir 'new))
 218           ;; set calculated children to the node
 219           (ztree-diff-node-set-children node children)
 220           ;; push the created node to the result list
 221           (push node result))))
 222     ;; result is a pair: difference status and nodes list
 223     (cons different-dir result)))
 224
 225 (defun ztree-diff-model-create (dir1 dir2)
 226   (when (not (file-directory-p dir1))
 227     (error "Path %s is not a directory" dir1))
 228   (when (not (file-directory-p dir2))
 229     (error "Path %s is not a directory" dir2))
 230   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
 231   (let* ((model
 232           (ztree-diff-node-create nil dir1 dir2
 233                                   (concat (file-short-name dir1)
 234                                           " <--> "
 235                                           (file-short-name dir2))
 236                                   nil
 237                                   nil))
 238          (traverse (ztree-diff-node-traverse model dir1 dir2)))
 239     (ztree-diff-node-set-children model (cdr traverse))
 240     (ztree-diff-node-set-different model (car traverse))
 241     (message "Done.")
 242     model))
 243
 244 (defun ztree-diff-model-update-node (node)
 245   (setq ztree-diff-model-wait-message
 246         (concat "Updating " (ztree-diff-node-short-name node) " ..."))
 247   (let ((traverse (ztree-diff-node-traverse node
 248                                             (ztree-diff-node-left-path node)
 249                                             (ztree-diff-node-right-path node))))
 250     (ztree-diff-node-set-children node (cdr traverse))
 251     (ztree-diff-node-set-different node (car traverse))
 252     (message "Done.")))
 253
 254
 255
 256 (provide 'ztree-diff-model)