X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/30984c4c4be84d1f2b71ab6f8a57886cc630f080..5b702fc580115644e691f8f0dff4c6cc16366c5f:/packages/ztree/ztree-diff-model.el diff --git a/packages/ztree/ztree-diff-model.el b/packages/ztree/ztree-diff-model.el index 572d9766b..7bec4619b 100644 --- a/packages/ztree/ztree-diff-model.el +++ b/packages/ztree/ztree-diff-model.el @@ -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, @@ -53,7 +54,12 @@ ;; 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)