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

   1 ;;; ztree-diff.el --- Text mode diff 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 ;;; Code:
  30 (require 'ztree-view)
  31 (require 'ztree-diff-model)
  32
  33 (defconst ztree-diff-hidden-files-regexp "^\\."
  34   "Hidden files regexp.
  35 By default all filest starting with dot '.', including . and ..")
  36
  37 (defface ztreep-diff-header-face
  38   '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
  39     (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
  40     (t :height 1.2 :foreground "darkblue" :weight bold))
  41   "*Face used for the header in Ztree Diff buffer."
  42   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  43 (defvar ztreep-diff-header-face 'ztreep-diff-header-face)
  44
  45 (defface ztreep-diff-header-small-face
  46   '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
  47     (((background dark)) (:foreground "lightblue" :weight bold))
  48     (t :weight bold :foreground "darkblue"))
  49   "*Face used for the header in Ztree Diff buffer."
  50   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  51 (defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face)
  52
  53 (defface ztreep-diff-model-diff-face
  54   '((t                   (:foreground "red")))
  55   "*Face used for different files in Ztree-diff."
  56   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  57 (defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face)
  58
  59 (defface ztreep-diff-model-add-face
  60   '((t                   (:foreground "blue")))
  61   "*Face used for added files in Ztree-diff."
  62   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  63 (defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face)
  64
  65 (defface ztreep-diff-model-normal-face
  66   '((t                   (:foreground "#7f7f7f")))
  67   "*Face used for non-modified files in Ztree-diff."
  68   :group 'Ztree-diff :group 'font-lock-highlighting-faces)
  69 (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face)
  70
  71
  72 (defvar ztree-diff-filter-list (list ztree-diff-hidden-files-regexp)
  73   "List of regexp file names to filter out.
  74 By default paths starting with dot (like .git) are ignored")
  75 (make-variable-buffer-local 'ztree-diff-filter-list)
  76
  77 (defvar ztree-diff-dirs-pair nil
  78   "Pair of the directories stored.  Used to perform the full rescan.")
  79 (make-variable-buffer-local 'ztree-diff-dirs-pair)
  80
  81 (defvar ztree-diff-show-equal-files t
  82   "Show or not equal files/directories on both sides.")
  83 (make-variable-buffer-local 'ztree-diff-show-equal-files)
  84
  85 ;;;###autoload
  86 (define-minor-mode ztreediff-mode
  87   "A minor mode for displaying the difference of the directory trees in text mode."
  88   ;; initial value
  89   nil
  90   ;; modeline name
  91   " Diff"
  92   ;; The minor mode keymap
  93   `(
  94     (,(kbd "C") . ztree-diff-copy)
  95     (,(kbd "h") . ztree-diff-toggle-show-equal-files)
  96     (,(kbd "D") . ztree-diff-delete-file)
  97     (,(kbd "v") . ztree-diff-view-file)
  98     (,(kbd "d") . ztree-diff-simple-diff-files)
  99     (,(kbd "r") . ztree-diff-partial-rescan)
 100     ([f5] . ztree-diff-full-rescan)))
 101
 102
 103 (defun ztree-diff-node-face (node)
 104   "Return the face for the NODE depending on diff status."
 105   (let ((diff (ztree-diff-node-different node)))
 106     (cond ((eq diff 'diff) ztreep-diff-model-diff-face)
 107           ((eq diff 'new)  ztreep-diff-model-add-face)
 108           (t ztreep-diff-model-normal-face))))
 109
 110 (defun ztree-diff-insert-buffer-header ()
 111   "Insert the header to the ztree buffer."
 112   (insert-with-face "Differences tree" ztreep-diff-header-face)
 113   (newline-and-begin)
 114   (when ztree-diff-dirs-pair
 115     (insert-with-face (concat "Left:  " (car ztree-diff-dirs-pair))
 116                       ztreep-diff-header-small-face)
 117     (newline-and-begin)
 118     (insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair))
 119                       ztreep-diff-header-small-face)
 120     (newline-and-begin))
 121   (insert-with-face "Legend:" ztreep-diff-header-small-face)
 122   (newline-and-begin)
 123   (insert-with-face " Normal file " ztreep-diff-model-normal-face)
 124   (insert-with-face "- same on both sides" ztreep-diff-header-small-face)
 125   (newline-and-begin)
 126   (insert-with-face " Orphan file " ztreep-diff-model-add-face)
 127   (insert-with-face "- does not exist on other side" ztreep-diff-header-small-face)
 128   (newline-and-begin)
 129   (insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
 130   (insert-with-face "- different from other side" ztreep-diff-header-small-face)
 131   (newline-and-begin)
 132   (insert-with-face "==============" ztreep-diff-header-face)
 133   (newline-and-begin))
 134
 135 (defun ztree-diff-full-rescan ()
 136   "Force full rescan of the directory trees."
 137   (interactive)
 138   (when (and ztree-diff-dirs-pair
 139              (yes-or-no-p (format "Force full rescan?")))
 140     (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))))
 141
 142
 143
 144 (defun ztree-diff-existing-common (node)
 145   "Return the NODE if both left and right sides exist."
 146   (let ((left (ztree-diff-node-left-path node))
 147         (right (ztree-diff-node-right-path node)))
 148     (if (and left right
 149              (file-exists-p left)
 150              (file-exists-p right))
 151         node
 152       nil)))
 153
 154 (defun ztree-diff-existing-common-parent (node)
 155   "Return the first node in up in hierarchy of the NODE which has both sides."
 156   (let ((common (ztree-diff-existing-common node)))
 157     (if common
 158         common
 159       (ztree-diff-existing-common-parent (ztree-diff-node-parent node)))))
 160
 161 (defun ztree-diff-do-partial-rescan (node)
 162   "Partly rescan the NODE."
 163   (let* ((common (ztree-diff-existing-common-parent node))
 164          (parent (ztree-diff-node-parent common)))
 165     (if (not parent)
 166         (when ztree-diff-dirs-pair
 167           (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))
 168       (progn
 169         (ztree-diff-model-partial-rescan common)
 170         (ztree-diff-node-update-all-parents-diff node)
 171         (ztree-refresh-buffer (line-number-at-pos))))))
 172
 173
 174 (defun ztree-diff-partial-rescan ()
 175   "Perform partial rescan on the current node."
 176   (interactive)
 177   (let ((found (ztree-find-node-at-point)))
 178     (when found
 179       (ztree-diff-do-partial-rescan (car found)))))
 180
 181
 182 (defun ztree-diff-simple-diff (node)
 183   "Create a simple diff buffer for files from left and right panels.
 184 Argument NODE node containing paths to files to call a diff on."
 185   (let* ((node-left (ztree-diff-node-left-path node))
 186          (node-right (ztree-diff-node-right-path node)))
 187     (when (and
 188            node-left
 189            node-right
 190            (not (file-directory-p node-left)))
 191       ;; show the diff window on the bottom
 192       ;; to not to crush tree appearance
 193       (let ((split-width-threshold nil))
 194         (diff node-left node-right)))))
 195
 196
 197 (defun ztree-diff-simple-diff-files ()
 198   "Create a simple diff buffer for files from left and right panels."
 199   (interactive)
 200   (let ((found (ztree-find-node-at-point)))
 201     (when found
 202       (let ((node (car found)))
 203         (ztree-diff-simple-diff node)))))
 204
 205 (defun ztree-diff-node-action (node hard)
 206   "Perform action on NODE:
 207 1 if both left and right sides present:
 208    1.1 if they are differend
 209       1.1.1 if HARD ediff
 210       1.1.2 simple diff otherwiste
 211    1.2 if they are the same - view left
 212 2 if left or right present - view left or rigth"
 213   (let ((left (ztree-diff-node-left-path node))
 214         (right (ztree-diff-node-right-path node))
 215         (open-f '(lambda (path) (if hard (find-file path)
 216                                   (let ((split-width-threshold nil))
 217                                     (view-file-other-window path))))))
 218     (cond ((and left right)
 219            (if (not (ztree-diff-node-different node))
 220                (funcall open-f left)
 221              (if hard
 222                  (ediff left right)
 223                (ztree-diff-simple-diff node))))
 224           (left (funcall open-f left))
 225           (right (funcall open-f right))
 226           (t nil))))
 227
 228
 229
 230 (defun ztree-diff-copy-file (node source-path destination-path copy-to-right)
 231   "Update the NODE status and copy the file.
 232 File copied from SOURCE-PATH to DESTINATION-PATH.
 233 COPY-TO-RIGHT specifies which side of the NODE to update."
 234   (let ((target-path (concat
 235                       (file-name-as-directory destination-path)
 236                       (file-name-nondirectory
 237                        (directory-file-name source-path)))))
 238     (let ((err (condition-case error-trap
 239                    (progn
 240                      ;; don't ask for overwrite
 241                      ;; keep time stamp
 242                      (copy-file source-path target-path t t)
 243                      nil)
 244                  (error error-trap))))
 245       ;; error message if failed
 246       (if err (message (concat "Error: " (nth 2 err)))
 247         (progn              ; otherwise:
 248           ;; assuming all went ok when left and right nodes are the same
 249           ;; set both as not different
 250           (ztree-diff-node-set-different node nil)
 251           ;; update left/right paths
 252           (if copy-to-right
 253               (ztree-diff-node-set-right-path node target-path)
 254             (ztree-diff-node-set-left-path node target-path))
 255           (ztree-diff-node-update-all-parents-diff node)
 256           (ztree-refresh-buffer (line-number-at-pos)))))))
 257
 258
 259 (defun ztree-diff-copy-dir (node source-path destination-path copy-to-right)
 260     "Update the NODE status and copy the directory.
 261 Directory copied from SOURCE-PATH to DESTINATION-PATH.
 262 COPY-TO-RIGHT specifies which side of the NODE to update."
 263   (let* ((src-path (file-name-as-directory source-path))
 264          (target-path (file-name-as-directory destination-path))
 265          (target-full-path (concat
 266                             target-path
 267                             (file-name-nondirectory
 268                              (directory-file-name source-path)))))
 269     (let ((err (condition-case error-trap
 270                    (progn
 271                      ;; keep time stamp
 272                      ;; ask for overwrite
 273                      (copy-directory src-path target-path t t)
 274                      nil)
 275                  (error error-trap))))
 276       ;; error message if failed
 277       (if err (message (concat "Error: " (nth 1 err)))
 278         (progn
 279           (message target-full-path)
 280           (if copy-to-right
 281               (ztree-diff-node-set-right-path node
 282                                               target-full-path)
 283             (ztree-diff-node-set-left-path node
 284                                            target-full-path))
 285           (ztree-diff-model-update-node node)
 286           (ztree-diff-node-update-all-parents-diff node)
 287           (ztree-refresh-buffer (line-number-at-pos)))))))
 288
 289
 290 (defun ztree-diff-copy ()
 291   "Copy the file under the cursor to other side."
 292   (interactive)
 293   (let ((found (ztree-find-node-at-point)))
 294     (when found
 295       (let* ((node (car found))
 296              (side (cdr found))
 297              (node-side (ztree-diff-node-side node))
 298              (copy-to-right t)           ; copy from left to right
 299              (node-left (ztree-diff-node-left-path node))
 300              (node-right (ztree-diff-node-right-path node))
 301              (source-path nil)
 302              (destination-path nil)
 303              (parent (ztree-diff-node-parent node)))
 304         (when parent                ; do not copy the root node
 305           ;; determine a side to copy from/to
 306           ;; algorithm:
 307           ;; 1) if both side are present, use the side
 308           ;;    variable
 309           (setq copy-to-right (if (eq node-side 'both)
 310                                   (eq side 'left)
 311                                 ;; 2) if one of sides is absent, copy from
 312                                 ;;    the side where the file is present
 313                                 (eq node-side 'left)))
 314           ;; 3) in both cases determine if the destination
 315           ;;    directory is in place
 316           (setq source-path (if copy-to-right node-left node-right)
 317                 destination-path (if copy-to-right
 318                                      (ztree-diff-node-right-path parent)
 319                                    (ztree-diff-node-left-path parent)))
 320           (when (and source-path destination-path
 321                      (yes-or-no-p (format "Copy [%s]%s to [%s]%s/ ?"
 322                                           (if copy-to-right "LEFT" "RIGHT")
 323                                           (ztree-diff-node-short-name node)
 324                                           (if copy-to-right "RIGHT" "LEFT")
 325                                           destination-path)))
 326             (if (file-directory-p source-path)
 327                 (ztree-diff-copy-dir node
 328                                      source-path
 329                                      destination-path
 330                                      copy-to-right)
 331               (ztree-diff-copy-file node
 332                                     source-path
 333                                     destination-path
 334                                     copy-to-right))))))))
 335
 336 (defun ztree-diff-view-file ()
 337   "View file at point, depending on side."
 338   (interactive)
 339   (let ((found (ztree-find-node-at-point)))
 340     (when found
 341       (let* ((node (car found))
 342              (side (cdr found))
 343              (node-side (ztree-diff-node-side node))
 344              (node-left (ztree-diff-node-left-path node))
 345              (node-right (ztree-diff-node-right-path node)))
 346         (when (or (eq node-side 'both)
 347                   (eq side node-side))
 348           (cond ((and (eq side 'left)
 349                       node-left)
 350                  (view-file node-left))
 351                 ((and (eq side 'right)
 352                       node-right)
 353                  (view-file node-right))))))))
 354
 355
 356 (defun ztree-diff-delete-file ()
 357   "Delete the file under the cursor."
 358   (interactive)
 359   (let ((found (ztree-find-node-at-point)))
 360     (when found
 361       (let* ((node (car found))
 362              (side (cdr found))
 363              (node-side (ztree-diff-node-side node))
 364              (delete-from-left t)
 365              (remove-path nil)
 366              (parent (ztree-diff-node-parent node)))
 367         (when parent                    ; do not delete the root node
 368           ;; algorithm for determining what to delete similar to copy:
 369           ;; 1. if the file is present on both sides, delete
 370           ;;    from the side currently selected
 371           (setq delete-from-left (if (eq node-side 'both)
 372                                      (eq side 'left)
 373                                    ;; 2) if one of sides is absent, delete
 374                                    ;; from the side where the file is present
 375                                    (eq node-side 'left)))
 376           (setq remove-path (if delete-from-left
 377                                 (ztree-diff-node-left-path node)
 378                               (ztree-diff-node-right-path node)))
 379           (when (yes-or-no-p (format "Delete the file [%s]%s ?"
 380                                      (if delete-from-left "LEFT" "RIGHT")
 381                                      remove-path))
 382             (let* ((delete-command
 383                     (if (file-directory-p remove-path)
 384                         '(delete-directory remove-path t)
 385                       '(delete-file remove-path t)))
 386                    (children (ztree-diff-node-children parent))
 387                    (err
 388                     (condition-case error-trap
 389                         (progn
 390                           (eval delete-command)
 391                           nil)
 392                       (error error-trap))))
 393               (if err (message (concat "Error: " (nth 2 err)))
 394                 (progn
 395                   (setq children (ztree-filter
 396                                   #'(lambda (x) (not (ztree-diff-node-equal x node)))
 397                                   children))
 398                   (ztree-diff-node-set-children parent children))
 399                 (ztree-diff-node-update-all-parents-diff node)
 400                 (ztree-refresh-buffer (line-number-at-pos))))))))))
 401
 402
 403
 404 (defun ztree-node-is-in-filter-list (node)
 405   "Determine if the NODE is in filter list.
 406 If the node is in the filter list it shall not be visible"
 407   (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx node))))
 408
 409
 410 (defun ztree-node-is-visible (node)
 411   "Determine if the NODE should be visible."
 412   (and (ztree-diff-node-parent node)    ; parent is always visible
 413        (not (ztree-node-is-in-filter-list (ztree-diff-node-short-name node)))
 414        (or ztree-diff-show-equal-files
 415            (ztree-diff-node-different node))))
 416
 417 (defun ztree-diff-toggle-show-equal-files ()
 418   "Toggle visibility of the equal files."
 419   (interactive)
 420   (setq ztree-diff-show-equal-files (not ztree-diff-show-equal-files))
 421   (ztree-refresh-buffer))
 422
 423 ;;;###autoload
 424 (defun ztree-diff (dir1 dir2)
 425   "Create an interactive buffer with the directory tree of the path given.
 426 Argument DIR1 left directory.
 427 Argument DIR2 right directory."
 428   (interactive "DLeft directory \nDRight directory ")
 429   (let* ((difference (ztree-diff-model-create dir1 dir2))
 430          (buf-name (concat "*"
 431                            (ztree-diff-node-short-name difference)
 432                            " <--> "
 433                            (ztree-diff-node-right-short-name difference)
 434                            "*")))
 435     (ztree-view buf-name
 436                 difference
 437                 'ztree-node-is-visible
 438                 'ztree-diff-insert-buffer-header
 439                 'ztree-diff-node-short-name-wrapper
 440                 'ztree-diff-node-is-directory
 441                 'ztree-diff-node-equal
 442                 'ztree-diff-node-children
 443                 'ztree-diff-node-face
 444                 'ztree-diff-node-action
 445                 'ztree-diff-node-side)
 446     (ztreediff-mode)
 447     (setq ztree-diff-dirs-pair (cons dir1 dir2))
 448     (ztree-refresh-buffer)))
 449
 450
 451
 452
 453 (provide 'ztree-diff)
 454 ;;; ztree-diff.el ends here