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   ;; FIXME: We shouldn't use internal Tramp functions.
 128   (require 'tramp)
 129   (if (not (tramp-tramp-file-p file))
 130       file
 131     (tramp-file-name-localname (tramp-dissect-file-name file))))
 132
 133 (defun ztree-diff-modef-quotify-string (x)
 134   "Surround string X with quotes."
 135   (concat "\"" x "\""))
 136
 137 (defun ztree-diff-model-files-equal (file1 file2)
 138   "Compare files FILE1 and FILE2 using external diff.
 139 Returns t if equal."
 140   ;; FIXME: This "untrampification" only works if both file1 and file2 are on
 141   ;; the same host.
 142   ;; FIXME: We assume that default-directory is also on the same host as
 143   ;; file(1|2).
 144   (let* ((file1-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file1)))
 145          (file2-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file2)))
 146          (diff-command (concat "diff -q" " " file1-untrampified " " file2-untrampified))
 147          (diff-output (shell-command-to-string diff-command)))
 148     (not (> (length diff-output) 2))))
 149
 150 (defun ztree-directory-files (dir)
 151   "Return the list of full paths of files in a directory DIR.
 152 Filters out . and .."
 153   (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name file)))
 154                                    (not (or (string-equal simple-name ".")
 155                                             (string-equal simple-name "..")))))
 156                 (directory-files dir 'full)))
 157
 158 (defun ztree-diff-model-partial-rescan (node)
 159   "Rescan the NODE."
 160   ;; assuming what parent is always exists
 161   ;; otherwise the UI shall force the full rescan
 162   (let ((isdir (ztree-diff-node-is-directory node))
 163         (left (ztree-diff-node-left-path node))
 164         (right (ztree-diff-node-right-path node)))
 165     ;; if node is a directory - traverse
 166     (when (and left right
 167                (file-exists-p left)
 168                (file-exists-p right))
 169       (if isdir
 170           (let ((traverse (ztree-diff-node-traverse
 171                            node
 172                            left
 173                            right)))
 174             (ztree-diff-node-set-different node (car traverse))
 175             (ztree-diff-node-set-children node (cdr traverse)))
 176         ;; node is a file
 177         (ztree-diff-node-set-different
 178          node
 179          (if (ztree-diff-model-files-equal left right)
 180              nil
 181            'diff))))))
 182
 183 (defun ztree-diff-model-subtree (parent path side)
 184   "Create a subtree with given PARENT for the given PATH.
 185 Argument SIDE either 'left or 'right side."
 186   (let ((files (ztree-directory-files path))
 187         (result nil))
 188     (dolist (file files)
 189       (if (file-directory-p file)
 190           (let* ((node (ztree-diff-node-create
 191                         parent
 192                         (when (eq side 'left) file)
 193                         (when (eq side 'right) file)
 194                         (ztree-file-short-name file)
 195                         (ztree-file-short-name file)
 196                         nil
 197                         'new))
 198                  (children (ztree-diff-model-subtree node file side)))
 199             (ztree-diff-node-set-children node children)
 200             (push node result))
 201         (push (ztree-diff-node-create
 202                parent
 203                (when (eq side 'left) file)
 204                (when (eq side 'right) file)
 205                (ztree-file-short-name file)
 206                (ztree-file-short-name file)
 207                nil
 208                'new)
 209               result)))
 210     result))
 211
 212 (defun ztree-diff-node-update-diff-from-children (node)
 213   "Set the diff status for the NODE based on its children."
 214   (let ((children (ztree-diff-node-children node))
 215         (diff nil))
 216     (dolist (child children)
 217       (unless (ztree-diff-model-ignore-p child)
 218         (setq diff
 219               (ztree-diff-model-update-diff
 220                diff
 221                (ztree-diff-node-different child)))))
 222     (ztree-diff-node-set-different node diff)))
 223
 224 (defun ztree-diff-node-update-all-parents-diff (node)
 225   "Recursively update all parents diff status for the NODE."
 226   (let ((parent node))
 227     (while (setq parent (ztree-diff-node-parent parent))
 228       (ztree-diff-node-update-diff-from-children parent))))
 229
 230
 231 (defun ztree-diff-model-update-diff (old new)
 232   "Get the diff status depending if OLD or NEW is not nil."
 233   (if new
 234       (if (or (not old)
 235               (eq old 'new))
 236           new
 237         old)
 238     old))
 239
 240 (defun ztree-diff-node-traverse (parent path1 path2)
 241   "Traverse 2 paths creating the list nodes with PARENT defined and diff status.
 242 Function traversing 2 paths PATH1 and PATH2 returning the list where the
 243 first element is the difference status (nil, 'diff, 'new') and
 244 the rest is the combined list of nodes."
 245   (let ((list1 (ztree-directory-files path1))
 246         (list2 (ztree-directory-files path2))
 247         (different-dir nil)
 248         (result nil))
 249     (ztree-diff-model-update-wait-message)
 250     ;; first - adding all entries from left directory
 251     (dolist (file1 list1)
 252       ;; for every entry in the first directory
 253       ;; we are creating the node
 254       (let* ((simple-name (ztree-file-short-name file1))
 255              (isdir (file-directory-p file1))
 256              (children nil)
 257              (different nil)
 258              ;; create the current node to be set as parent to
 259              ;; subdirectories
 260              (node (ztree-diff-node-create parent file1 nil simple-name simple-name nil nil))
 261              ;; 1. find if the file is in the second directory and the type
 262              ;;    is the same - i.e. both are directories or both are files
 263              (file2 (ztree-find list2
 264                                 #'(lambda (x) (and (string-equal (ztree-file-short-name x)
 265                                                                  simple-name)
 266                                                    (eq isdir (file-directory-p x)))))))
 267         ;; 2. if it is not in the second directory, add it as a node
 268         (if (not file2)
 269             (progn
 270               ;; 2.1 if it is a directory, add the whole subtree
 271               (when (file-directory-p file1)
 272                 (setq children (ztree-diff-model-subtree node file1 'left)))
 273               ;; 2.2 update the difference status for this entry
 274               (setq different 'new))
 275           ;; 3. if it is found in second directory and of the same type
 276           ;; 3.1 if it is a file
 277           (if (not (file-directory-p file1))
 278               ;; 3.1.1 set difference status to this entry
 279               (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
 280             ;; 3.2 if it is the directory
 281             ;; 3.2.1 get the result of the directories comparison together with status
 282             (let ((traverse (ztree-diff-node-traverse node file1 file2)))
 283               ;; 3.2.2 update the difference status for whole comparison from
 284               ;;       difference result from the 2 subdirectories comparison
 285               (setq different (car traverse))
 286               ;; 3.2.3 set the children list from the 2 subdirectories comparison
 287               (setq children (cdr traverse)))))
 288         ;; update calculated parameters of the node
 289         (ztree-diff-node-set-right-path node file2)
 290         (ztree-diff-node-set-children node children)
 291         (ztree-diff-node-set-different node different)
 292         ;; 2.3 update difference status for the whole comparison
 293         ;; depending if the node should participate in overall result
 294         (unless (ztree-diff-model-ignore-p node)
 295           (setq different-dir (ztree-diff-model-update-diff different-dir different)))
 296         ;; push the created node to the result list
 297         (push node result)))
 298     ;; second - adding entries from the right directory which are not present
 299     ;; in the left directory
 300     (dolist (file2 list2)
 301       ;; for every entry in the second directory
 302       ;; we are creating the node
 303       (let* ((simple-name (ztree-file-short-name file2))
 304              (isdir (file-directory-p file2))
 305              (children nil)
 306              ;; create the node to be added to the results list
 307              (node (ztree-diff-node-create parent nil file2 simple-name simple-name nil 'new))
 308              ;; 1. find if the file is in the first directory and the type
 309              ;;    is the same - i.e. both are directories or both are files
 310              (file1 (ztree-find list1
 311                                 #'(lambda (x) (and (string-equal (ztree-file-short-name x)
 312                                                                  simple-name)
 313                                                    (eq isdir (file-directory-p x)))))))
 314         ;; if it is not in the first directory, add it as a node
 315         (unless file1
 316           ;; if it is a directory, set the whole subtree to children
 317           (when (file-directory-p file2)
 318             (setq children (ztree-diff-model-subtree node file2 'right)))
 319           ;; set calculated children to the node
 320           (ztree-diff-node-set-children node children)
 321           ;; update the different status for the whole comparison
 322           ;; depending if the node should participate in overall result
 323           (unless (ztree-diff-model-ignore-p node)
 324             (setq different-dir (ztree-diff-model-update-diff different-dir 'new)))
 325           ;; push the created node to the result list
 326           (push node result))))
 327     ;; result is a pair: difference status and nodes list
 328     (cons different-dir result)))
 329
 330 (defun ztree-diff-model-create (dir1 dir2 &optional ignore-p)
 331   "Create a node based on DIR1 and DIR2.
 332 IGNORE-P is the optional filtering function, taking node as
 333 an argument, which determines if the node should be excluded
 334 from comparison."
 335   (unless (file-directory-p dir1)
 336     (error "Path %s is not a directory" dir1))
 337   (unless (file-directory-p dir2)
 338     (error "Path %s is not a directory" dir2))
 339   (setf ztree-diff-model-ignore-fun ignore-p)
 340   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
 341   (let* ((model
 342           (ztree-diff-node-create nil dir1 dir2
 343                                   (ztree-file-short-name dir1)
 344                                   (ztree-file-short-name dir2)
 345                                   nil
 346                                   nil))
 347          (traverse (ztree-diff-node-traverse model dir1 dir2)))
 348     (ztree-diff-node-set-children model (cdr traverse))
 349     (ztree-diff-node-set-different model (car traverse))
 350     (message "Done.")
 351     model))
 352
 353 (defun ztree-diff-model-update-node (node)
 354   "Refresh the NODE."
 355   (setq ztree-diff-model-wait-message
 356         (concat "Updating " (ztree-diff-node-short-name node) " ..."))
 357   (let ((traverse (ztree-diff-node-traverse node
 358                                             (ztree-diff-node-left-path node)
 359                                             (ztree-diff-node-right-path node))))
 360     (ztree-diff-node-set-children node (cdr traverse))
 361     (ztree-diff-node-set-different node (car traverse))
 362     (message "Done.")))
 363
 364
 365
 366 (provide 'ztree-diff-model)
 367
 368 ;;; ztree-diff-model.el ends here