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

   1 ;;; ztree-diff-model.el --- diff model for directory trees -*- lexical-binding: t; -*-
   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 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 (defvar ztree-diff-model-ignore-fun nil
  40   "Function which determines if the node should be excluded from comparison.")
  41 (make-variable-buffer-local 'ztree-diff-model-ignore-fun)
  42
  43 (defun ztree-diff-model-update-wait-message ()
  44   "Update the wait mesage with one more '.' progress indication."
  45   (when ztree-diff-model-wait-message
  46     (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message "."))
  47     (message ztree-diff-model-wait-message)))
  48
  49 ;; Create a record ztree-diff-node with defined fields and getters/setters
  50 ;; here:
  51 ;; parent - parent node
  52 ;; left-path is the full path on the left side of the diff window,
  53 ;; right-path is the full path of the right side,
  54 ;; short-name - is the file or directory name
  55 ;; children - list of nodes - files or directories if the node is a directory
  56 ;; different = {nil, 'new, 'diff} - means comparison status
  57 (ztree-defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different))
  58
  59 (defun ztree-diff-model-ignore-p (node)
  60   "Determine if the NODE should be excluded from comparison results."
  61   (when ztree-diff-model-ignore-fun
  62     (funcall ztree-diff-model-ignore-fun node)))
  63
  64 (defun ztree-diff-node-to-string (node)
  65   "Construct the string with contents of the NODE given."
  66   (let* ((string-or-nil #'(lambda (x) (if x
  67                                           (cond ((stringp x) x)
  68                                                 ((eq x 'new) "new")
  69                                                 ((eq x 'diff) "different")
  70                                                 (t (ztree-diff-node-short-name x)))
  71                                         "(empty)")))
  72          (children (ztree-diff-node-children node))
  73          (ch-str ""))
  74     (dolist (x children)
  75       (setq ch-str (concat ch-str "\n   * " (ztree-diff-node-short-name x))))
  76     (concat "Node: " (ztree-diff-node-short-name node)
  77             "\n"
  78             ;; " * Parent: " (let ((parent (ztree-diff-node-parent node)))
  79             ;;                 (if parent (ztree-diff-node-short-name parent) "nil"))
  80             " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
  81             "\n"
  82             " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path node))
  83             "\n"
  84             " * Right path: " (funcall string-or-nil (ztree-diff-node-right-path node))
  85             "\n"
  86             " * Children: " ch-str
  87             "\n")))
  88
  89
  90 (defun ztree-diff-node-short-name-wrapper (node &optional right-side)
  91   "Return the short name of the NODE given.
  92 If the RIGHT-SIDE is true, take the right leaf"
  93   (if (not right-side)
  94       (ztree-diff-node-short-name node)
  95     (ztree-diff-node-right-short-name node)))
  96
  97
  98 (defun ztree-diff-node-is-directory (node)
  99   "Determines if the NODE is a directory."
 100   (let ((left (ztree-diff-node-left-path node))
 101         (right (ztree-diff-node-right-path node)))
 102     (if left
 103         (file-directory-p left)
 104       (file-directory-p right))))
 105
 106 (defun ztree-diff-node-side (node)
 107   "Determine the side there the file is present for NODE.
 108 Return BOTH if the file present on both sides;
 109 LEFT if only on the left side and
 110 RIGHT if only on the right side."
 111   (let ((left (ztree-diff-node-left-path node))
 112         (right (ztree-diff-node-right-path node)))
 113     (if (and left right) 'both
 114       (if left 'left 'right))))
 115
 116 (defun ztree-diff-node-equal (node1 node2)
 117   "Determines if NODE1 and NODE2 are equal."
 118   (and (string-equal (ztree-diff-node-short-name node1)
 119                      (ztree-diff-node-short-name node2))
 120        (string-equal (ztree-diff-node-left-path node1)
 121                      (ztree-diff-node-left-path node2))
 122        (string-equal (ztree-diff-node-right-path node1)
 123                      (ztree-diff-node-right-path node1))))
 124
 125 (defun ztree-diff-untrampify-filename (file)
 126   "Return FILE as the local file name."
 127   (require 'tramp)
 128   (if (not (tramp-tramp-file-p file))
 129       file
 130     (tramp-file-name-localname (tramp-dissect-file-name file))))
 131
 132 (defun ztree-diff-modef-quotify-string (x)
 133   "Surround string X with quotes."
 134   (concat "\"" x "\""))
 135
 136 (defun ztree-diff-model-files-equal (file1 file2)
 137   "Compare files FILE1 and FILE2 using external diff.
 138 Returns t if equal."
 139   (let* ((file1-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file1)))
 140          (file2-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file2)))
 141          (diff-command (concat "diff -q" " " file1-untrampified " " file2-untrampified))
 142          (diff-output (shell-command-to-string diff-command)))
 143     (not (> (length diff-output) 2))))
 144
 145 (defun ztree-directory-files (dir)
 146   "Return the list of full paths of files in a directory DIR.
 147 Filters out . and .."
 148   (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name file)))
 149                                    (not (or (string-equal simple-name ".")
 150                                             (string-equal simple-name "..")))))
 151                 (directory-files dir 'full)))
 152
 153 (defun ztree-diff-model-partial-rescan (node)
 154   "Rescan the NODE."
 155   ;; assuming what parent is always exists
 156   ;; otherwise the UI shall force the full rescan
 157   (let ((parent (ztree-diff-node-parent node))
 158         (isdir (ztree-diff-node-is-directory node))
 159         (left (ztree-diff-node-left-path node))
 160         (right (ztree-diff-node-right-path node)))
 161     ;; if node is a directory - traverse
 162     (when (and left right
 163                (file-exists-p left)
 164                (file-exists-p right))
 165       (if isdir
 166           (let ((traverse (ztree-diff-node-traverse
 167                            node
 168                            left
 169                            right)))
 170             (ztree-diff-node-set-different node (car traverse))
 171             (ztree-diff-node-set-children node (cdr traverse)))
 172         ;; node is a file
 173         (ztree-diff-node-set-different
 174          node
 175          (if (ztree-diff-model-files-equal left right)
 176              nil
 177            'diff))))))
 178
 179 (defun ztree-diff-model-subtree (parent path side)
 180   "Create a subtree with given PARENT for the given PATH.
 181 Argument SIDE either 'left or 'right side."
 182   (let ((files (ztree-directory-files path))
 183         (result nil))
 184     (dolist (file files)
 185       (if (file-directory-p file)
 186           (let* ((node (ztree-diff-node-create
 187                         parent
 188                         (when (eq side 'left) file)
 189                         (when (eq side 'right) file)
 190                         (ztree-file-short-name file)
 191                         (ztree-file-short-name file)
 192                         nil
 193                         'new))
 194                  (children (ztree-diff-model-subtree node file side)))
 195             (ztree-diff-node-set-children node children)
 196             (push node result))
 197         (push (ztree-diff-node-create
 198                parent
 199                (when (eq side 'left) file)
 200                (when (eq side 'right) file)
 201                (ztree-file-short-name file)
 202                (ztree-file-short-name file)
 203                nil
 204                'new)
 205               result)))
 206     result))
 207
 208 (defun ztree-diff-node-update-diff-from-children (node)
 209   "Set the diff status for the NODE based on its children."
 210   (let ((children (ztree-diff-node-children node))
 211         (diff nil))
 212     (dolist (child children)
 213       (unless (ztree-diff-model-ignore-p child)
 214         (setq diff
 215               (ztree-diff-model-update-diff
 216                diff
 217                (ztree-diff-node-different child)))))
 218     (ztree-diff-node-set-different node diff)))
 219
 220 (defun ztree-diff-node-update-all-parents-diff (node)
 221   "Recursively update all parents diff status for the NODE."
 222   (let ((parent node))
 223     (while (setq parent (ztree-diff-node-parent parent))
 224       (ztree-diff-node-update-diff-from-children parent))))
 225
 226
 227 (defun ztree-diff-model-update-diff (old new)
 228   "Get the diff status depending if OLD or NEW is not nil."
 229   (if new
 230       (if (or (not old)
 231               (eq old 'new))
 232           new
 233         old)
 234     old))
 235
 236 (defun ztree-diff-node-traverse (parent path1 path2)
 237   "Traverse 2 paths creating the list nodes with PARENT defined and diff status.
 238 Function traversing 2 paths PATH1 and PATH2 returning the list where the
 239 first element is the difference status (nil, 'diff, 'new') and
 240 the rest is the combined list of nodes."
 241   (let ((list1 (ztree-directory-files path1))
 242         (list2 (ztree-directory-files path2))
 243         (different-dir nil)
 244         (result nil))
 245     (ztree-diff-model-update-wait-message)
 246     ;; first - adding all entries from left directory
 247     (dolist (file1 list1)
 248       ;; for every entry in the first directory
 249       ;; we are creating the node
 250       (let* ((simple-name (ztree-file-short-name file1))
 251              (isdir (file-directory-p file1))
 252              (children nil)
 253              (different nil)
 254              ;; create the current node to be set as parent to
 255              ;; subdirectories
 256              (node (ztree-diff-node-create parent file1 nil simple-name simple-name nil nil))
 257              ;; 1. find if the file is in the second directory and the type
 258              ;;    is the same - i.e. both are directories or both are files
 259              (file2 (ztree-find list2
 260                                 #'(lambda (x) (and (string-equal (ztree-file-short-name x)
 261                                                                  simple-name)
 262                                                    (eq isdir (file-directory-p x)))))))
 263         ;; 2. if it is not in the second directory, add it as a node
 264         (if (not file2)
 265             (progn
 266               ;; 2.1 if it is a directory, add the whole subtree
 267               (when (file-directory-p file1)
 268                 (setq children (ztree-diff-model-subtree node file1 'left)))
 269               ;; 2.2 update the difference status for this entry
 270               (setq different 'new))
 271           ;; 3. if it is found in second directory and of the same type
 272           ;; 3.1 if it is a file
 273           (if (not (file-directory-p file1))
 274               ;; 3.1.1 set difference status to this entry
 275               (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
 276             ;; 3.2 if it is the directory
 277             ;; 3.2.1 get the result of the directories comparison together with status
 278             (let ((traverse (ztree-diff-node-traverse node file1 file2)))
 279               ;; 3.2.2 update the difference status for whole comparison from
 280               ;;       difference result from the 2 subdirectories comparison
 281               (setq different (car traverse))
 282               ;; 3.2.3 set the children list from the 2 subdirectories comparison
 283               (setq children (cdr traverse)))))
 284         ;; update calculated parameters of the node
 285         (ztree-diff-node-set-right-path node file2)
 286         (ztree-diff-node-set-children node children)
 287         (ztree-diff-node-set-different node different)
 288         ;; 2.3 update difference status for the whole comparison
 289         ;; depending if the node should participate in overall result
 290         (unless (ztree-diff-model-ignore-p node)
 291           (setq different-dir (ztree-diff-model-update-diff different-dir different)))
 292         ;; push the created node to the result list
 293         (push node result)))
 294     ;; second - adding entries from the right directory which are not present
 295     ;; in the left directory
 296     (dolist (file2 list2)
 297       ;; for every entry in the second directory
 298       ;; we are creating the node
 299       (let* ((simple-name (ztree-file-short-name file2))
 300              (isdir (file-directory-p file2))
 301              (children nil)
 302              ;; create the node to be added to the results list
 303              (node (ztree-diff-node-create parent nil file2 simple-name simple-name nil 'new))
 304              ;; 1. find if the file is in the first directory and the type
 305              ;;    is the same - i.e. both are directories or both are files
 306              (file1 (ztree-find list1
 307                                 #'(lambda (x) (and (string-equal (ztree-file-short-name x)
 308                                                                  simple-name)
 309                                                    (eq isdir (file-directory-p x)))))))
 310         ;; if it is not in the first directory, add it as a node
 311         (unless file1
 312           ;; if it is a directory, set the whole subtree to children
 313           (when (file-directory-p file2)
 314             (setq children (ztree-diff-model-subtree node file2 'right)))
 315           ;; set calculated children to the node
 316           (ztree-diff-node-set-children node children)
 317           ;; update the different status for the whole comparison
 318           ;; depending if the node should participate in overall result
 319           (unless (ztree-diff-model-ignore-p node)
 320             (setq different-dir (ztree-diff-model-update-diff different-dir 'new)))
 321           ;; push the created node to the result list
 322           (push node result))))
 323     ;; result is a pair: difference status and nodes list
 324     (cons different-dir result)))
 325
 326 (defun ztree-diff-model-create (dir1 dir2 &optional ignore-p)
 327   "Create a node based on DIR1 and DIR2.
 328 IGNORE-P is the optional filtering function, taking node as
 329 an argument, which determines if the node should be excluded
 330 from comparison."
 331   (unless (file-directory-p dir1)
 332     (error "Path %s is not a directory" dir1))
 333   (unless (file-directory-p dir2)
 334     (error "Path %s is not a directory" dir2))
 335   (setf ztree-diff-model-ignore-fun ignore-p)
 336   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
 337   (let* ((model
 338           (ztree-diff-node-create nil dir1 dir2
 339                                   (ztree-file-short-name dir1)
 340                                   (ztree-file-short-name dir2)
 341                                   nil
 342                                   nil))
 343          (traverse (ztree-diff-node-traverse model dir1 dir2)))
 344     (ztree-diff-node-set-children model (cdr traverse))
 345     (ztree-diff-node-set-different model (car traverse))
 346     (message "Done.")
 347     model))
 348
 349 (defun ztree-diff-model-update-node (node)
 350   "Refresh the NODE."
 351   (setq ztree-diff-model-wait-message
 352         (concat "Updating " (ztree-diff-node-short-name node) " ..."))
 353   (let ((traverse (ztree-diff-node-traverse node
 354                                             (ztree-diff-node-left-path node)
 355                                             (ztree-diff-node-right-path node))))
 356     (ztree-diff-node-set-children node (cdr traverse))
 357     (ztree-diff-node-set-different node (car traverse))
 358     (message "Done.")))
 359
 360
 361
 362 (provide 'ztree-diff-model)
 363
 364 ;;; ztree-diff-model.el ends here