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

   1 ;;; ztree-diff-model.el --- diff model for directory trees
   2
   3 ;; Copyright (C) 2013-2015  Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
   6 ;;
   7 ;; Created: 2013-11-1l
   8 ;;
   9 ;; Keywords: files tools
  10 ;; URL: https://github.com/fourier/ztree
  11 ;; Compatibility: GNU Emacs GNU Emacs 24.x
  12 ;;
  13 ;; This file is part of GNU Emacs.
  14 ;;
  15 ;; GNU Emacs is free software: you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation, either version 3 of the License, or
  18 ;; (at your option) any later version.
  19 ;;
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  27 ;;
  28 ;;; Commentary:
  29
  30 ;; Diff model
  31
  32 ;;; Code:
  33 (require 'ztree-util)
  34
  35 (defvar ztree-diff-model-wait-message nil
  36   "Message showing while constructing the diff tree.")
  37 (make-variable-buffer-local 'ztree-diff-model-wait-message)
  38
  39
  40 (defun ztree-diff-model-update-wait-message ()
  41   "Update the wait mesage with one more '.' progress indication."
  42   (when ztree-diff-model-wait-message
  43     (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message "."))
  44     (message ztree-diff-model-wait-message)))
  45
  46
  47
  48 ;; Create a record ztree-diff-node with defined fielsd and getters/setters
  49 ;; here:
  50 ;; parent - parent node
  51 ;; left-path is the full path on the left side of the diff window,
  52 ;; right-path is the full path of the right side,
  53 ;; short-name - is the file or directory name
  54 ;; children - list of nodes - files or directories if the node is a directory
  55 ;; different = {nil, 'new, 'diff} - means comparison status
  56 (defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different))
  57
  58 (defun ztree-diff-node-to-string (node)
  59   "Construct the string with contents of the NODE given."
  60   (let* ((string-or-nil #'(lambda (x) (if x
  61                                           (cond ((stringp x) x)
  62                                                 ((eq x 'new) "new")
  63                                                 ((eq x 'diff) "different")
  64                                                 (t (ztree-diff-node-short-name x)))
  65                                         "(empty)")))
  66          (children (ztree-diff-node-children node))
  67          (ch-str ""))
  68     (dolist (x children)
  69       (setq ch-str (concat ch-str "\n   * " (ztree-diff-node-short-name x))))
  70     (concat "Node: " (ztree-diff-node-short-name node)
  71             "\n"
  72             ;; " * Parent: " (let ((parent (ztree-diff-node-parent node)))
  73             ;;                 (if parent (ztree-diff-node-short-name parent) "nil"))
  74             " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
  75             "\n"
  76             " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path node))
  77             "\n"
  78             " * Right path: " (funcall string-or-nil (ztree-diff-node-right-path node))
  79             "\n"
  80             " * Children: " ch-str
  81             "\n")))
  82
  83
  84 (defun ztree-diff-node-short-name-wrapper (node &optional right-side)
  85   "Return the short name of the NODE given.
  86 If the RIGHT-SIDE is true, take the right leaf"
  87   (if (not right-side)
  88       (ztree-diff-node-short-name node)
  89     (ztree-diff-node-right-short-name node)))
  90
  91
  92 (defun ztree-diff-node-is-directory (node)
  93   "Determines if the NODE is a directory."
  94   (let ((left (ztree-diff-node-left-path node))
  95         (right (ztree-diff-node-right-path node)))
  96     (if left
  97         (file-directory-p left)
  98       (file-directory-p right))))
  99
 100 (defun ztree-diff-node-side (node)
 101   "Determine the side there the file is present for NODE.
 102 Return BOTH if the file present on both sides;
 103 LEFT if only on the left side and
 104 RIGHT if only on the right side."
 105   (let ((left (ztree-diff-node-left-path node))
 106         (right (ztree-diff-node-right-path node)))
 107     (if (and left right) 'both
 108       (if left 'left 'right))))
 109
 110 (defun ztree-diff-node-equal (node1 node2)
 111   "Determines if NODE1 and NODE2 are equal."
 112   (and (string-equal (ztree-diff-node-short-name node1)
 113                      (ztree-diff-node-short-name node2))
 114        (string-equal (ztree-diff-node-left-path node1)
 115                      (ztree-diff-node-left-path node2))
 116        (string-equal (ztree-diff-node-right-path node1)
 117                      (ztree-diff-node-right-path node1))))
 118
 119 (defun ztree-diff-untrampify-filename (file)
 120   "Return FILE as the local file name."
 121   (require 'tramp)
 122   (if (not (tramp-tramp-file-p file))
 123       file
 124     (tramp-file-name-localname (tramp-dissect-file-name file))))
 125
 126 (defun ztree-diff-modef-quotify-string (x)
 127   "Surround string X with quotes."
 128   (concat "\"" x "\""))
 129
 130 (defun ztree-diff-model-files-equal (file1 file2)
 131   "Compare files FILE1 and FILE2 using external diff.
 132 Returns t if equal."
 133   (let* ((file1-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file1)))
 134          (file2-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file2)))
 135          (diff-command (concat "diff -q" " " file1-untrampified " " file2-untrampified))
 136          (diff-output (shell-command-to-string diff-command)))
 137     (not (> (length diff-output) 2))))
 138
 139 (defun ztree-directory-files (dir)
 140   "Return the list of full paths of files in a directory DIR.
 141 Filters out . and .."
 142   (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file)))
 143                                    (not (or (string-equal simple-name ".")
 144                                             (string-equal simple-name "..")))))
 145                 (directory-files dir 'full)))
 146
 147 (defun ztree-diff-model-partial-rescan (node)
 148   "Rescan the NODE."
 149   ;; assuming what parent is always exists
 150   ;; otherwise the UI shall force the full rescan
 151   (let ((parent (ztree-diff-node-parent node))
 152         (isdir (ztree-diff-node-is-directory node))
 153         (left (ztree-diff-node-left-path node))
 154         (right (ztree-diff-node-right-path node)))
 155     ;; if node is a directory - traverse
 156     (when (and left right
 157                (file-exists-p left)
 158                (file-exists-p right))
 159       (if isdir
 160         (let ((traverse (ztree-diff-node-traverse
 161                          node
 162                          left
 163                          right)))
 164           (ztree-diff-node-set-different node (car traverse))
 165           (ztree-diff-node-set-children node (cdr traverse)))
 166         ;; node is a file
 167         (ztree-diff-node-set-different
 168          node
 169          (if (ztree-diff-model-files-equal left right)
 170              nil
 171            'diff))))))
 172
 173 (defun ztree-diff-model-subtree (parent path side)
 174   "Create a subtree with given PARENT for the given PATH.
 175 Argument SIDE either 'left or 'right side."
 176   (let ((files (ztree-directory-files path))
 177         (result nil))
 178     (dolist (file files)
 179       (if (file-directory-p file)
 180           (let* ((node (ztree-diff-node-create
 181                         parent
 182                         (when (eq side 'left) file)
 183                         (when (eq side 'right) file)
 184                         (file-short-name file)
 185                         (file-short-name file)
 186                         nil
 187                         'new))
 188                  (children (ztree-diff-model-subtree node file side)))
 189             (ztree-diff-node-set-children node children)
 190             (push node result))
 191         (push (ztree-diff-node-create
 192                parent
 193                (when (eq side 'left) file)
 194                (when (eq side 'right) file)
 195                (file-short-name file)
 196                (file-short-name file)
 197                nil
 198                'new)
 199               result)))
 200     result))
 201
 202 (defun ztree-diff-node-update-diff-from-children (node)
 203   "Set the diff status for the NODE based on its children."
 204   (let ((children (ztree-diff-node-children node))
 205         (diff nil))
 206     (dolist (child children)
 207       (setq diff
 208             (ztree-diff-model-update-diff
 209              diff
 210              (ztree-diff-node-different child))))
 211     (ztree-diff-node-set-different node diff)))
 212
 213 (defun ztree-diff-node-update-all-parents-diff (node)
 214   "Recursively update all parents diff status for the NODE."
 215   (let ((parent node))
 216     (while (setq parent (ztree-diff-node-parent parent))
 217       (ztree-diff-node-update-diff-from-children parent))))
 218
 219
 220 (defun ztree-diff-model-update-diff (old new)
 221   "Get the diff status depending if OLD or NEW is not nil."
 222   (if new
 223       (if (or (not old)
 224               (eq old 'new))
 225           new
 226         old)
 227     old))
 228
 229 (defun ztree-diff-node-traverse (parent path1 path2)
 230   "Traverse 2 paths creating the list nodes with PARENT defined and diff status.
 231 Function traversing 2 paths PATH1 and PATH2 returning the list where the
 232 first element is the difference status (nil, 'diff, 'new') and
 233 the rest is the combined list of nodes."
 234   (let ((list1 (ztree-directory-files path1))
 235         (list2 (ztree-directory-files path2))
 236         (different-dir nil)
 237         (result nil))
 238     (ztree-diff-model-update-wait-message)
 239     ;; first - adding all entries from left directory
 240     (dolist (file1 list1)
 241       ;; for every entry in the first directory
 242       ;; we are creating the node
 243       (let* ((simple-name (file-short-name file1))
 244              (isdir (file-directory-p file1))
 245              (children nil)
 246              (different nil)
 247              ;; create the current node to be set as parent to
 248              ;; subdirectories
 249              (node (ztree-diff-node-create parent file1 nil simple-name simple-name nil nil))
 250              ;; 1. find if the file is in the second directory and the type
 251              ;;    is the same - i.e. both are directories or both are files
 252              (file2 (ztree-find list2
 253                                 #'(lambda (x) (and (string-equal (file-short-name x)
 254                                                                  simple-name)
 255                                                    (eq isdir (file-directory-p x)))))))
 256         ;; 2. if it is not in the second directory, add it as a node
 257         (if (not file2)
 258             (progn
 259               ;; 2.1 if it is a directory, add the whole subtree
 260               (when (file-directory-p file1)
 261                 (setq children (ztree-diff-model-subtree node file1 'left)))
 262               ;; 2.2 update the difference status for this entry
 263               (setq different 'new))
 264           ;; 3. if it is found in second directory and of the same type
 265           ;; 3.1 if it is a file
 266           (if (not (file-directory-p file1))
 267               ;; 3.1.1 set difference status to this entry
 268               (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
 269             ;; 3.2 if it is the directory
 270             ;; 3.2.1 get the result of the directories comparison together with status
 271             (let ((traverse (ztree-diff-node-traverse node file1 file2)))
 272               ;; 3.2.2 update the difference status for whole comparison from
 273               ;;       difference result from the 2 subdirectories comparison
 274               (setq different (car traverse))
 275               ;; 3.2.3 set the children list from the 2 subdirectories comparison
 276               (setq children (cdr traverse)))))
 277         ;; 2.3 update difference status for the whole comparison
 278         (setq different-dir (ztree-diff-model-update-diff different-dir different))
 279         ;; update calculated parameters of the node
 280         (ztree-diff-node-set-right-path node file2)
 281         (ztree-diff-node-set-children node children)
 282         (ztree-diff-node-set-different node different)
 283         ;; push the created node to the result list
 284         (push node result)))
 285     ;; second - adding entries from the right directory which are not present
 286     ;; in the left directory
 287     (dolist (file2 list2)
 288       ;; for every entry in the second directory
 289       ;; we are creating the node
 290       (let* ((simple-name (file-short-name file2))
 291              (isdir (file-directory-p file2))
 292              (children nil)
 293              ;; create the node to be added to the results list
 294              (node (ztree-diff-node-create parent nil file2 simple-name simple-name nil 'new))
 295              ;; 1. find if the file is in the first directory and the type
 296              ;;    is the same - i.e. both are directories or both are files
 297              (file1 (ztree-find list1
 298                                 #'(lambda (x) (and (string-equal (file-short-name x)
 299                                                                  simple-name)
 300                                                    (eq isdir (file-directory-p x)))))))
 301         ;; if it is not in the first directory, add it as a node
 302         (when (not file1)
 303           ;; if it is a directory, set the whole subtree to children
 304           (when (file-directory-p file2)
 305             (setq children (ztree-diff-model-subtree node file2 'right)))
 306           ;; update the different status for the whole comparison
 307           (setq different-dir (ztree-diff-model-update-diff different-dir 'new))
 308           ;; set calculated children to the node
 309           (ztree-diff-node-set-children node children)
 310           ;; push the created node to the result list
 311           (push node result))))
 312     ;; result is a pair: difference status and nodes list
 313     (cons different-dir result)))
 314
 315 (defun ztree-diff-model-create (dir1 dir2)
 316   "Create a node based on DIR1 and DIR2."
 317   (when (not (file-directory-p dir1))
 318     (error "Path %s is not a directory" dir1))
 319   (when (not (file-directory-p dir2))
 320     (error "Path %s is not a directory" dir2))
 321   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
 322   (let* ((model
 323           (ztree-diff-node-create nil dir1 dir2
 324                                   (file-short-name dir1)
 325                                   (file-short-name dir2)
 326                                   nil
 327                                   nil))
 328          (traverse (ztree-diff-node-traverse model dir1 dir2)))
 329     (ztree-diff-node-set-children model (cdr traverse))
 330     (ztree-diff-node-set-different model (car traverse))
 331     (message "Done.")
 332     model))
 333
 334 (defun ztree-diff-model-update-node (node)
 335   "Refresh the NODE."
 336   (setq ztree-diff-model-wait-message
 337         (concat "Updating " (ztree-diff-node-short-name node) " ..."))
 338   (let ((traverse (ztree-diff-node-traverse node
 339                                             (ztree-diff-node-left-path node)
 340                                             (ztree-diff-node-right-path node))))
 341     (ztree-diff-node-set-children node (cdr traverse))
 342     (ztree-diff-node-set-different node (car traverse))
 343     (message "Done.")))
 344
 345
 346
 347 (provide 'ztree-diff-model)
 348
 349 ;;; ztree-diff-model.el ends here