X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/5817fe1ff1059fd505dc5e6d5171f545866bee91..f10533854f4c7bb54247a11981191bf37b70cb36:/packages/ztree/ztree-diff.el diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el index ff9b3235f..cfd0c967c 100644 --- a/packages/ztree/ztree-diff.el +++ b/packages/ztree/ztree-diff.el @@ -1,10 +1,10 @@ ;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2015 Free Software Foundation, Inc. +;; Copyright (C) 2013-2016 Free Software Foundation, Inc. ;; -;; Author: Alexey Veretennikov -;; -;; Created: 2013-11-1l +;; Author: Alexey Veretennikov +;; +;; Created: 2013-11-11 ;; ;; Keywords: files tools ;; URL: https://github.com/fourier/ztree @@ -33,7 +33,7 @@ (defconst ztree-diff-hidden-files-regexp "^\\." "Hidden files regexp. -By default all filest starting with dot '.', including . and ..") +By default all filest starting with dot `.', including . and ..") (defface ztreep-diff-header-face '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) @@ -63,29 +63,39 @@ By default all filest starting with dot '.', including . and ..") :group 'Ztree-diff :group 'font-lock-highlighting-faces) (defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face) +(defface ztreep-diff-model-ignored-face + '((((type tty pc) (class color) (min-colors 256)) :foreground "#2f2f2f") + (((type tty pc) (class color) (min-colors 8)) :foreground "white") + (t (:foreground "#7f7f7f" :strike-through t))) + "*Face used for non-modified files in Ztree-diff." + :group 'Ztree-diff :group 'font-lock-highlighting-faces) +(defvar ztreep-diff-model-ignored-face 'ztreep-diff-model-ignored-face) + (defface ztreep-diff-model-normal-face - '((t (:foreground "#7f7f7f"))) + '((((type tty pc) (class color) (min-colors 8)) :foreground "white") + (t (:foreground "#7f7f7f"))) "*Face used for non-modified files in Ztree-diff." :group 'Ztree-diff :group 'font-lock-highlighting-faces) (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face) -(defvar ztree-diff-filter-list (list ztree-diff-hidden-files-regexp) +(defvar-local ztree-diff-filter-list (list ztree-diff-hidden-files-regexp) "List of regexp file names to filter out. By default paths starting with dot (like .git) are ignored") -(make-variable-buffer-local 'ztree-diff-filter-list) -(defvar ztree-diff-dirs-pair nil +(defvar-local ztree-diff-dirs-pair nil "Pair of the directories stored. Used to perform the full rescan.") -(make-variable-buffer-local 'ztree-diff-dirs-pair) -(defvar ztree-diff-show-equal-files t +(defvar-local ztree-diff-show-equal-files t "Show or not equal files/directories on both sides.") -(make-variable-buffer-local 'ztree-diff-show-equal-files) -(defvar ztree-diff-show-filtered-files nil +(defvar-local ztree-diff-show-filtered-files nil "Show or not files from the filtered list.") +(defvar-local ztree-diff-wait-message nil + "Message showing while constructing the diff tree.") + + ;;;###autoload (define-minor-mode ztreediff-mode "A minor mode for displaying the difference of the directory trees in text mode." @@ -102,15 +112,17 @@ By default paths starting with dot (like .git) are ignored") (,(kbd "v") . ztree-diff-view-file) (,(kbd "d") . ztree-diff-simple-diff-files) (,(kbd "r") . ztree-diff-partial-rescan) + (,(kbd "R") . ztree-diff-full-rescan) ([f5] . ztree-diff-full-rescan))) (defun ztree-diff-node-face (node) "Return the face for the NODE depending on diff status." (let ((diff (ztree-diff-node-different node))) - (cond ((eq diff 'diff) ztreep-diff-model-diff-face) + (cond ((eq diff 'ignore) ztreep-diff-model-ignored-face) + ((eq diff 'diff) ztreep-diff-model-diff-face) ((eq diff 'new) ztreep-diff-model-add-face) - (t ztreep-diff-model-normal-face)))) + ((eq diff 'same) ztreep-diff-model-normal-face)))) (defun ztree-diff-insert-buffer-header () "Insert the header to the ztree buffer." @@ -133,7 +145,11 @@ By default paths starting with dot (like .git) are ignored") (insert "\n") (ztree-insert-with-face " Mismatch file " ztreep-diff-model-diff-face) (ztree-insert-with-face "- different from other side" ztreep-diff-header-small-face) + (insert "\n ") + (ztree-insert-with-face "Ignored file" ztreep-diff-model-ignored-face) + (ztree-insert-with-face " - ignored from comparison" ztreep-diff-header-small-face) (insert "\n") + (ztree-insert-with-face "==============" ztreep-diff-header-face) (insert "\n")) @@ -170,10 +186,11 @@ By default paths starting with dot (like .git) are ignored") (if (not parent) (when ztree-diff-dirs-pair (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))) - (progn - (ztree-diff-model-partial-rescan common) - (ztree-diff-node-update-all-parents-diff node) - (ztree-refresh-buffer (line-number-at-pos)))))) + (ztree-diff-update-wait-message + (concat "Updating " (ztree-diff-node-short-name common) " ...")) + (ztree-diff-model-partial-rescan common) + (message "Done") + (ztree-refresh-buffer (line-number-at-pos))))) (defun ztree-diff-partial-rescan () @@ -217,11 +234,13 @@ Argument NODE node containing paths to files to call a diff on." 2 if left or right present - view left or rigth" (let ((left (ztree-diff-node-left-path node)) (right (ztree-diff-node-right-path node)) + ;; FIXME: The GNU convention is to only use "path" for lists of + ;; directories as in load-path. (open-f #'(lambda (path) (if hard (find-file path) (let ((split-width-threshold nil)) (view-file-other-window path)))))) (cond ((and left right) - (if (not (ztree-diff-node-different node)) + (if (eql (ztree-diff-node-different node) 'same) (funcall open-f left) (if hard (ediff left right) @@ -249,16 +268,17 @@ COPY-TO-RIGHT specifies which side of the NODE to update." (error error-trap)))) ;; error message if failed (if err (message (concat "Error: " (nth 2 err))) - (progn ; otherwise: - ;; assuming all went ok when left and right nodes are the same - ;; set both as not different - (ztree-diff-node-set-different node nil) - ;; update left/right paths - (if copy-to-right - (ztree-diff-node-set-right-path node target-path) - (ztree-diff-node-set-left-path node target-path)) - (ztree-diff-node-update-all-parents-diff node) - (ztree-refresh-buffer (line-number-at-pos))))))) + ;; otherwise: + ;; assuming all went ok when left and right nodes are the same + ;; set both as not different if they were not ignored + (unless (eq (ztree-diff-node-different node) 'ignore) + (setf (ztree-diff-node-different node) 'same)) + ;; update left/right paths + (if copy-to-right + (setf (ztree-diff-node-right-path node) target-path) + (setf (ztree-diff-node-left-path node) target-path)) + (ztree-diff-node-update-all-parents-diff node) + (ztree-refresh-buffer (line-number-at-pos)))))) (defun ztree-diff-copy-dir (node source-path destination-path copy-to-right) @@ -279,17 +299,23 @@ COPY-TO-RIGHT specifies which side of the NODE to update." nil) (error error-trap)))) ;; error message if failed - (if err (message (concat "Error: " (nth 1 err))) - (progn - (message target-full-path) - (if copy-to-right - (ztree-diff-node-set-right-path node - target-full-path) - (ztree-diff-node-set-left-path node - target-full-path)) - (ztree-diff-model-update-node node) - (ztree-diff-node-update-all-parents-diff node) - (ztree-refresh-buffer (line-number-at-pos))))))) + (if err + (progn + (message (concat "Error: " (nth 1 err))) + ;; and do rescan of the node + (ztree-diff-do-partial-rescan node)) + ;; if everything is ok, update statuses + (message target-full-path) + (if copy-to-right + (setf (ztree-diff-node-right-path node) target-full-path) + (setf (ztree-diff-node-left-path node) target-full-path)) + (ztree-diff-update-wait-message + (concat "Updating " (ztree-diff-node-short-name node) " ...")) + ;; TODO: do not rescan the node. Use some logic like in delete + (ztree-diff-model-update-node node) + (message "Done.") + (ztree-diff-node-update-all-parents-diff node) + (ztree-refresh-buffer (line-number-at-pos)))))) (defun ztree-diff-copy () @@ -366,55 +392,67 @@ COPY-TO-RIGHT specifies which side of the NODE to update." (let* ((node (car found)) (side (cdr found)) (node-side (ztree-diff-node-side node)) - (delete-from-left t) - (remove-path nil) - (parent (ztree-diff-node-parent node))) - (when parent ; do not delete the root node - ;; algorithm for determining what to delete similar to copy: - ;; 1. if the file is present on both sides, delete - ;; from the side currently selected - (setq delete-from-left (if (eq node-side 'both) - (eq side 'left) - ;; 2) if one of sides is absent, delete - ;; from the side where the file is present - (eq node-side 'left))) - (setq remove-path (if delete-from-left - (ztree-diff-node-left-path node) - (ztree-diff-node-right-path node))) - (when (yes-or-no-p (format "Delete the file [%s]%s ?" - (if delete-from-left "LEFT" "RIGHT") - remove-path)) - (let* ((delete-command - (if (file-directory-p remove-path) - #'delete-directory - #'delete-file)) - (children (ztree-diff-node-children parent)) - (err - (condition-case error-trap - (progn - (funcall delete-command remove-path t) - nil) - (error error-trap)))) - (if err - (progn - (message (concat "Error: " (nth 2 err))) - ;; when error happened while deleting the - ;; directory, rescan the node - ;; and update the parents with a new status - ;; of this node - (when (file-directory-p remove-path) - (ztree-diff-model-partial-rescan node) - (ztree-diff-node-update-all-parents-diff node))) - ;; if everything ok + (parent (ztree-diff-node-parent node)) + ;; algorithm for determining what to delete similar to copy: + ;; 1. if the file is present on both sides, delete + ;; from the side currently selected + ;; 2. if one of sides is absent, delete + ;; from the side where the file is present + (delete-from-left + (or (eql node-side 'left) + (and (eql node-side 'both) + (eql side 'left)))) + (remove-path (if delete-from-left + (ztree-diff-node-left-path node) + (ztree-diff-node-right-path node)))) + (when (and parent ; do not delete the root node + (yes-or-no-p (format "Delete the file [%s]%s ?" + (if delete-from-left "LEFT" "RIGHT") + remove-path))) + (let* ((delete-command + (if (file-directory-p remove-path) + #'delete-directory + #'delete-file)) + (children (ztree-diff-node-children parent)) + (err + (condition-case error-trap + (progn + (funcall delete-command remove-path t) + nil) + (error error-trap)))) + (if err (progn - ;; remove the node from children - (setq children (ztree-filter - #'(lambda (x) (not (ztree-diff-node-equal x node))) - children)) - (ztree-diff-node-set-children parent children)) - (ztree-diff-node-update-all-parents-diff node) - ;;(ztree-diff-model-partial-rescan node) - (ztree-refresh-buffer (line-number-at-pos)))))))))) + (message (concat "Error: " (nth 2 err))) + ;; when error happened while deleting the + ;; directory, rescan the node + ;; and update the parents with a new status + ;; of this node + (when (file-directory-p remove-path) + (ztree-diff-model-partial-rescan node))) + ;; if everything ok + ;; if was only on one side + ;; remove the node from children + (if (or (and (eql node-side 'left) + delete-from-left) + (and (eql node-side 'right) + (not delete-from-left))) + (setf (ztree-diff-node-children parent) + (ztree-filter + (lambda (x) (not (ztree-diff-node-equal x node))) + children)) + ;; otherwise update only one side + (mapc (if delete-from-left + (lambda (x) (setf (ztree-diff-node-left-path x) nil)) + (lambda (x) (setf (ztree-diff-node-right-path x) nil))) + (cons node (ztree-diff-node-children node))) + ;; and update diff status + ;; if was ignored keep the old status + (unless (eql (ztree-diff-node-different node) 'ignore) + (setf (ztree-diff-node-different node) 'new)) + ;; finally update all children statuses + (ztree-diff-node-update-diff-from-parent node))) + (ztree-diff-node-update-all-parents-diff node) + (ztree-refresh-buffer (line-number-at-pos)))))))) @@ -431,44 +469,68 @@ unless it is a parent node." (defun ztree-node-is-visible (node) "Determine if the NODE should be visible." - ;; visible then - ;; 1) either it is a parent - (or (not (ztree-diff-node-parent node)) ; parent is always visible - (and - ;; 2.1) or it is not in ignore list and - (or ztree-diff-show-filtered-files ; show filtered files regardless - (not (ztree-diff-node-ignore-p node))) - ;; 2.2) it has different status - (or ztree-diff-show-equal-files ; show equal files regardless - (ztree-diff-node-different node))))) + (let ((diff (ztree-diff-node-different node))) + ;; visible then + ;; either it is a root. root have no parent + (or (not (ztree-diff-node-parent node)) ; parent is always visible + ;; or the files are different or orphan + (or (eql diff 'new) + (eql diff 'diff)) + ;; or it is ignored but we show ignored for now + (and (eql diff 'ignore) + ztree-diff-show-filtered-files) + ;; or they are same but we show same for now + (and (eql diff 'same) + ztree-diff-show-equal-files)))) (defun ztree-diff-toggle-show-equal-files () "Toggle visibility of the equal files." (interactive) (setq ztree-diff-show-equal-files (not ztree-diff-show-equal-files)) + (message (concat (if ztree-diff-show-equal-files "Show" "Hide") " equal files")) (ztree-refresh-buffer)) (defun ztree-diff-toggle-show-filtered-files () "Toggle visibility of the filtered files." (interactive) (setq ztree-diff-show-filtered-files (not ztree-diff-show-filtered-files)) + (message (concat (if ztree-diff-show-filtered-files "Show" "Hide") " filtered files")) (ztree-refresh-buffer)) +(defun ztree-diff-update-wait-message (&optional msg) + "Update the wait mesage with one more `.' progress indication." + (if msg + (setq ztree-diff-wait-message msg) + (when ztree-diff-wait-message + (setq ztree-diff-wait-message (concat ztree-diff-wait-message ".")))) + (message ztree-diff-wait-message)) + ;;;###autoload (defun ztree-diff (dir1 dir2) "Create an interactive buffer with the directory tree of the path given. Argument DIR1 left directory. Argument DIR2 right directory." (interactive "DLeft directory \nDRight directory ") - (let* ((difference (ztree-diff-model-create dir1 dir2 #'ztree-diff-node-ignore-p)) + (unless (and dir1 (file-directory-p dir1)) + (error "Path %s is not a directory" dir1)) + (unless (file-exists-p dir1) + (error "Path %s does not exist" dir1)) + (unless (and dir2 (file-directory-p dir2)) + (error "Path %s is not a directory" dir2)) + (unless (file-exists-p dir2) + (error "Path %s does not exist" dir2)) + (let* ((model + (ztree-diff-node-create nil dir1 dir2 nil)) (buf-name (concat "*" - (ztree-diff-node-short-name difference) + (ztree-diff-node-short-name model) " <--> " - (ztree-diff-node-right-short-name difference) + (ztree-diff-node-right-short-name model) "*"))) + ;; after this command we are in a new buffer, + ;; so all buffer-local vars are valid (ztree-view buf-name - difference + model 'ztree-node-is-visible 'ztree-diff-insert-buffer-header 'ztree-diff-node-short-name-wrapper @@ -479,11 +541,19 @@ Argument DIR2 right directory." 'ztree-diff-node-action 'ztree-diff-node-side) (ztreediff-mode) + (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p) + (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message) (setq ztree-diff-dirs-pair (cons dir1 dir2)) + (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 " ...")) + (ztree-diff-node-recreate model) + (message "Done.") + (ztree-refresh-buffer))) + + (provide 'ztree-diff) ;;; ztree-diff.el ends here