]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/ztree/ztree-diff-model.el
Merge '0c8e5e554199814c25258bc93b64dc008a9ab840', register assoc early.
[gnu-emacs-elpa] / packages / ztree / ztree-diff-model.el
index 572d9766b781295fef2b03ee26f4e9cda7e08caa..7bec4619b633757b4ee998a855b23476ea1a8af9 100644 (file)
@@ -1,4 +1,4 @@
-;;; ztree-diff-model.el --- diff model for directory trees
+;;; ztree-diff-model.el --- diff model for directory trees -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2013-2015  Free Software Foundation, Inc.
 ;;
@@ -8,7 +8,7 @@
 ;;
 ;; Keywords: files tools
 ;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs GNU Emacs 24.x
+;; Compatibility: GNU Emacs 24.x
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -36,6 +36,9 @@
   "Message showing while constructing the diff tree.")
 (make-variable-buffer-local 'ztree-diff-model-wait-message)
 
+(defvar ztree-diff-model-ignore-fun nil
+  "Function which determines if the node should be excluded from comparison.")
+(make-variable-buffer-local 'ztree-diff-model-ignore-fun)
 
 (defun ztree-diff-model-update-wait-message ()
   "Update the wait mesage with one more '.' progress indication."
@@ -43,9 +46,7 @@
     (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message "."))
     (message ztree-diff-model-wait-message)))
 
-
-
-;; Create a record ztree-diff-node with defined fielsd and getters/setters
+;; Create a record ztree-diff-node with defined fields and getters/setters
 ;; here:
 ;; parent - parent node
 ;; left-path is the full path on the left side of the diff window,
 ;; short-name - is the file or directory name
 ;; children - list of nodes - files or directories if the node is a directory
 ;; different = {nil, 'new, 'diff} - means comparison status
-(defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different))
+(ztree-defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different))
+
+(defun ztree-diff-model-ignore-p (node)
+  "Determine if the NODE should be excluded from comparison results."
+  (when ztree-diff-model-ignore-fun
+    (funcall ztree-diff-model-ignore-fun node)))
 
 (defun ztree-diff-node-to-string (node)
   "Construct the string with contents of the NODE given."
@@ -79,7 +85,7 @@
             "\n"
             " * Children: " ch-str
             "\n")))
-                          
+
 
 (defun ztree-diff-node-short-name-wrapper (node &optional right-side)
   "Return the short name of the NODE given.
@@ -139,7 +145,7 @@ Returns t if equal."
 (defun ztree-directory-files (dir)
   "Return the list of full paths of files in a directory DIR.
 Filters out . and .."
-  (ztree-filter #'(lambda (file) (let ((simple-name (file-short-name file)))
+  (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name file)))
                                    (not (or (string-equal simple-name ".")
                                             (string-equal simple-name "..")))))
                 (directory-files dir 'full)))
@@ -157,12 +163,12 @@ Filters out . and .."
                (file-exists-p left)
                (file-exists-p right))
       (if isdir
-        (let ((traverse (ztree-diff-node-traverse
-                         node
-                         left
-                         right)))
-          (ztree-diff-node-set-different node (car traverse))
-          (ztree-diff-node-set-children node (cdr traverse)))
+          (let ((traverse (ztree-diff-node-traverse
+                           node
+                           left
+                           right)))
+            (ztree-diff-node-set-different node (car traverse))
+            (ztree-diff-node-set-children node (cdr traverse)))
         ;; node is a file
         (ztree-diff-node-set-different
          node
@@ -181,8 +187,8 @@ Argument SIDE either 'left or 'right side."
                         parent
                         (when (eq side 'left) file)
                         (when (eq side 'right) file)
-                        (file-short-name file)
-                        (file-short-name file)
+                        (ztree-file-short-name file)
+                        (ztree-file-short-name file)
                         nil
                         'new))
                  (children (ztree-diff-model-subtree node file side)))
@@ -192,8 +198,8 @@ Argument SIDE either 'left or 'right side."
                parent
                (when (eq side 'left) file)
                (when (eq side 'right) file)
-               (file-short-name file)
-               (file-short-name file)
+               (ztree-file-short-name file)
+               (ztree-file-short-name file)
                nil
                'new)
               result)))
@@ -204,10 +210,11 @@ Argument SIDE either 'left or 'right side."
   (let ((children (ztree-diff-node-children node))
         (diff nil))
     (dolist (child children)
-      (setq diff
-            (ztree-diff-model-update-diff
-             diff
-             (ztree-diff-node-different child))))
+      (unless (ztree-diff-model-ignore-p child)
+        (setq diff
+              (ztree-diff-model-update-diff
+               diff
+               (ztree-diff-node-different child)))))
     (ztree-diff-node-set-different node diff)))
 
 (defun ztree-diff-node-update-all-parents-diff (node)
@@ -240,7 +247,7 @@ the rest is the combined list of nodes."
     (dolist (file1 list1)
       ;; for every entry in the first directory
       ;; we are creating the node
-      (let* ((simple-name (file-short-name file1))
+      (let* ((simple-name (ztree-file-short-name file1))
              (isdir (file-directory-p file1))
              (children nil)
              (different nil)
@@ -250,7 +257,7 @@ the rest is the combined list of nodes."
              ;; 1. find if the file is in the second directory and the type
              ;;    is the same - i.e. both are directories or both are files
              (file2 (ztree-find list2
-                                #'(lambda (x) (and (string-equal (file-short-name x)
+                                #'(lambda (x) (and (string-equal (ztree-file-short-name x)
                                                                  simple-name)
                                                    (eq isdir (file-directory-p x)))))))
         ;; 2. if it is not in the second directory, add it as a node
@@ -274,12 +281,14 @@ the rest is the combined list of nodes."
               (setq different (car traverse))
               ;; 3.2.3 set the children list from the 2 subdirectories comparison
               (setq children (cdr traverse)))))
-        ;; 2.3 update difference status for the whole comparison
-        (setq different-dir (ztree-diff-model-update-diff different-dir different))
         ;; update calculated parameters of the node
         (ztree-diff-node-set-right-path node file2)
         (ztree-diff-node-set-children node children)
         (ztree-diff-node-set-different node different)
+        ;; 2.3 update difference status for the whole comparison
+        ;; depending if the node should participate in overall result
+        (unless (ztree-diff-model-ignore-p node)
+          (setq different-dir (ztree-diff-model-update-diff different-dir different)))
         ;; push the created node to the result list
         (push node result)))
     ;; second - adding entries from the right directory which are not present
@@ -287,7 +296,7 @@ the rest is the combined list of nodes."
     (dolist (file2 list2)
       ;; for every entry in the second directory
       ;; we are creating the node
-      (let* ((simple-name (file-short-name file2))
+      (let* ((simple-name (ztree-file-short-name file2))
              (isdir (file-directory-p file2))
              (children nil)
              ;; create the node to be added to the results list
@@ -295,34 +304,40 @@ the rest is the combined list of nodes."
              ;; 1. find if the file is in the first directory and the type
              ;;    is the same - i.e. both are directories or both are files
              (file1 (ztree-find list1
-                                #'(lambda (x) (and (string-equal (file-short-name x)
+                                #'(lambda (x) (and (string-equal (ztree-file-short-name x)
                                                                  simple-name)
                                                    (eq isdir (file-directory-p x)))))))
         ;; if it is not in the first directory, add it as a node
-        (when (not file1)
+        (unless file1
           ;; if it is a directory, set the whole subtree to children
           (when (file-directory-p file2)
             (setq children (ztree-diff-model-subtree node file2 'right)))
-          ;; update the different status for the whole comparison
-          (setq different-dir (ztree-diff-model-update-diff different-dir 'new))
           ;; set calculated children to the node
           (ztree-diff-node-set-children node children)
+          ;; update the different status for the whole comparison
+          ;; depending if the node should participate in overall result
+          (unless (ztree-diff-model-ignore-p node)
+            (setq different-dir (ztree-diff-model-update-diff different-dir 'new)))
           ;; push the created node to the result list
           (push node result))))
     ;; result is a pair: difference status and nodes list
     (cons different-dir result)))
 
-(defun ztree-diff-model-create (dir1 dir2)
-  "Create a node based on DIR1 and DIR2."
-  (when (not (file-directory-p dir1))
+(defun ztree-diff-model-create (dir1 dir2 &optional ignore-p)
+  "Create a node based on DIR1 and DIR2.
+IGNORE-P is the optional filtering function, taking node as
+an argument, which determines if the node should be excluded
+from comparison."
+  (unless (file-directory-p dir1)
     (error "Path %s is not a directory" dir1))
-  (when (not (file-directory-p dir2))
+  (unless (file-directory-p dir2)
     (error "Path %s is not a directory" dir2))
+  (setf ztree-diff-model-ignore-fun ignore-p)
   (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
   (let* ((model
           (ztree-diff-node-create nil dir1 dir2
-                                  (file-short-name dir1)
-                                  (file-short-name dir2)
+                                  (ztree-file-short-name dir1)
+                                  (ztree-file-short-name dir2)
                                   nil
                                   nil))
          (traverse (ztree-diff-node-traverse model dir1 dir2)))
@@ -341,7 +356,7 @@ the rest is the combined list of nodes."
     (ztree-diff-node-set-children node (cdr traverse))
     (ztree-diff-node-set-different node (car traverse))
     (message "Done.")))
-    
+
 
 
 (provide 'ztree-diff-model)