Fix some quoting problems in doc strings

[gnu-emacs-elpa] / packages / ztree / ztree-diff.el

diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el
index ff9b3235f1207de464b1bb920410dba88107c230..cfd0c967cd97458830c6924550384766458ab290 100644 (file)
--- 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; -*-
 
 ;;; 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 <alexey dot veretennikov at gmail dot com>
-;; 
-;; Created: 2013-11-1l
+;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
+;;
+;; Created: 2013-11-11

 ;;
 ;; Keywords: files tools
 ;; URL: https://github.com/fourier/ztree
 ;;
 ;; Keywords: files tools
 ;; URL: https://github.com/fourier/ztree


@@ -33,7 +33,7 @@
 
 (defconst ztree-diff-hidden-files-regexp "^\\."
   "Hidden files regexp.
 
 (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)
 
 (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)
 
   :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
 (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)
 
 
   "*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")
   "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.")
   "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.")
   "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.")
 
   "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."
 ;;;###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 "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)))
     ([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)
           ((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."
 
 (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 " 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")
   (insert "\n")

+

   (ztree-insert-with-face "==============" ztreep-diff-header-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)))
     (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 ()
 
 
 (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))
 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)
         (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)
                (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)))
                  (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)
 
 
 (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
                      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 ()
 
 
 (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))
       (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
                 (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."
 
 (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))
 
 (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))
   (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))
 
 
   (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 ")
 ;;;###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 "*"
          (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
     (ztree-view buf-name

-                difference
+                model

                 'ztree-node-is-visible
                 'ztree-diff-insert-buffer-header
                 'ztree-diff-node-short-name-wrapper
                 '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-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))
     (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)))
 
 
 
 
     (ztree-refresh-buffer)))
 
 
 
 

+
+

 (provide 'ztree-diff)
 ;;; ztree-diff.el ends here
 (provide 'ztree-diff)
 ;;; ztree-diff.el ends here