| commit | author | age | ||
| 5cb5f7 | 1 | ;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2013-2016 Free Software Foundation, Inc. | |
| 4 | ;; | |
| 5 | ;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com> | |
| 6 | ;; | |
| 7 | ;; Created: 2013-11-11 | |
| 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 | (eval-when-compile (require 'cl)) | |
| 32 | (require 'ztree-view) | |
| 33 | (require 'ztree-diff-model) | |
| 34 | ||
| 35 | (defconst ztree-diff-hidden-files-regexp "^\\." | |
| 36 | "Hidden files regexp. | |
| 37 | By default all filest starting with dot `.', including . and ..") | |
| 38 | ||
| 39 | (defface ztreep-diff-header-face | |
| 40 | '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) | |
| 41 | (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold)) | |
| 42 | (t :height 1.2 :foreground "darkblue" :weight bold)) | |
| 43 | "*Face used for the header in Ztree Diff buffer." | |
| 44 | :group 'Ztree-diff :group 'font-lock-highlighting-faces) | |
| 45 | (defvar ztreep-diff-header-face 'ztreep-diff-header-face) | |
| 46 | ||
| 47 | (defface ztreep-diff-header-small-face | |
| 48 | '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) | |
| 49 | (((background dark)) (:foreground "lightblue" :weight bold)) | |
| 50 | (t :weight bold :foreground "darkblue")) | |
| 51 | "*Face used for the header in Ztree Diff buffer." | |
| 52 | :group 'Ztree-diff :group 'font-lock-highlighting-faces) | |
| 53 | (defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face) | |
| 54 | ||
| 55 | (defface ztreep-diff-model-diff-face | |
| 56 | '((t (:foreground "red"))) | |
| 57 | "*Face used for different files in Ztree-diff." | |
| 58 | :group 'Ztree-diff :group 'font-lock-highlighting-faces) | |
| 59 | (defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face) | |
| 60 | ||
| 61 | (defface ztreep-diff-model-add-face | |
| 62 | '((t (:foreground "blue"))) | |
| 63 | "*Face used for added files in Ztree-diff." | |
| 64 | :group 'Ztree-diff :group 'font-lock-highlighting-faces) | |
| 65 | (defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face) | |
| 66 | ||
| 67 | (defface ztreep-diff-model-ignored-face | |
| 68 | '((((type tty pc) (class color) (min-colors 256)) :foreground "#2f2f2f") | |
| 69 | (((type tty pc) (class color) (min-colors 8)) :foreground "white") | |
| 70 | (t (:foreground "#7f7f7f" :strike-through t))) | |
| 71 | "*Face used for non-modified files in Ztree-diff." | |
| 72 | :group 'Ztree-diff :group 'font-lock-highlighting-faces) | |
| 73 | (defvar ztreep-diff-model-ignored-face 'ztreep-diff-model-ignored-face) | |
| 74 | ||
| 75 | (defface ztreep-diff-model-normal-face | |
| 76 | '((((type tty pc) (class color) (min-colors 8)) :foreground "white") | |
| 77 | (t (:foreground "#7f7f7f"))) | |
| 78 | "*Face used for non-modified files in Ztree-diff." | |
| 79 | :group 'Ztree-diff :group 'font-lock-highlighting-faces) | |
| 80 | (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face) | |
| 81 | ||
| 82 | ||
| 83 | (defvar-local ztree-diff-filter-list (list ztree-diff-hidden-files-regexp) | |
| 84 | "List of regexp file names to filter out. | |
| 85 | By default paths starting with dot (like .git) are ignored") | |
| 86 | ||
| 87 | (defvar-local ztree-diff-dirs-pair nil | |
| 88 | "Pair of the directories stored. Used to perform the full rescan.") | |
| 89 | ||
| 90 | (defvar-local ztree-diff-show-equal-files t | |
| 91 | "Show or not equal files/directories on both sides.") | |
| 92 | ||
| 93 | (defvar-local ztree-diff-show-filtered-files nil | |
| 94 | "Show or not files from the filtered list.") | |
| 95 | ||
| 96 | (defvar-local ztree-diff-show-right-orphan-files t | |
| 97 | "Show or not orphan files/directories on right side.") | |
| 98 | ||
| 99 | (defvar-local ztree-diff-show-left-orphan-files t | |
| 100 | "Show or not orphan files/directories on left side.") | |
| 101 | ||
| 102 | (defvar-local ztree-diff-wait-message nil | |
| 103 | "Message showing while constructing the diff tree.") | |
| 104 | ||
| 105 | (defvar ztree-diff-ediff-previous-window-configurations nil | |
| 106 | "Window configurations prior to calling `ediff'. | |
| 107 | A queue of window configurations, allowing | |
| 108 | to restore last configuration even if there were a couple of ediff sessions") | |
| 109 | ||
| 110 | ;;;###autoload | |
| 111 | (define-minor-mode ztreediff-mode | |
| 112 | "A minor mode for displaying the difference of the directory trees in text mode." | |
| 113 | ;; initial value | |
| 114 | nil | |
| 115 | ;; modeline name | |
| 116 | " Diff" | |
| 117 | ;; The minor mode keymap | |
| 118 | `( | |
| 119 | (,(kbd "C") . ztree-diff-copy) | |
| 120 | (,(kbd "h") . ztree-diff-toggle-show-equal-files) | |
| 121 | (,(kbd "H") . ztree-diff-toggle-show-filtered-files) | |
| 122 | (,(kbd "D") . ztree-diff-delete-file) | |
| 123 | (,(kbd "v") . ztree-diff-view-file) | |
| 124 | (,(kbd "d") . ztree-diff-simple-diff-files) | |
| 125 | (,(kbd "r") . ztree-diff-partial-rescan) | |
| 126 | (,(kbd "R") . ztree-diff-full-rescan) | |
| 127 | ([f5] . ztree-diff-full-rescan))) | |
| 128 | ||
| 129 | ||
| 130 | (defun ztree-diff-node-face (node) | |
| 131 | "Return the face for the NODE depending on diff status." | |
| 132 | (let ((diff (ztree-diff-node-different node))) | |
| 133 | (cond ((eq diff 'ignore) ztreep-diff-model-ignored-face) | |
| 134 | ((eq diff 'diff) ztreep-diff-model-diff-face) | |
| 135 | ((eq diff 'new) ztreep-diff-model-add-face) | |
| 136 | ((eq diff 'same) ztreep-diff-model-normal-face)))) | |
| 137 | ||
| 138 | (defun ztree-diff-insert-buffer-header () | |
| 139 | "Insert the header to the ztree buffer." | |
| 140 | (ztree-insert-with-face "Differences tree" ztreep-diff-header-face) | |
| 141 | (insert "\n") | |
| 142 | (when ztree-diff-dirs-pair | |
| 143 | (ztree-insert-with-face (concat "Left: " (car ztree-diff-dirs-pair)) | |
| 144 | ztreep-diff-header-small-face) | |
| 145 | (insert "\n") | |
| 146 | (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair)) | |
| 147 | ztreep-diff-header-small-face) | |
| 148 | (insert "\n")) | |
| 149 | (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face) | |
| 150 | (insert "\n") | |
| 151 | (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face) | |
| 152 | (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face) | |
| 153 | (insert "\n") | |
| 154 | (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face) | |
| 155 | (ztree-insert-with-face "- does not exist on other side" ztreep-diff-header-small-face) | |
| 156 | (insert "\n") | |
| 157 | (ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face) | |
| 158 | (ztree-insert-with-face "- different from other side" ztreep-diff-header-small-face) | |
| 159 | (insert "\n ") | |
| 160 | (ztree-insert-with-face "Ignored file" ztreep-diff-model-ignored-face) | |
| 161 | (ztree-insert-with-face " - ignored from comparison" ztreep-diff-header-small-face) | |
| 162 | (insert "\n") | |
| 163 | ||
| 164 | (ztree-insert-with-face "==============" ztreep-diff-header-face) | |
| 165 | (insert "\n")) | |
| 166 | ||
| 167 | (defun ztree-diff-full-rescan () | |
| 168 | "Force full rescan of the directory trees." | |
| 169 | (interactive) | |
| 170 | (when (and ztree-diff-dirs-pair | |
| 171 | (yes-or-no-p (format "Force full rescan?"))) | |
| 172 | (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))) | |
| 173 | ||
| 174 | ||
| 175 | ||
| 176 | (defun ztree-diff-existing-common (node) | |
| 177 | "Return the NODE if both left and right sides exist." | |
| 178 | (let ((left (ztree-diff-node-left-path node)) | |
| 179 | (right (ztree-diff-node-right-path node))) | |
| 180 | (if (and left right | |
| 181 | (file-exists-p left) | |
| 182 | (file-exists-p right)) | |
| 183 | node | |
| 184 | nil))) | |
| 185 | ||
| 186 | (defun ztree-diff-existing-common-parent (node) | |
| 187 | "Return the first node in up in hierarchy of the NODE which has both sides." | |
| 188 | (let ((common (ztree-diff-existing-common node))) | |
| 189 | (if common | |
| 190 | common | |
| 191 | (ztree-diff-existing-common-parent (ztree-diff-node-parent node))))) | |
| 192 | ||
| 193 | (defun ztree-diff-do-partial-rescan (node) | |
| 194 | "Partly rescan the NODE." | |
| 195 | (let* ((common (ztree-diff-existing-common-parent node)) | |
| 196 | (parent (ztree-diff-node-parent common))) | |
| 197 | (if (not parent) | |
| 198 | (when ztree-diff-dirs-pair | |
| 199 | (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))) | |
| 200 | (ztree-diff-update-wait-message | |
| 201 | (concat "Updating " (ztree-diff-node-short-name common) " ...")) | |
| 202 | (ztree-diff-model-partial-rescan common) | |
| 203 | (message "Done") | |
| 204 | (ztree-refresh-buffer (line-number-at-pos))))) | |
| 205 | ||
| 206 | ||
| 207 | (defun ztree-diff-partial-rescan () | |
| 208 | "Perform partial rescan on the current node." | |
| 209 | (interactive) | |
| 210 | (let ((found (ztree-find-node-at-point))) | |
| 211 | (when found | |
| 212 | (ztree-diff-do-partial-rescan (car found))))) | |
| 213 | ||
| 214 | ||
| 215 | (defun ztree-diff-simple-diff (node) | |
| 216 | "Create a simple diff buffer for files from left and right panels. | |
| 217 | Argument NODE node containing paths to files to call a diff on." | |
| 218 | (let* ((node-left (ztree-diff-node-left-path node)) | |
| 219 | (node-right (ztree-diff-node-right-path node))) | |
| 220 | (when (and | |
| 221 | node-left | |
| 222 | node-right | |
| 223 | (not (file-directory-p node-left))) | |
| 224 | ;; show the diff window on the bottom | |
| 225 | ;; to not to crush tree appearance | |
| 226 | (let ((split-width-threshold nil)) | |
| 227 | (diff node-left node-right))))) | |
| 228 | ||
| 229 | ||
| 230 | (defun ztree-diff-simple-diff-files () | |
| 231 | "Create a simple diff buffer for files from left and right panels." | |
| 232 | (interactive) | |
| 233 | (let ((found (ztree-find-node-at-point))) | |
| 234 | (when found | |
| 235 | (let ((node (car found))) | |
| 236 | (ztree-diff-simple-diff node))))) | |
| 237 | ||
| 238 | (defun ztree-diff-ediff-before-setup-hook-function () | |
| 239 | "Hook function for `ediff-before-setup-hook'. | |
| 240 | ||
| 241 | See the Info node `(ediff) hooks'. | |
| 242 | ||
| 243 | This hook function removes itself." | |
| 244 | (push (current-window-configuration) ztree-diff-ediff-previous-window-configurations) | |
| 245 | (ztree-save-current-position) | |
| 246 | (remove-hook 'ediff-before-setup-hook #'ztree-diff-ediff-before-setup-hook-function)) | |
| 247 | ||
| 248 | (defun ztree-diff-ediff-quit-hook-function () | |
| 249 | "Hook function for `ediff-quit-hook'. | |
| 250 | ||
| 251 | See the Info node `(ediff) hooks'. | |
| 252 | ||
| 253 | This hook function removes itself." | |
| 254 | (set-window-configuration (pop ztree-diff-ediff-previous-window-configurations)) | |
| 255 | (ztree-refresh-buffer) | |
| 256 | (remove-hook 'ediff-quit-hook #'ztree-diff-ediff-quit-hook-function)) | |
| 257 | ||
| 258 | (defun ztree-diff-ediff (file-a file-b &optional startup-hooks) | |
| 259 | "Ediff that cleans up after itself. | |
| 260 | ||
| 261 | Ediff-related buffers are killed and the pre-Ediff window | |
| 262 | configuration is restored." | |
| 263 | (add-hook 'ediff-before-setup-hook #'ztree-diff-ediff-before-setup-hook-function) | |
| 264 | (add-hook 'ediff-quit-hook #'ztree-diff-ediff-quit-hook-function t) | |
| 265 | (ediff file-a file-b startup-hooks)) | |
| 266 | ||
| 267 | (defun ztree-diff-node-action (node hard) | |
| 268 | "Perform action on NODE: | |
| 269 | 1 if both left and right sides present: | |
| 270 | 1.1 if they are differend | |
| 271 | 1.1.1 if HARD ediff | |
| 272 | 1.1.2 simple diff otherwiste | |
| 273 | 1.2 if they are the same - view left | |
| 274 | 2 if left or right present - view left or rigth" | |
| 275 | ;; save current position in case if the window | |
| 276 | ;; configuration will change | |
| 277 | (ztree-save-current-position) | |
| 278 | (let ((left (ztree-diff-node-left-path node)) | |
| 279 | (right (ztree-diff-node-right-path node)) | |
| 280 | ;; FIXME: The GNU convention is to only use "path" for lists of | |
| 281 | ;; directories as in load-path. | |
| 282 | (open-f #'(lambda (path) (if hard (find-file path) | |
| 283 | (let ((split-width-threshold nil)) | |
| 284 | (view-file-other-window path)))))) | |
| 285 | (cond ((and left right) | |
| 286 | (if (eql (ztree-diff-node-different node) 'same) | |
| 287 | (funcall open-f left) | |
| 288 | (if hard | |
| 289 | (ztree-diff-ediff left right) | |
| 290 | (ztree-diff-simple-diff node)))) | |
| 291 | (left (funcall open-f left)) | |
| 292 | (right (funcall open-f right)) | |
| 293 | (t nil)))) | |
| 294 | ||
| 295 | ||
| 296 | ||
| 297 | (defun ztree-diff-copy-file (node source-path destination-path copy-to-right) | |
| 298 | "Update the NODE status and copy the file. | |
| 299 | File copied from SOURCE-PATH to DESTINATION-PATH. | |
| 300 | COPY-TO-RIGHT specifies which side of the NODE to update." | |
| 301 | (let ((target-path (concat | |
| 302 | (file-name-as-directory destination-path) | |
| 303 | (file-name-nondirectory | |
| 304 | (directory-file-name source-path))))) | |
| 305 | (let ((err (condition-case error-trap | |
| 306 | (progn | |
| 307 | ;; don't ask for overwrite | |
| 308 | ;; keep time stamp | |
| 309 | (copy-file source-path target-path t t) | |
| 310 | nil) | |
| 311 | (error error-trap)))) | |
| 312 | ;; error message if failed | |
| 313 | (if err (message (concat "Error: " (nth 2 err))) | |
| 314 | ;; otherwise: | |
| 315 | ;; assuming all went ok when left and right nodes are the same | |
| 316 | ;; set both as not different if they were not ignored | |
| 317 | (unless (eq (ztree-diff-node-different node) 'ignore) | |
| 318 | (setf (ztree-diff-node-different node) 'same)) | |
| 319 | ;; update left/right paths | |
| 320 | (if copy-to-right | |
| 321 | (setf (ztree-diff-node-right-path node) target-path) | |
| 322 | (setf (ztree-diff-node-left-path node) target-path)) | |
| 323 | (ztree-diff-node-update-all-parents-diff node) | |
| 324 | (ztree-refresh-buffer (line-number-at-pos)))))) | |
| 325 | ||
| 326 | ||
| 327 | (defun ztree-diff-copy-dir (node source-path destination-path copy-to-right) | |
| 328 | "Update the NODE status and copy the directory. | |
| 329 | Directory copied from SOURCE-PATH to DESTINATION-PATH. | |
| 330 | COPY-TO-RIGHT specifies which side of the NODE to update." | |
| 331 | (let* ((src-path (file-name-as-directory source-path)) | |
| 332 | (target-path (file-name-as-directory destination-path)) | |
| 333 | (target-full-path (concat | |
| 334 | target-path | |
| 335 | (file-name-nondirectory | |
| 336 | (directory-file-name source-path))))) | |
| 337 | (let ((err (condition-case error-trap | |
| 338 | (progn | |
| 339 | ;; keep time stamp | |
| 340 | ;; ask for overwrite | |
| 341 | (copy-directory src-path target-path t t) | |
| 342 | nil) | |
| 343 | (error error-trap)))) | |
| 344 | ;; error message if failed | |
| 345 | (if err | |
| 346 | (progn | |
| 347 | (message (concat "Error: " (nth 1 err))) | |
| 348 | ;; and do rescan of the node | |
| 349 | (ztree-diff-do-partial-rescan node)) | |
| 350 | ;; if everything is ok, update statuses | |
| 351 | (message target-full-path) | |
| 352 | (if copy-to-right | |
| 353 | (setf (ztree-diff-node-right-path node) target-full-path) | |
| 354 | (setf (ztree-diff-node-left-path node) target-full-path)) | |
| 355 | (ztree-diff-update-wait-message | |
| 356 | (concat "Updating " (ztree-diff-node-short-name node) " ...")) | |
| 357 | ;; TODO: do not rescan the node. Use some logic like in delete | |
| 358 | (ztree-diff-model-update-node node) | |
| 359 | (message "Done.") | |
| 360 | (ztree-diff-node-update-all-parents-diff node) | |
| 361 | (ztree-refresh-buffer (line-number-at-pos)))))) | |
| 362 | ||
| 363 | ||
| 364 | (defun ztree-diff-copy () | |
| 365 | "Copy the file under the cursor to other side." | |
| 366 | (interactive) | |
| 367 | (let ((found (ztree-find-node-at-point))) | |
| 368 | (when found | |
| 369 | (let* ((node (car found)) | |
| 370 | (side (cdr found)) | |
| 371 | (node-side (ztree-diff-node-side node)) | |
| 372 | (copy-to-right t) ; copy from left to right | |
| 373 | (node-left (ztree-diff-node-left-path node)) | |
| 374 | (node-right (ztree-diff-node-right-path node)) | |
| 375 | (source-path nil) | |
| 376 | (destination-path nil) | |
| 377 | (parent (ztree-diff-node-parent node))) | |
| 378 | (when parent ; do not copy the root node | |
| 379 | ;; determine a side to copy from/to | |
| 380 | ;; algorithm: | |
| 381 | ;; 1) if both side are present, use the side | |
| 382 | ;; variable | |
| 383 | (setq copy-to-right (if (eq node-side 'both) | |
| 384 | (eq side 'left) | |
| 385 | ;; 2) if one of sides is absent, copy from | |
| 386 | ;; the side where the file is present | |
| 387 | (eq node-side 'left))) | |
| 388 | ;; 3) in both cases determine if the destination | |
| 389 | ;; directory is in place | |
| 390 | (setq source-path (if copy-to-right node-left node-right) | |
| 391 | destination-path (if copy-to-right | |
| 392 | (ztree-diff-node-right-path parent) | |
| 393 | (ztree-diff-node-left-path parent))) | |
| 394 | (when (and source-path destination-path | |
| 395 | (yes-or-no-p (format "Copy [%s]%s to [%s]%s/ ?" | |
| 396 | (if copy-to-right "LEFT" "RIGHT") | |
| 397 | (ztree-diff-node-short-name node) | |
| 398 | (if copy-to-right "RIGHT" "LEFT") | |
| 399 | destination-path))) | |
| 400 | (if (file-directory-p source-path) | |
| 401 | (ztree-diff-copy-dir node | |
| 402 | source-path | |
| 403 | destination-path | |
| 404 | copy-to-right) | |
| 405 | (ztree-diff-copy-file node | |
| 406 | source-path | |
| 407 | destination-path | |
| 408 | copy-to-right)))))))) | |
| 409 | ||
| 410 | (defun ztree-diff-view-file () | |
| 411 | "View file at point, depending on side." | |
| 412 | (interactive) | |
| 413 | (let ((found (ztree-find-node-at-point))) | |
| 414 | (when found | |
| 415 | (let* ((node (car found)) | |
| 416 | (side (cdr found)) | |
| 417 | (node-side (ztree-diff-node-side node)) | |
| 418 | (node-left (ztree-diff-node-left-path node)) | |
| 419 | (node-right (ztree-diff-node-right-path node))) | |
| 420 | (when (or (eq node-side 'both) | |
| 421 | (eq side node-side)) | |
| 422 | (cond ((and (eq side 'left) | |
| 423 | node-left) | |
| 424 | (view-file node-left)) | |
| 425 | ((and (eq side 'right) | |
| 426 | node-right) | |
| 427 | (view-file node-right)))))))) | |
| 428 | ||
| 429 | ||
| 430 | (defun ztree-diff-delete-file () | |
| 431 | "Delete the file under the cursor." | |
| 432 | (interactive) | |
| 433 | (let ((found (ztree-find-node-at-point))) | |
| 434 | (when found | |
| 435 | (let* ((node (car found)) | |
| 436 | (side (cdr found)) | |
| 437 | (node-side (ztree-diff-node-side node)) | |
| 438 | (parent (ztree-diff-node-parent node)) | |
| 439 | ;; algorithm for determining what to delete similar to copy: | |
| 440 | ;; 1. if the file is present on both sides, delete | |
| 441 | ;; from the side currently selected | |
| 442 | ;; 2. if one of sides is absent, delete | |
| 443 | ;; from the side where the file is present | |
| 444 | (delete-from-left | |
| 445 | (or (eql node-side 'left) | |
| 446 | (and (eql node-side 'both) | |
| 447 | (eql side 'left)))) | |
| 448 | (remove-path (if delete-from-left | |
| 449 | (ztree-diff-node-left-path node) | |
| 450 | (ztree-diff-node-right-path node)))) | |
| 451 | (when (and parent ; do not delete the root node | |
| 452 | (yes-or-no-p (format "Delete the file [%s]%s ?" | |
| 453 | (if delete-from-left "LEFT" "RIGHT") | |
| 454 | remove-path))) | |
| 455 | (let* ((delete-command | |
| 456 | (if (file-directory-p remove-path) | |
| 457 | #'delete-directory | |
| 458 | #'delete-file)) | |
| 459 | (children (ztree-diff-node-children parent)) | |
| 460 | (err | |
| 461 | (condition-case error-trap | |
| 462 | (progn | |
| 463 | (funcall delete-command remove-path t) | |
| 464 | nil) | |
| 465 | (error error-trap)))) | |
| 466 | (if err | |
| 467 | (progn | |
| 468 | (message (concat "Error: " (nth 2 err))) | |
| 469 | ;; when error happened while deleting the | |
| 470 | ;; directory, rescan the node | |
| 471 | ;; and update the parents with a new status | |
| 472 | ;; of this node | |
| 473 | (when (file-directory-p remove-path) | |
| 474 | (ztree-diff-model-partial-rescan node))) | |
| 475 | ;; if everything ok | |
| 476 | ;; if was only on one side | |
| 477 | ;; remove the node from children | |
| 478 | (if (or (and (eql node-side 'left) | |
| 479 | delete-from-left) | |
| 480 | (and (eql node-side 'right) | |
| 481 | (not delete-from-left))) | |
| 482 | (setf (ztree-diff-node-children parent) | |
| 483 | (ztree-filter | |
| 484 | (lambda (x) (not (ztree-diff-node-equal x node))) | |
| 485 | children)) | |
| 486 | ;; otherwise update only one side | |
| 487 | (mapc (if delete-from-left | |
| 488 | (lambda (x) (setf (ztree-diff-node-left-path x) nil)) | |
| 489 | (lambda (x) (setf (ztree-diff-node-right-path x) nil))) | |
| 490 | (cons node (ztree-diff-node-children node))) | |
| 491 | ;; and update diff status | |
| 492 | ;; if was ignored keep the old status | |
| 493 | (unless (eql (ztree-diff-node-different node) 'ignore) | |
| 494 | (setf (ztree-diff-node-different node) 'new)) | |
| 495 | ;; finally update all children statuses | |
| 496 | (ztree-diff-node-update-diff-from-parent node))) | |
| 497 | (ztree-diff-node-update-all-parents-diff node) | |
| 498 | (ztree-refresh-buffer (line-number-at-pos)))))))) | |
| 499 | ||
| 500 | ||
| 501 | ||
| 502 | (defun ztree-diff-node-ignore-p (node) | |
| 503 | "Determine if the NODE is in filter list. | |
| 504 | If the node is in the filter list it shall not be visible, | |
| 505 | unless it is a parent node." | |
| 506 | (let ((name (ztree-diff-node-short-name node))) | |
| 507 | ;; ignore then | |
| 508 | ;; not a root and is in filter list | |
| 509 | (and (ztree-diff-node-parent node) | |
| 510 | (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx name)))))) | |
| 511 | ||
| 512 | ||
| 513 | (defun ztree-node-is-visible (node) | |
| 514 | "Determine if the NODE should be visible." | |
| 515 | (let ((diff (ztree-diff-node-different node))) | |
| 516 | ;; visible then | |
| 517 | ;; either it is a root. root have no parent | |
| 518 | (or (not (ztree-diff-node-parent node)) ; parent is always visible | |
| 519 | ;; or the files are different | |
| 520 | (eql diff 'diff) | |
| 521 | ;; or it is orphaned, but show orphaned files for now | |
| 522 | (and (eql diff 'new) | |
| 523 | (if (ztree-diff-node-left-path node) | |
| 524 | ztree-diff-show-left-orphan-files | |
| 525 | ztree-diff-show-right-orphan-files)) | |
| 526 | ;; or it is ignored but we show ignored for now | |
| 527 | (and (eql diff 'ignore) | |
| 528 | ztree-diff-show-filtered-files) | |
| 529 | ;; or they are same but we show same for now | |
| 530 | (and (eql diff 'same) | |
| 531 | ztree-diff-show-equal-files)))) | |
| 532 | ||
| 533 | (defmacro ztree-diff-define-toggle-show (what) | |
| 534 | (let ((funcsymbol (intern (concat "ztree-diff-toggle-show-" what "-files"))) | |
| 535 | (variable (intern (concat "ztree-diff-show-" what "-files"))) | |
| 536 | (fundesc (concat "Toggle visibility of the " what " files/directories"))) | |
| 537 | `(defun ,funcsymbol () | |
| 538 | ,fundesc | |
| 539 | (interactive) | |
| 540 | (setq ,variable (not ,variable)) | |
| 541 | (message (concat (if ,variable "Show " "Hide ") ,what " files")) | |
| 542 | (ztree-refresh-buffer)))) | |
| 543 | ||
| 544 | (ztree-diff-define-toggle-show "equal") | |
| 545 | (ztree-diff-define-toggle-show "filtered") | |
| 546 | (ztree-diff-define-toggle-show "left-orphan") | |
| 547 | (ztree-diff-define-toggle-show "right-orphan") | |
| 548 | ||
| 549 | (defun ztree-diff-toggle-show-orphan-files () | |
| 550 | "Toggle visibility of left and right orphan files." | |
| 551 | (interactive) | |
| 552 | (let ((show (not ztree-diff-show-left-orphan-files))) | |
| 553 | (setq ztree-diff-show-left-orphan-files show) | |
| 554 | (setq ztree-diff-show-right-orphan-files show) | |
| 555 | (message (concat (if show "Show" "Hide") " orphan files")) | |
| 556 | (ztree-refresh-buffer))) | |
| 557 | ||
| 558 | (defun ztree-diff-update-wait-message (&optional msg) | |
| 559 | "Update the wait message MSG with one more `.' progress indication." | |
| 560 | (if msg | |
| 561 | (setq ztree-diff-wait-message msg) | |
| 562 | (when ztree-diff-wait-message | |
| 563 | (setq ztree-diff-wait-message (concat ztree-diff-wait-message ".")))) | |
| 564 | (message ztree-diff-wait-message)) | |
| 565 | ||
| 566 | ;;;###autoload | |
| 567 | (defun ztree-diff (dir1 dir2) | |
| 568 | "Create an interactive buffer with the directory tree of the path given. | |
| 569 | Argument DIR1 left directory. | |
| 570 | Argument DIR2 right directory." | |
| 571 | (interactive "DLeft directory \nDRight directory ") | |
| 572 | (unless (and dir1 (file-directory-p dir1)) | |
| 573 | (error "Path %s is not a directory" dir1)) | |
| 574 | (unless (file-exists-p dir1) | |
| 575 | (error "Path %s does not exist" dir1)) | |
| 576 | (unless (and dir2 (file-directory-p dir2)) | |
| 577 | (error "Path %s is not a directory" dir2)) | |
| 578 | (unless (file-exists-p dir2) | |
| 579 | (error "Path %s does not exist" dir2)) | |
| 580 | (unless (ztree-same-host-p dir1 dir2) | |
| 581 | (error "Compared directories are not on the same host")) | |
| 582 | (let* ((model | |
| 583 | (ztree-diff-node-create nil dir1 dir2 nil)) | |
| 584 | (buf-name (concat "*" | |
| 585 | (ztree-diff-node-short-name model) | |
| 586 | " <--> " | |
| 587 | (ztree-diff-node-right-short-name model) | |
| 588 | "*"))) | |
| 589 | ;; after this command we are in a new buffer, | |
| 590 | ;; so all buffer-local vars are valid | |
| 591 | (ztree-view buf-name | |
| 592 | model | |
| 593 | 'ztree-node-is-visible | |
| 594 | 'ztree-diff-insert-buffer-header | |
| 595 | 'ztree-diff-node-short-name-wrapper | |
| 596 | 'ztree-diff-node-is-directory | |
| 597 | 'ztree-diff-node-equal | |
| 598 | 'ztree-diff-node-children | |
| 599 | 'ztree-diff-node-face | |
| 600 | 'ztree-diff-node-action | |
| 601 | 'ztree-diff-node-side) | |
| 602 | (ztreediff-mode) | |
| 603 | (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p) | |
| 604 | (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message) | |
| 605 | (setq ztree-diff-dirs-pair (cons dir1 dir2)) | |
| 606 | (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 " ...")) | |
| 607 | (ztree-diff-node-recreate model) | |
| 608 | (message "Done.") | |
| 609 | ||
| 610 | (ztree-refresh-buffer))) | |
| 611 | ||
| 612 | ||
| 613 | ||
| 614 | ||
| 615 | ||
| 616 | ||
| 617 | (provide 'ztree-diff) | |
| 618 | ;;; ztree-diff.el ends here | |
