X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/635eb9aa49293e747b208ccf464236551bbf8a9a..69e56ed49da21b1ec9c642f1c6b29b337d4096b4:/ztree-diff.el diff --git a/ztree-diff.el b/ztree-diff.el index 044ab90a2..6fd3644a8 100644 --- a/ztree-diff.el +++ b/ztree-diff.el @@ -1,28 +1,29 @@ -;;; ztree-diff.el --- Text mode diff for directory trees +;;; ztree-diff.el --- Text mode diff for directory trees -*- lexical-binding: t; -*- -;; Copyright (C) 2013 Alexey Veretennikov +;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; ;; Author: Alexey Veretennikov +;; ;; Created: 2013-11-1l -;; Version: 1.0.0 -;; Keywords: files +;; +;; Keywords: files tools ;; URL: https://github.com/fourier/ztree -;; Compatibility: GNU Emacs GNU Emacs 24.x +;; Compatibility: GNU Emacs 24.x ;; -;; This file is NOT part of GNU Emacs. +;; This file is part of GNU Emacs. ;; -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 2 -;; of the License, or (at your option) any later version. +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: @@ -31,8 +32,8 @@ (require 'ztree-diff-model) (defconst ztree-diff-hidden-files-regexp "^\\." - "Hidden files regexp. By default all filest starting with dot '.', -including . and ..") + "Hidden files regexp. +By default all filest starting with dot '.', including . and ..") (defface ztreep-diff-header-face '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) @@ -69,16 +70,17 @@ including . and ..") (defvar ztreep-diff-model-normal-face 'ztreep-diff-model-normal-face) -(defvar ztree-diff-filter-list nil - "List of regexp file names to filter out") +(defvar 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 - "Pair of the directories stored. Used to perform the full rescan") + "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 - "Show or not equal files/directories on both sides") + "Show or not equal files/directories on both sides.") (make-variable-buffer-local 'ztree-diff-show-equal-files) ;;;###autoload @@ -100,37 +102,39 @@ including . and ..") (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) ((eq diff 'new) ztreep-diff-model-add-face) - (t ztreep-diff-model-normal-face)))) + (t ztreep-diff-model-normal-face)))) (defun ztree-diff-insert-buffer-header () - (insert-with-face "Differences tree" ztreep-diff-header-face) - (newline) + "Insert the header to the ztree buffer." + (ztree-insert-with-face "Differences tree" ztreep-diff-header-face) + (insert "\n") (when ztree-diff-dirs-pair - (insert-with-face (concat "Left: " (car ztree-diff-dirs-pair)) - ztreep-diff-header-small-face) - (newline) - (insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair)) - ztreep-diff-header-small-face) - (newline)) - (insert-with-face "Legend:" ztreep-diff-header-small-face) - (newline) - (insert-with-face " Normal file " ztreep-diff-model-normal-face) - (insert-with-face "- same on both sides" ztreep-diff-header-small-face) - (newline) - (insert-with-face " Orphan file " ztreep-diff-model-add-face) - (insert-with-face "- does not exist on other side" ztreep-diff-header-small-face) - (newline) - (insert-with-face " Mismatch file " ztreep-diff-model-diff-face) - (insert-with-face "- different from other side" ztreep-diff-header-small-face) - (newline) - (insert-with-face "==============" ztreep-diff-header-face) - (newline)) + (ztree-insert-with-face (concat "Left: " (car ztree-diff-dirs-pair)) + ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair)) + ztreep-diff-header-small-face) + (insert "\n")) + (ztree-insert-with-face "Legend:" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Normal file " ztreep-diff-model-normal-face) + (ztree-insert-with-face "- same on both sides" ztreep-diff-header-small-face) + (insert "\n") + (ztree-insert-with-face " Orphan file " ztreep-diff-model-add-face) + (ztree-insert-with-face "- does not exist on other side" ztreep-diff-header-small-face) + (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 "==============" ztreep-diff-header-face) + (insert "\n")) (defun ztree-diff-full-rescan () - "Forces full rescan of the directory trees" + "Force full rescan of the directory trees." (interactive) (when (and ztree-diff-dirs-pair (yes-or-no-p (format "Force full rescan?"))) @@ -139,6 +143,7 @@ including . and ..") (defun ztree-diff-existing-common (node) + "Return the NODE if both left and right sides exist." (let ((left (ztree-diff-node-left-path node)) (right (ztree-diff-node-right-path node))) (if (and left right @@ -146,14 +151,16 @@ including . and ..") (file-exists-p right)) node nil))) - + (defun ztree-diff-existing-common-parent (node) + "Return the first node in up in hierarchy of the NODE which has both sides." (let ((common (ztree-diff-existing-common node))) (if common common (ztree-diff-existing-common-parent (ztree-diff-node-parent node))))) (defun ztree-diff-do-partial-rescan (node) + "Partly rescan the NODE." (let* ((common (ztree-diff-existing-common-parent node)) (parent (ztree-diff-node-parent common))) (if (not parent) @@ -163,18 +170,19 @@ including . and ..") (ztree-diff-model-partial-rescan common) (ztree-diff-node-update-all-parents-diff node) (ztree-refresh-buffer (line-number-at-pos)))))) - + (defun ztree-diff-partial-rescan () - "Performs partial rescan on the current node" + "Perform partial rescan on the current node." (interactive) (let ((found (ztree-find-node-at-point))) (when found (ztree-diff-do-partial-rescan (car found))))) - + (defun ztree-diff-simple-diff (node) - "Create a simple diff buffer for files from left and right panels" + "Create a simple diff buffer for files from left and right panels. +Argument NODE node containing paths to files to call a diff on." (let* ((node-left (ztree-diff-node-left-path node)) (node-right (ztree-diff-node-right-path node))) (when (and @@ -188,7 +196,7 @@ including . and ..") (defun ztree-diff-simple-diff-files () - "Create a simple diff buffer for files from left and right panels" + "Create a simple diff buffer for files from left and right panels." (interactive) (let ((found (ztree-find-node-at-point))) (when found @@ -196,16 +204,16 @@ including . and ..") (ztree-diff-simple-diff node))))) (defun ztree-diff-node-action (node hard) - "Perform action on node: + "Perform action on NODE: 1 if both left and right sides present: 1.1 if they are differend - 1.1.1 if hard ediff + 1.1.1 if HARD ediff 1.1.2 simple diff otherwiste 1.2 if they are the same - view left 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)) - (open-f '(lambda (path) (if hard (find-file path) + (open-f #'(lambda (path) (if hard (find-file path) (let ((split-width-threshold nil)) (view-file-other-window path)))))) (cond ((and left right) @@ -217,10 +225,13 @@ including . and ..") (left (funcall open-f left)) (right (funcall open-f right)) (t nil)))) - + (defun ztree-diff-copy-file (node source-path destination-path copy-to-right) + "Update the NODE status and copy the file. +File copied from SOURCE-PATH to DESTINATION-PATH. +COPY-TO-RIGHT specifies which side of the NODE to update." (let ((target-path (concat (file-name-as-directory destination-path) (file-name-nondirectory @@ -247,6 +258,9 @@ including . and ..") (defun ztree-diff-copy-dir (node source-path destination-path copy-to-right) + "Update the NODE status and copy the directory. +Directory copied from SOURCE-PATH to DESTINATION-PATH. +COPY-TO-RIGHT specifies which side of the NODE to update." (let* ((src-path (file-name-as-directory source-path)) (target-path (file-name-as-directory destination-path)) (target-full-path (concat @@ -275,6 +289,7 @@ including . and ..") (defun ztree-diff-copy () + "Copy the file under the cursor to other side." (interactive) (let ((found (ztree-find-node-at-point))) (when found @@ -320,7 +335,7 @@ including . and ..") copy-to-right)))))))) (defun ztree-diff-view-file () - "View file at point, depending on side" + "View file at point, depending on side." (interactive) (let ((found (ztree-find-node-at-point))) (when found @@ -337,9 +352,10 @@ including . and ..") ((and (eq side 'right) node-right) (view-file node-right)))))))) - + (defun ztree-diff-delete-file () + "Delete the file under the cursor." (interactive) (let ((found (ztree-find-node-at-point))) (when found @@ -364,19 +380,19 @@ including . and ..") (when (yes-or-no-p (format "Delete the file [%s]%s ?" (if delete-from-left "LEFT" "RIGHT") remove-path)) - (let* ((delete-command + (let* ((delete-command (if (file-directory-p remove-path) '(delete-directory remove-path t) '(delete-file remove-path t))) (children (ztree-diff-node-children parent)) - (err + (err (condition-case error-trap (progn (eval delete-command) nil) (error error-trap)))) (if err (message (concat "Error: " (nth 2 err))) - (progn + (progn (setq children (ztree-filter #'(lambda (x) (not (ztree-diff-node-equal x node))) children)) @@ -387,25 +403,29 @@ including . and ..") (defun ztree-node-is-in-filter-list (node) - "Determine if the node is in filter list (and therefore -apparently shall not be visible" + "Determine if the NODE is in filter list. +If the node is in the filter list it shall not be visible" (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx node)))) (defun ztree-node-is-visible (node) + "Determine if the NODE should be visible." (and (ztree-diff-node-parent node) ; parent is always visible (not (ztree-node-is-in-filter-list (ztree-diff-node-short-name node))) (or ztree-diff-show-equal-files (ztree-diff-node-different node)))) (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)) (ztree-refresh-buffer)) ;;;###autoload (defun ztree-diff (dir1 dir2) - "Creates an interactive buffer with the directory tree of the path given" + "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)) (buf-name (concat "*" @@ -413,7 +433,6 @@ apparently shall not be visible" " <--> " (ztree-diff-node-right-short-name difference) "*"))) - (setq ztree-diff-filter-list (list ztree-diff-hidden-files-regexp)) (ztree-view buf-name difference 'ztree-node-is-visible @@ -428,7 +447,7 @@ apparently shall not be visible" (ztreediff-mode) (setq ztree-diff-dirs-pair (cons dir1 dir2)) (ztree-refresh-buffer))) - +