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

   1 ;; Diff model
   2
   3 (require 'ztree-util)
   4
   5 ;; different = {nil, 'new, 'diff}
   6 (defun ztree-diff-model-create-node (left-full-path right-full-path short-name children different)
   7   (let (node)
   8     (setq node (plist-put node 'left left-full-path))
   9     (setq node (plist-put node 'right right-full-path))
  10     (setq node (plist-put node 'short short-name))
  11     (setq node (plist-put node 'children children))
  12     (setq node (plist-put node 'different different))))
  13
  14 (defun ztree-diff-model-get-left-path (node)
  15   (plist-get node 'left))
  16
  17 (defun ztree-diff-model-get-right-path (node)
  18   (plist-get node 'right))
  19
  20 (defun ztree-diff-model-short-name (node)
  21     (plist-get node 'short))
  22
  23 (defun ztree-diff-model-children (node)
  24     (plist-get node 'children))
  25
  26 (defun ztree-diff-model-differet (node)
  27     (plist-get node 'different))
  28
  29 (defun ztree-diff-model-is-directory (node)
  30   (let ((left  (plist-get node 'left))
  31         (right (plist-get node 'right)))
  32     (if left
  33         (file-directory-p left)
  34       (file-directory-p right))))
  35
  36 (defun ztree-diff-model-side (node)
  37   (let ((left  (plist-get node 'left))
  38         (right (plist-get node 'right)))
  39   (if (and left right) 'both
  40     (if left 'left 'right))))
  41
  42 (defun ztree-diff-model-files-equal (file1 file2)
  43   "Compare files using external diff. Returns t if equal"
  44   (let ((diff-output (shell-command-to-string (concat "diff -q" " " file1 " " file2))))
  45     (not (> (length diff-output) 2))))
  46
  47
  48 (defun ztree-directory-files (dir)
  49   "Returns the list of full paths of files in a directory, filtering out . and .."
  50   (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file)))
  51                                    (not (or (string-equal simple-name ".")
  52                                             (string-equal simple-name "..")))))
  53                 (directory-files dir 'full)))
  54
  55 (defun ztree-diff-model-subtree (path side)
  56   "Creates a subtree for the given path for either 'left or 'right sides"
  57   (let ((files (ztree-directory-files path))
  58         (result nil))
  59     (dolist (file files)
  60       (if (file-directory-p file)
  61           (push (ztree-diff-model-create-node
  62                  (when (eq side 'left) file)
  63                  (when (eq side 'right) file)
  64                  (file-short-name file)
  65                  (ztree-diff-model-subtree file side)
  66                  'new)
  67                 result)
  68         (push (ztree-diff-model-create-node
  69                (when (eq side 'left) file)
  70                (when (eq side 'right) file)
  71                (file-short-name file)
  72                nil
  73                'new)
  74               result)))
  75     result))
  76
  77
  78 (defun ztree-diff-model-update-diff (old new)
  79   (if new
  80       (if (or (not old)
  81               (eq old 'new))
  82           new
  83         old)
  84     old))
  85
  86 (defun ztree-diff-model-traverse (path1 path2)
  87   "Function traversing 2 paths returning the list where the
  88 first element is the difference status (nil, 'diff, 'new') and
  89 the rest is the combined list of nodes"
  90   (let ((list1 (ztree-directory-files path1))
  91         (list2 (ztree-directory-files path2))
  92         (different-dir nil)
  93         (result nil))
  94     ;; first - adding all entries from left directory
  95     (dolist (file1 list1)
  96       ;; for every entry in the first directory
  97       ;; we are creating the node
  98       (let* ((simple-name (file-short-name file1))
  99              (isdir (file-directory-p file1))
 100              (children nil)
 101              (different nil)
 102              ;; 1. find if the file is in the second directory and the type
 103              ;;    is the same - i.e. both are directories or both are files
 104              (file2 (ztree-find list2
 105                                 #'(lambda (x) (and (string-equal (file-short-name x)
 106                                                                  simple-name)
 107                                                    (eq isdir (file-directory-p x)))))))
 108         ;; 2. if it is not in the second directory, add it as a node
 109         (if (not file2)
 110             (progn
 111               ;; 2.1 if it is a directory, add the whole subtree
 112               (when (file-directory-p file1)
 113                 (setq children (ztree-diff-model-subtree file1 'left)))
 114               ;; 2.2 update the difference status for this entry
 115               (setq different 'new))
 116           ;; 3. if it is found in second directory and of the same type
 117           ;; 3.1 if it is a file
 118           (if (not (file-directory-p file1))
 119               ;; 3.1.1 set difference status to this entry
 120               (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
 121             ;; 3.2 if it is the directory
 122             ;; 3.2.1 get the result of the directories comparison together with status
 123             (let ((traverse (ztree-diff-model-traverse file1 file2)))
 124               ;; 3.2.2 update the difference status for whole comparison from
 125               ;;       difference result from the 2 subdirectories comparison
 126               (setq different (car traverse))
 127               ;; 3.2.3 set the children list from the 2 subdirectories comparison
 128               (setq children (cdr traverse)))))
 129         ;; 2.3 update difference status for the whole comparison
 130         (setq different-dir (ztree-diff-model-update-diff different-dir different))
 131         ;; push the created node to the result list
 132         (push (ztree-diff-model-create-node file1 file2 simple-name children different)
 133                 result)))
 134     ;; second - adding entries from the right directory which are not present
 135     ;; in the left directory
 136     (dolist (file2 list2)
 137       ;; for every entry in the second directory
 138       ;; we are creating the node
 139       (let* ((simple-name (file-short-name file2))
 140              (isdir (file-directory-p file2))
 141              (children nil)
 142              ;; 1. find if the file is in the first directory and the type
 143              ;;    is the same - i.e. both are directories or both are files
 144              (file1 (ztree-find list1
 145                                 #'(lambda (x) (and (string-equal (file-short-name x)
 146                                                                  simple-name)
 147                                                    (eq isdir (file-directory-p x)))))))
 148         ;; if it is not in the first directory, add it as a node
 149         (when (not file1)
 150           ;; if it is a directory, set the whole subtree to children
 151           (when (file-directory-p file2)
 152             (setq children (ztree-diff-model-subtree file2 'right)))
 153           ;; update the different status for the whole comparison
 154           (setq different-dir (ztree-diff-model-update-diff different-dir 'new))
 155           ;; push the created node to the result list
 156           (push (ztree-diff-model-create-node file1 file2 simple-name children 'new)
 157                 result))))
 158     (cons different-dir result)))
 159
 160 (defun ztree-diff-model-create (dir1 dir2)
 161   (when (not (file-directory-p dir1))
 162     (error "Path %s is not a directory" dir1))
 163   (when (not (file-directory-p dir2))
 164     (error "Path %s is not a directory" dir2))
 165   (let ((traverse (ztree-diff-model-traverse dir1 dir2)))
 166     (ztree-diff-model-create-node dir1 dir2
 167                                   (concat (file-short-name dir1)
 168                                           " <--> "
 169                                           (file-short-name dir2))
 170                                   (cdr traverse)
 171                                   (car traverse))))
 172
 173
 174 (provide 'ztree-diff-model)
 175
 176
 177
 178