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

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