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 right-short-name children different))
  54
  55 (defun ztree-diff-node-to-string (node)
  56   (let* ((string-or-nil #'(lambda (x) (if x
  57                                           (cond ((stringp x) x)
  58                                                 ((eq x 'new) "new")
  59                                                 ((eq x 'diff) "different")
  60                                                 (t (ztree-diff-node-short-name x)))
  61                                         "(empty)")))
  62          (children (ztree-diff-node-children node))
  63          (ch-str ""))
  64     (dolist (x children)
  65       (setq ch-str (concat ch-str "\n   * " (ztree-diff-node-short-name x))))
  66     (concat "Node: " (ztree-diff-node-short-name node)
  67             "\n"
  68             ;; " * Parent: " (let ((parent (ztree-diff-node-parent node)))
  69             ;;                 (if parent (ztree-diff-node-short-name parent) "nil"))
  70             " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
  71             "\n"
  72             " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path node))
  73             "\n"
  74             " * Right path: " (funcall string-or-nil (ztree-diff-node-right-path node))
  75             "\n"
  76             " * Children: " ch-str
  77             "\n")))
  78
  79
  80 (defun ztree-diff-node-short-name-wrapper (node &optional right-side)
  81   (if (not right-side)
  82       (ztree-diff-node-short-name node)
  83     (ztree-diff-node-right-short-name node)))
  84
  85
  86 (defun ztree-diff-node-is-directory (node)
  87   (let ((left (ztree-diff-node-left-path node))
  88         (right (ztree-diff-node-right-path node)))
  89     (if left
  90         (file-directory-p left)
  91       (file-directory-p right))))
  92
  93 (defun ztree-diff-node-side (node)
  94   (let ((left (ztree-diff-node-left-path node))
  95         (right (ztree-diff-node-right-path node)))
  96     (if (and left right) 'both
  97       (if left 'left 'right))))
  98
  99 (defun ztree-diff-node-equal (node1 node2)
 100   (and (string-equal (ztree-diff-node-short-name node1)
 101                      (ztree-diff-node-short-name node2))
 102        (string-equal (ztree-diff-node-left-path node1)
 103                      (ztree-diff-node-left-path node2))
 104        (string-equal (ztree-diff-node-right-path node1)
 105                      (ztree-diff-node-right-path node1))))
 106
 107 (defun ztree-diff-model-files-equal (file1 file2)
 108   "Compare files using external diff. Returns t if equal"
 109   (let ((diff-output (shell-command-to-string (concat "diff -q" " " file1 " " file2))))
 110     (not (> (length diff-output) 2))))
 111
 112
 113 (defun ztree-directory-files (dir)
 114   "Returns the list of full paths of files in a directory, filtering out . and .."
 115   (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file)))
 116                                    (not (or (string-equal simple-name ".")
 117                                             (string-equal simple-name "..")))))
 118                 (directory-files dir 'full)))
 119
 120 (defun ztree-diff-model-partial-rescan (node)
 121   ;; assuming what parent is always exists
 122   ;; otherwise the UI shall force the full rescan
 123   (let ((parent (ztree-diff-node-parent node))
 124         (isdir (ztree-diff-node-is-directory node))
 125         (left (ztree-diff-node-left-path node))
 126         (right (ztree-diff-node-right-path node)))
 127     ;; if node is a directory - traverse
 128     (when (and left right
 129                (file-exists-p left)
 130                (file-exists-p right))
 131       (if isdir
 132         (let ((traverse (ztree-diff-node-traverse
 133                          node
 134                          left
 135                          right)))
 136           (ztree-diff-node-set-different node (car traverse))
 137           (ztree-diff-node-set-children node (cdr traverse)))
 138         ;; node is a file
 139         (ztree-diff-node-set-different
 140          node
 141          (if (ztree-diff-model-files-equal left right)
 142              nil
 143            'diff))))))
 144
 145 (defun ztree-diff-model-subtree (parent path side)
 146   "Creates a subtree for the given path for either 'left or 'right sides"
 147   (let ((files (ztree-directory-files path))
 148         (result nil))
 149     (dolist (file files)
 150       (if (file-directory-p file)
 151           (let* ((node (ztree-diff-node-create
 152                         parent
 153                         (when (eq side 'left) file)
 154                         (when (eq side 'right) file)
 155                         (file-short-name file)
 156                         (file-short-name file)
 157                         nil
 158                         'new))
 159                  (children (ztree-diff-model-subtree node file side)))
 160             (ztree-diff-node-set-children node children)
 161             (push node result))
 162         (push (ztree-diff-node-create
 163                parent
 164                (when (eq side 'left) file)
 165                (when (eq side 'right) file)
 166                (file-short-name file)
 167                (file-short-name file)
 168                nil
 169                'new)
 170               result)))
 171     result))
 172
 173 (defun ztree-diff-node-update-diff-from-children (node)
 174   (let ((children (ztree-diff-node-children node))
 175         (diff nil))
 176     (dolist (child children)
 177       (setq diff
 178             (ztree-diff-model-update-diff
 179              diff
 180              (ztree-diff-node-different child))))
 181     (ztree-diff-node-set-different node diff)))
 182
 183 (defun ztree-diff-node-update-all-parents-diff (node)
 184   (let ((parent node))
 185     (while (setq parent (ztree-diff-node-parent parent))
 186       (ztree-diff-node-update-diff-from-children parent))))
 187
 188
 189 (defun ztree-diff-model-update-diff (old new)
 190   (if new
 191       (if (or (not old)
 192               (eq old 'new))
 193           new
 194         old)
 195     old))
 196
 197 (defun ztree-diff-node-traverse (parent path1 path2)
 198   "Function traversing 2 paths returning the list where the
 199 first element is the difference status (nil, 'diff, 'new') and
 200 the rest is the combined list of nodes"
 201   (let ((list1 (ztree-directory-files path1))
 202         (list2 (ztree-directory-files path2))
 203         (different-dir nil)
 204         (result nil))
 205     (ztree-diff-model-update-wait-message)
 206     ;; first - adding all entries from left directory
 207     (dolist (file1 list1)
 208       ;; for every entry in the first directory
 209       ;; we are creating the node
 210       (let* ((simple-name (file-short-name file1))
 211              (isdir (file-directory-p file1))
 212              (children nil)
 213              (different nil)
 214              ;; create the current node to be set as parent to
 215              ;; subdirectories
 216              (node (ztree-diff-node-create parent file1 nil simple-name simple-name nil nil))
 217              ;; 1. find if the file is in the second directory and the type
 218              ;;    is the same - i.e. both are directories or both are files
 219              (file2 (ztree-find list2
 220                                 #'(lambda (x) (and (string-equal (file-short-name x)
 221                                                                  simple-name)
 222                                                    (eq isdir (file-directory-p x)))))))
 223         ;; 2. if it is not in the second directory, add it as a node
 224         (if (not file2)
 225             (progn
 226               ;; 2.1 if it is a directory, add the whole subtree
 227               (when (file-directory-p file1)
 228                 (setq children (ztree-diff-model-subtree node file1 'left)))
 229               ;; 2.2 update the difference status for this entry
 230               (setq different 'new))
 231           ;; 3. if it is found in second directory and of the same type
 232           ;; 3.1 if it is a file
 233           (if (not (file-directory-p file1))
 234               ;; 3.1.1 set difference status to this entry
 235               (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
 236             ;; 3.2 if it is the directory
 237             ;; 3.2.1 get the result of the directories comparison together with status
 238             (let ((traverse (ztree-diff-node-traverse node file1 file2)))
 239               ;; 3.2.2 update the difference status for whole comparison from
 240               ;;       difference result from the 2 subdirectories comparison
 241               (setq different (car traverse))
 242               ;; 3.2.3 set the children list from the 2 subdirectories comparison
 243               (setq children (cdr traverse)))))
 244         ;; 2.3 update difference status for the whole comparison
 245         (setq different-dir (ztree-diff-model-update-diff different-dir different))
 246         ;; update calculated parameters of the node
 247         (ztree-diff-node-set-right-path node file2)
 248         (ztree-diff-node-set-children node children)
 249         (ztree-diff-node-set-different node different)
 250         ;; push the created node to the result list
 251         (push node result)))
 252     ;; second - adding entries from the right directory which are not present
 253     ;; in the left directory
 254     (dolist (file2 list2)
 255       ;; for every entry in the second directory
 256       ;; we are creating the node
 257       (let* ((simple-name (file-short-name file2))
 258              (isdir (file-directory-p file2))
 259              (children nil)
 260              ;; create the node to be added to the results list
 261              (node (ztree-diff-node-create parent nil file2 simple-name simple-name nil 'new))
 262              ;; 1. find if the file is in the first directory and the type
 263              ;;    is the same - i.e. both are directories or both are files
 264              (file1 (ztree-find list1
 265                                 #'(lambda (x) (and (string-equal (file-short-name x)
 266                                                                  simple-name)
 267                                                    (eq isdir (file-directory-p x)))))))
 268         ;; if it is not in the first directory, add it as a node
 269         (when (not file1)
 270           ;; if it is a directory, set the whole subtree to children
 271           (when (file-directory-p file2)
 272             (setq children (ztree-diff-model-subtree node file2 'right)))
 273           ;; update the different status for the whole comparison
 274           (setq different-dir (ztree-diff-model-update-diff different-dir 'new))
 275           ;; set calculated children to the node
 276           (ztree-diff-node-set-children node children)
 277           ;; push the created node to the result list
 278           (push node result))))
 279     ;; result is a pair: difference status and nodes list
 280     (cons different-dir result)))
 281
 282 (defun ztree-diff-model-create (dir1 dir2)
 283   (when (not (file-directory-p dir1))
 284     (error "Path %s is not a directory" dir1))
 285   (when (not (file-directory-p dir2))
 286     (error "Path %s is not a directory" dir2))
 287   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
 288   (let* ((model
 289           (ztree-diff-node-create nil dir1 dir2
 290                                   (file-short-name dir1)
 291                                   (file-short-name dir2)
 292                                   nil
 293                                   nil))
 294          (traverse (ztree-diff-node-traverse model dir1 dir2)))
 295     (ztree-diff-node-set-children model (cdr traverse))
 296     (ztree-diff-node-set-different model (car traverse))
 297     (message "Done.")
 298     model))
 299
 300 (defun ztree-diff-model-update-node (node)
 301   (setq ztree-diff-model-wait-message
 302         (concat "Updating " (ztree-diff-node-short-name node) " ..."))
 303   (let ((traverse (ztree-diff-node-traverse node
 304                                             (ztree-diff-node-left-path node)
 305                                             (ztree-diff-node-right-path node))))
 306     (ztree-diff-node-set-children node (cdr traverse))
 307     (ztree-diff-node-set-different node (car traverse))
 308     (message "Done.")))
 309
 310
 311
 312 (provide 'ztree-diff-model)