branch: master
commit a136ff87271a7a4bf363a4d8bf07429db9bacaf4
Merge: e7f3aa4 a7c5489
Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
Commit: Alexey Veretennikov <alexey.veretenni...@gmail.com>
Merged from upstream with StefanM's changes
---
packages/ztree/README.md | 21 ++-
packages/ztree/ztree-diff-model.el | 386 +++++++++++++++++++-----------------
packages/ztree/ztree-diff.el | 274 ++++++++++++++++----------
packages/ztree/ztree-dir.el | 56 +++++-
packages/ztree/ztree-util.el | 6 +-
packages/ztree/ztree-view.el | 192 ++++++++++--------
packages/ztree/ztree.el | 4 +-
7 files changed, 558 insertions(+), 381 deletions(-)
diff --git a/packages/ztree/README.md b/packages/ztree/README.md
index f96adb4..dc1907a 100644
--- a/packages/ztree/README.md
+++ b/packages/ztree/README.md
@@ -54,7 +54,9 @@ Then you need to specify the left and right directories to
compare.
* `F5` forces the full rescan.
### Customizations
-By default all files starting with dot (like `.gitignore`) are not shown and
excluded from the difference status for directories. One can add an additional
regexps to the list `ztree-diff-filter-list`.
+By default all files starting with dot (like `.gitignore`) are not shown and
excluded from the difference status for directories. One can add an additional
regexps to the list `ztree-diff-filter-list`.
+
+One also could turn on unicode characters to draw the tree with instead of
normal ASCII-characters. This is controlled by the `ztree-draw-unicode-lines`
variable.
### Screenshots
@@ -87,3 +89,20 @@ Set the `ztree-dir-move-focus` variable to `t` in order to
move focus to the oth
+
+## Contributions
+You can contribute to **ztree** in one of the following ways.
+- Submit a bug report
+- Submit a feature request
+- Submit a simple pull request (with changes < 15 lines)
+
+### Copyright issues
+Since **ztree** is a part of [GNU ELPA](https://elpa.gnu.org/), it is
copyrighted by the [Free Software Foundation, Inc.](http://www.fsf.org/).
Therefore in order to submit nontrivial changes (with total amount of lines >
15), one needs to to grant the right to include your works in GNU Emacs to the
FSF.
+
+For this you need to complete
[this](https://raw.githubusercontent.com/fourier/ztree/contributions/request-assign.txt)
form, and send it to [ass...@gnu.org](mailto:ass...@gnu.org). The FSF will
send you the assignment contract that both you and the FSF will sign.
+
+For more information one can read
[here](http://www.gnu.org/licenses/why-assign.html) to understand why it is
needed.
+
+As soon as the paperwork is done one can contribute to **ztree** with bigger
pull requests.
+Note what pull requests without paperwork done will not be accepted, so please
notify the [maintainer](mailto:alexey.veretenni...@gmail.com) if everything is
in place.
+
diff --git a/packages/ztree/ztree-diff-model.el
b/packages/ztree/ztree-diff-model.el
index f0b4e4a..b4ad75f 100644
--- a/packages/ztree/ztree-diff-model.el
+++ b/packages/ztree/ztree-diff-model.el
@@ -1,10 +1,10 @@
;;; ztree-diff-model.el --- diff model 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>
+;; Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
;;
-;; Created: 2013-11-1l
+;; Created: 2013-11-11
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
@@ -33,19 +33,17 @@
(require 'ztree-util)
(eval-when-compile (require 'cl-lib))
-(defvar ztree-diff-model-wait-message nil
- "Message showing while constructing the diff tree.")
-(make-variable-buffer-local 'ztree-diff-model-wait-message)
-
-(defvar ztree-diff-model-ignore-fun nil
+(defvar-local 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."
- (when ztree-diff-model-wait-message
- (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message
"."))
- (message ztree-diff-model-wait-message)))
+(defvar-local ztree-diff-model-progress-fun nil
+ "Function which should be called whenever the progress indications is
updated.")
+
+
+(defun ztree-diff-model-update-progress ()
+ "Update the progress."
+ (when ztree-diff-model-progress-fun
+ (funcall ztree-diff-model-progress-fun)))
;; Create a record ztree-diff-node with defined fields and getters/setters
;; here:
@@ -54,16 +52,19 @@
;; right-path is the full path of the right side,
;; 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
+;; different = {nil, 'same, 'new, 'diff, 'ignore} - means comparison status
(cl-defstruct (ztree-diff-node
(:constructor)
(:constructor ztree-diff-node-create
(parent left-path right-path
different
- &aux (short-name (ztree-file-short-name
- (or left-path right-path)))
- (right-short-name (ztree-file-short-name
- (or right-path left-path))))))
+ &aux
+ (short-name (ztree-file-short-name
+ (or left-path right-path)))
+ (right-short-name
+ (if (and left-path right-path)
+ (ztree-file-short-name right-path)
+ short-name)))))
parent left-path right-path short-name right-short-name children different)
(defun ztree-diff-model-ignore-p (node)
@@ -73,22 +74,26 @@
(defun ztree-diff-node-to-string (node)
"Construct the string with contents of the NODE given."
- (let* ((string-or-nil #'(lambda (x) (if x
- (cond ((stringp x) x)
- ((eq x 'new) "new")
- ((eq x 'diff) "different")
- (t (ztree-diff-node-short-name
x)))
- "(empty)")))
- (children (ztree-diff-node-children node))
- (ch-str ""))
+ (let ((string-or-nil #'(lambda (x) (if x
+ (cond ((stringp x) x)
+ ((eq x 'new) "new")
+ ((eq x 'diff) "different")
+ ((eq x 'ignore) "ignored")
+ ((eq x 'same) "same")
+ (t (ztree-diff-node-short-name
x)))
+ "(empty)")))
+ (children (ztree-diff-node-children node))
+ (ch-str ""))
(dolist (x children)
- (setq ch-str (concat ch-str "\n * " (ztree-diff-node-short-name x))))
+ (setq ch-str (concat ch-str "\n * " (ztree-diff-node-short-name x)
+ ": "
+ (funcall string-or-nil (ztree-diff-node-different
x)))))
(concat "Node: " (ztree-diff-node-short-name node)
"\n"
- ;; " * Parent: " (let ((parent (ztree-diff-node-parent node)))
- ;; (if parent (ztree-diff-node-short-name parent)
"nil"))
" * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
"\n"
+ " * Status: " (funcall string-or-nil (ztree-diff-node-different
node))
+ "\n"
" * Left path: " (funcall string-or-nil (ztree-diff-node-left-path
node))
"\n"
" * Right path: " (funcall string-or-nil
(ztree-diff-node-right-path node))
@@ -123,6 +128,7 @@ RIGHT if only on the right side."
(if (and left right) 'both
(if left 'left 'right))))
+
(defun ztree-diff-node-equal (node1 node2)
"Determines if NODE1 and NODE2 are equal."
(and (string-equal (ztree-diff-node-short-name node1)
@@ -156,9 +162,9 @@ Returns t if equal."
;; file(1|2).
(let* ((file1-untrampified (ztree-diff-untrampify-filename
(ztree-diff-modef-quotify-string file1)))
(file2-untrampified (ztree-diff-untrampify-filename
(ztree-diff-modef-quotify-string file2)))
- (diff-command (concat "diff -q" " " file1-untrampified " "
file2-untrampified))
+ (diff-command (concat diff-command " -q" " " file1-untrampified " "
file2-untrampified))
(diff-output (shell-command-to-string diff-command)))
- (not (> (length diff-output) 2))))
+ (if (<= (length diff-output) 2) 'same 'diff)))
(defun ztree-directory-files (dir)
"Return the list of full paths of files in a directory DIR.
@@ -169,32 +175,29 @@ Filters out . and .."
(directory-files dir 'full)))
(defun ztree-diff-model-partial-rescan (node)
- "Rescan the NODE."
- ;; assuming what parent is always exists
- ;; otherwise the UI shall force the full rescan
- (let ((isdir (ztree-diff-node-is-directory node))
- (left (ztree-diff-node-left-path node))
- (right (ztree-diff-node-right-path node)))
- ;; if node is a directory - traverse
- (when (and left right
- (file-exists-p left)
- (file-exists-p right))
- (if isdir
- (let ((traverse (ztree-diff-node-traverse
- node
- left
- right)))
- (setf (ztree-diff-node-different node) (car traverse))
- (setf (ztree-diff-node-children node) (cdr traverse)))
- ;; node is a file
- (setf (ztree-diff-node-different node)
- (if (ztree-diff-model-files-equal left right)
- nil
- 'diff))))))
-
-(defun ztree-diff-model-subtree (parent path side)
+ "Rescan the NODE.
+The node is a either a file or directory with both
+left and right parts existing."
+ ;; if a directory - recreate
+ (if (ztree-diff-node-is-directory node)
+ (ztree-diff-node-recreate node)
+ ;; if a file, change a status
+ (setf (ztree-diff-node-different node)
+ (if (or (ztree-diff-model-ignore-p node) ; if should be ignored
+ (eql (ztree-diff-node-different node) 'ignore) ; was ignored
+ (eql (ztree-diff-node-different ; or parent was ignored
+ (ztree-diff-node-parent node))
+ 'ignore))
+ 'ignore
+ (ztree-diff-model-files-equal (ztree-diff-node-left-path node)
+ (ztree-diff-node-right-path node)))))
+ ;; update all parents statuses
+ (ztree-diff-node-update-all-parents-diff node))
+
+(defun ztree-diff-model-subtree (parent path side diff)
"Create a subtree with given PARENT for the given PATH.
-Argument SIDE either 'left or 'right side."
+Argument SIDE either 'left or 'right side.
+Argument DIFF different status to be assigned to all created nodes."
(let ((files (ztree-directory-files path))
(result nil))
(dolist (file files)
@@ -203,29 +206,26 @@ Argument SIDE either 'left or 'right side."
parent
(when (eq side 'left) file)
(when (eq side 'right) file)
- 'new))
- (children (ztree-diff-model-subtree node file side)))
+ diff))
+ (children (ztree-diff-model-subtree node file side diff)))
(setf (ztree-diff-node-children node) children)
(push node result))
(push (ztree-diff-node-create
parent
(when (eq side 'left) file)
(when (eq side 'right) file)
- 'new)
+ diff)
result)))
result))
(defun ztree-diff-node-update-diff-from-children (node)
"Set the diff status for the NODE based on its children."
- (let ((children (ztree-diff-node-children node))
- (diff nil))
- (dolist (child children)
- (unless (ztree-diff-model-ignore-p child)
- (setq diff
- (ztree-diff-model-update-diff
- diff
- (ztree-diff-node-different child)))))
- (setf (ztree-diff-node-different node) diff)))
+ (unless (eql (ztree-diff-node-different node) 'ignore)
+ (let ((diff (cl-reduce #'ztree-diff-model-update-diff
+ (ztree-diff-node-children node)
+ :initial-value 'same
+ :key 'ztree-diff-node-different)))
+ (setf (ztree-diff-node-different node) diff))))
(defun ztree-diff-node-update-all-parents-diff (node)
"Recursively update all parents diff status for the NODE."
@@ -235,135 +235,159 @@ Argument SIDE either 'left or 'right side."
(defun ztree-diff-model-update-diff (old new)
- "Get the diff status depending if OLD or NEW is not nil."
- (if new
- (if (or (not old)
- (eq old 'new))
- new
- old)
- old))
-
-(defun ztree-diff-node-traverse (parent path1 path2)
- "Traverse 2 paths creating the list nodes with PARENT defined and diff
status.
-Function traversing 2 paths PATH1 and PATH2 returning the list where the
-first element is the difference status (nil, 'diff, 'new') and
-the rest is the combined list of nodes."
- (let ((list1 (ztree-directory-files path1))
- (list2 (ztree-directory-files path2))
- (different-dir nil)
- (result nil))
- (ztree-diff-model-update-wait-message)
+ "Get the diff status depending if OLD or NEW is not nil.
+If the OLD is 'ignore, do not change anything"
+ ;; if the old whole directory is ignored, ignore children's status
+ (cond ((eql old 'ignore) 'ignore)
+ ;; if the new status is ignored, use old
+ ((eql new 'ignore) old)
+ ;; if the old or new status is different, return different
+ ((or (eql old 'diff)
+ (eql new 'diff)) 'diff)
+ ;; if new is 'new, return new
+ ((eql new 'new) 'new)
+ ;; all other cases return old
+ (t old)))
+
+(defun ztree-diff-node-update-diff-from-parent (node)
+ "Recursively update diff status of all children of NODE.
+This function will traverse through all children recursively
+setting status from the NODE, unless they have an ignore status"
+ (let ((status (ztree-diff-node-different node))
+ (children (ztree-diff-node-children node)))
+ ;; if the parent has ignore status, force all kids this status
+ ;; otherwise only update status when the child status is not ignore
+ (mapc (lambda (child)
+ (when (or (eql status 'ignore)
+ (not
+ (or (eql status 'ignore)
+ (eql (ztree-diff-node-different child) 'ignore))))
+ (setf (ztree-diff-node-different child) status)
+ (ztree-diff-node-update-diff-from-parent child)))
+ children)))
+
+
+
+(defun ztree-diff-model-find-in-files (list shortname is-dir)
+ "Find in LIST of files the file with name SHORTNAME.
+If IS-DIR searching for directories; assume files otherwise"
+ (ztree-find list
+ (lambda (x) (and (string-equal (ztree-file-short-name x)
+ shortname)
+ (eq is-dir (file-directory-p x))))))
+
+
+(defun ztree-diff-model-should-ignore (node)
+ "Determine if the NODE and its children should be ignored.
+If no parent - never ignore;
+if in ignore list - ignore
+if parent has ignored status - ignore"
+ (let ((parent (ztree-diff-node-parent node)))
+ (and parent
+ (or (eql (ztree-diff-node-different parent) 'ignore)
+ (ztree-diff-model-ignore-p node)))))
+
+
+(defun ztree-diff-node-recreate (node)
+ "Traverse 2 paths defined in the NODE updating its children and status."
+ (let* ((list1 (ztree-directory-files (ztree-diff-node-left-path node))) ;;
left list of liles
+ (list2 (ztree-directory-files (ztree-diff-node-right-path node))) ;;
right list of files
+ (should-ignore (ztree-diff-model-should-ignore node))
+ ;; status automatically assigned to children of the node
+ (children-status (if should-ignore 'ignore 'new))
+ (children nil)) ;; list of children
+ ;; update waiting status
+ (ztree-diff-model-update-progress)
+ ;; update node status ignore status either inhereted from the
+ ;; parent or the own
+ (when should-ignore
+ (setf (ztree-diff-node-different node) 'ignore))
;; first - adding all entries from left directory
(dolist (file1 list1)
;; for every entry in the first directory
;; we are creating the node
(let* ((simple-name (ztree-file-short-name file1))
(isdir (file-directory-p file1))
- (children nil)
- (different nil)
- ;; create the current node to be set as parent to
- ;; subdirectories
- (node (ztree-diff-node-create parent file1 nil nil))
- ;; 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
(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
- (if (not file2)
- (progn
- ;; 2.1 if it is a directory, add the whole subtree
- (when (file-directory-p file1)
- (setq children (ztree-diff-model-subtree node file1 'left)))
- ;; 2.2 update the difference status for this entry
- (setq different 'new))
- ;; 3. if it is found in second directory and of the same type
- ;; 3.1 if it is a file
- (if (not (file-directory-p file1))
- ;; 3.1.1 set difference status to this entry
- (setq different (if (ztree-diff-model-files-equal file1 file2)
nil 'diff))
- ;; 3.2 if it is the directory
- ;; 3.2.1 get the result of the directories comparison together
with status
- (let ((traverse (ztree-diff-node-traverse node file1 file2)))
- ;; 3.2.2 update the difference status for whole comparison from
- ;; difference result from the 2 subdirectories comparison
- (setq different (car traverse))
- ;; 3.2.3 set the children list from the 2 subdirectories
comparison
- (setq children (cdr traverse)))))
- ;; update calculated parameters of the node
- (setf (ztree-diff-node-right-path node) file2)
- (setf (ztree-diff-node-children node) children)
- (setf (ztree-diff-node-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)))
+ ;; 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-diff-model-find-in-files list2 simple-name isdir))
+ ;; create a child. The current node is a parent
+ ;; new by default - will be overriden below if necessary
+ (child
+ (ztree-diff-node-create node file1 file2 children-status)))
+ ;; update child own ignore status
+ (when (ztree-diff-model-should-ignore child)
+ (setf (ztree-diff-node-different child) 'ignore))
+ ;; if exists on a right side with the same type,
+ ;; remove from the list of files on the right side
+ (when file2
+ (setf list2 (cl-delete file2 list2 :test #'string-equal)))
+ (cond
+ ;; when exist just on a left side and is a directory, add all
+ ((and isdir (not file2))
+ (setf (ztree-diff-node-children child)
+ (ztree-diff-model-subtree child
+ file1
+ 'left
+ (ztree-diff-node-different child))))
+ ;; if 1) exists on both sides and 2) it is a file
+ ;; and 3) not ignored file
+ ((and file2 (not isdir) (not (eql (ztree-diff-node-different child)
'ignore)))
+ (setf (ztree-diff-node-different child)
+ (ztree-diff-model-files-equal file1 file2)))
+ ;; if exists on both sides and it is a directory, traverse further
+ ((and file2 isdir)
+ (ztree-diff-node-recreate child)))
+ ;; push the created node to the children list
+ (push child children)))
;; second - adding entries from the right directory which are not present
;; in the left directory
(dolist (file2 list2)
;; for every entry in the second directory
;; we are creating the node
- (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
- (node (ztree-diff-node-create parent nil file2 'new))
- ;; 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
(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
- (unless file1
+ (let* ((isdir (file-directory-p file2))
+ ;; create the child to be added to the results list
+ (child
+ (ztree-diff-node-create node nil file2 children-status)))
+ ;; update ignore status of the child
+ (when (ztree-diff-model-should-ignore child)
+ (setf (ztree-diff-node-different child) 'ignore))
;; 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)))
- ;; set calculated children to the node
- (setf (ztree-diff-node-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 &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))
- (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 nil))
- (traverse (ztree-diff-node-traverse model dir1 dir2)))
- (setf (ztree-diff-node-children model) (cdr traverse))
- (setf (ztree-diff-node-different model) (car traverse))
- (message "Done.")
- model))
+ (when isdir
+ (setf (ztree-diff-node-children child)
+ (ztree-diff-model-subtree child
+ file2
+ 'right
+ (ztree-diff-node-different child))))
+ ;; push the created node to the result list
+ (push child children)))
+ ;; finally set different status based on all children
+ ;; depending if the node should participate in overall result
+ (unless should-ignore
+ (setf (ztree-diff-node-different node)
+ (cl-reduce #'ztree-diff-model-update-diff
+ children
+ :initial-value 'same
+ :key 'ztree-diff-node-different)))
+ ;; and set children
+ (setf (ztree-diff-node-children node) children)))
+
(defun ztree-diff-model-update-node (node)
"Refresh the NODE."
- (setq ztree-diff-model-wait-message
- (concat "Updating " (ztree-diff-node-short-name node) " ..."))
- (let ((traverse (ztree-diff-node-traverse node
- (ztree-diff-node-left-path node)
- (ztree-diff-node-right-path
node))))
- (setf (ztree-diff-node-children node) (cdr traverse))
- (setf (ztree-diff-node-different node) (car traverse))
- (message "Done.")))
+ (ztree-diff-node-recreate node))
+
+
+(defun ztree-diff-model-set-ignore-fun (ignore-p)
+ "Set the buffer-local ignore function to IGNORE-P.
+Ignore function is a function of one argument (ztree-diff-node)
+which returns t if the node should be ignored (like files starting
+with dot etc)."
+ (setf ztree-diff-model-ignore-fun ignore-p))
+(defun ztree-diff-model-set-progress-fun (progess-fun)
+ (setf ztree-diff-model-progress-fun progess-fun))
(provide 'ztree-diff-model)
diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el
index ea66a6e..ed3d5f9 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 <alexey dot veretennikov at gmail dot com>
+;; Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
;;
-;; Created: 2013-11-1l
+;; Created: 2013-11-11
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
@@ -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 ()
@@ -220,10 +237,10 @@ Argument NODE node containing paths to files to call a
diff on."
;; 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))))))
+ (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)
@@ -251,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
- (setf (ztree-diff-node-different node) nil)
- ;; 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)))))))
+ ;; 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)
@@ -281,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
- (setf (ztree-diff-node-right-path node)
- target-full-path)
- (setf (ztree-diff-node-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 ()
@@ -368,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))
- (setf (ztree-diff-node-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))))))))
@@ -433,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
@@ -481,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
diff --git a/packages/ztree/ztree-dir.el b/packages/ztree/ztree-dir.el
index 08f4041..d3d3b25 100644
--- a/packages/ztree/ztree-dir.el
+++ b/packages/ztree/ztree-dir.el
@@ -1,10 +1,10 @@
;;; ztree-dir.el --- Text mode directory tree -*- 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>
+;; Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
;;
-;; Created: 2013-11-1l
+;; Created: 2013-11-11
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
@@ -45,6 +45,7 @@
(require 'ztree-util)
(require 'ztree-view)
+(eval-when-compile (require 'cl-lib))
;;
;; Constants
@@ -60,7 +61,18 @@ By default all filest starting with dot '.', including . and
..")
(defvar ztree-dir-move-focus nil
"If set to true moves the focus to opened window when the
-user press RETURN on file ")t
+user press RETURN on file ")
+
+(defvar-local ztree-dir-filter-list (list ztree-hidden-files-regexp)
+ "List of regexp file names to filter out.
+By default paths starting with dot (like .git) are ignored.
+One could add own filters in the following way:
+
+(setq-default ztree-dir-filter-list (cons \"^.*\\.pyc\" ztree-dir-filter-list))
+")
+
+(defvar-local ztree-dir-show-filtered-files nil
+ "Show or not files from the filtered list.")
;;
@@ -76,6 +88,19 @@ user press RETURN on file ")t
(defvar ztreep-header-face 'ztreep-header-face)
+(define-minor-mode ztreedir-mode
+ "A minor mode for displaying the directory trees in text mode."
+ ;; initial value
+ nil
+ ;; modeline name
+ " Dir"
+ ;; The minor mode keymap
+ `(
+ (,(kbd "H") . ztree-dir-toggle-show-filtered-files)))
+
+
+
+
;;
;; File bindings to the directory tree control
;;
@@ -91,8 +116,12 @@ user press RETURN on file ")t
(defun ztree-file-not-hidden (filename)
"Determines if the file with FILENAME should be visible."
- (not (string-match ztree-hidden-files-regexp
- (ztree-file-short-name filename))))
+ (let ((name (ztree-file-short-name filename)))
+ (and (not (or (string= name ".") (string= name "..")))
+ (or
+ ztree-dir-show-filtered-files
+ (not (cl-find-if (lambda (rx) (string-match rx name))
ztree-dir-filter-list))))))
+
(defun ztree-find-file (node hard)
"Find the file at NODE.
@@ -107,6 +136,17 @@ Otherwise, the ztree window is used to find the file."
(t
(find-file node)))))
+
+(defun ztree-dir-toggle-show-filtered-files ()
+ "Toggle visibility of the filtered files."
+ (interactive)
+ (setq ztree-dir-show-filtered-files (not ztree-dir-show-filtered-files))
+ (message (concat (if ztree-dir-show-filtered-files "Show" "Hide") " filtered
files"))
+ (ztree-refresh-buffer))
+
+
+
+
;;;###autoload
(defun ztree-dir (path)
"Create an interactive buffer with the directory tree of the PATH given."
@@ -122,7 +162,9 @@ Otherwise, the ztree window is used to find the file."
#'string-equal
(lambda (x) (directory-files x 'full))
nil ; face
- #'ztree-find-file)))) ; action
+ #'ztree-find-file) ; action
+ (ztreedir-mode))))
+
(provide 'ztree-dir)
diff --git a/packages/ztree/ztree-util.el b/packages/ztree/ztree-util.el
index 40fe12e..ec49457 100644
--- a/packages/ztree/ztree-util.el
+++ b/packages/ztree/ztree-util.el
@@ -1,10 +1,10 @@
;;; ztree-util.el --- Auxiliary utilities for the ztree package -*-
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>
+;; Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
;;
-;; Created: 2013-11-1l
+;; Created: 2013-11-11
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
diff --git a/packages/ztree/ztree-view.el b/packages/ztree/ztree-view.el
index 4a5a766..3244ccc 100644
--- a/packages/ztree/ztree-view.el
+++ b/packages/ztree/ztree-view.el
@@ -1,10 +1,10 @@
;;; ztree-view.el --- Text mode tree view (buffer) -*- 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>
+;; Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
;;
-;; Created: 2013-11-1l
+;; Created: 2013-11-11
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
@@ -48,78 +48,65 @@
;; Globals
;;
-(defvar ztree-expanded-nodes-list nil
+(defvar ztree-draw-unicode-lines nil
+ "If set forces ztree to draw lines with unicode characters.")
+
+(defvar-local ztree-expanded-nodes-list nil
"A list of Expanded nodes (i.e. directories) entries.")
-(make-variable-buffer-local 'ztree-expanded-nodes-list)
-(defvar ztree-start-node nil
+(defvar-local ztree-start-node nil
"Start node(i.e. directory) for the window.")
-(make-variable-buffer-local 'ztree-start-node)
-(defvar ztree-line-to-node-table nil
+(defvar-local ztree-line-to-node-table nil
"List of tuples with full node(i.e. file/directory name and the line.")
-(make-variable-buffer-local 'ztree-line-to-node-table)
-(defvar ztree-start-line nil
+(defvar-local ztree-start-line nil
"Index of the start line - the root.")
-(make-variable-buffer-local 'ztree-start-line)
-(defvar ztree-parent-lines-array nil
+(defvar-local ztree-parent-lines-array nil
"Array of parent lines.
The ith value of the array is the parent line for line i.
If ith value is i - it is the root line")
-(make-variable-buffer-local 'ztree-parent-lines-array)
-(defvar ztree-count-subsequent-bs nil
+(defvar-local ztree-count-subsequent-bs nil
"Counter for the subsequest BS keys (to identify double BS).
Used in order to not to use cl package and `lexical-let'")
-(make-variable-buffer-local 'ztree-count-subsequent-bs)
-(defvar ztree-line-tree-properties nil
+(defvar-local ztree-line-tree-properties nil
"Hash with key - line number, value - property ('left, 'right, 'both).
Used for 2-side trees, to determine if the node exists on left or right
or both sides")
-(make-variable-buffer-local 'ztree-line-tree-properties)
-(defvar ztree-tree-header-fun nil
+(defvar-local ztree-tree-header-fun nil
"Function inserting the header into the tree buffer.
MUST inster newline at the end!")
-(make-variable-buffer-local 'ztree-tree-header-fun)
-(defvar ztree-node-short-name-fun nil
+(defvar-local ztree-node-short-name-fun nil
"Function which creates a pretty-printable short string from the node.")
-(make-variable-buffer-local 'ztree-node-short-name-fun)
-(defvar ztree-node-is-expandable-fun nil
+(defvar-local ztree-node-is-expandable-fun nil
"Function which determines if the node is expandable.
For example if the node is a directory")
-(make-variable-buffer-local 'ztree-node-is-expandable-fun)
-(defvar ztree-node-equal-fun nil
+(defvar-local ztree-node-equal-fun nil
"Function which determines if the 2 nodes are equal.")
-(make-variable-buffer-local 'ztree-node-equal-fun)
-(defvar ztree-node-contents-fun nil
+(defvar-local ztree-node-contents-fun nil
"Function returning list of node contents.")
-(make-variable-buffer-local 'ztree-node-contents-fun)
-(defvar ztree-node-side-fun nil
+(defvar-local ztree-node-side-fun nil
"Function returning position of the node: 'left, 'right or 'both.
If not defined(by default) - using single screen tree, otherwise
the buffer is split to 2 trees")
-(make-variable-buffer-local 'ztree-node-side-fun)
-(defvar ztree-node-face-fun nil
+(defvar-local ztree-node-face-fun nil
"Function returning face for the node.")
-(make-variable-buffer-local 'ztree-node-face-fun)
-(defvar ztree-node-action-fun nil
+(defvar-local ztree-node-action-fun nil
"Function called when Enter/Space pressed on the node.")
-(make-variable-buffer-local 'ztree-node-action-fun)
-(defvar ztree-node-showp-fun nil
+(defvar-local ztree-node-showp-fun nil
"Function called to decide if the node should be visible.")
-(make-variable-buffer-local 'ztree-node-showp-fun)
;;
@@ -176,7 +163,9 @@ the buffer is split to 2 trees")
(define-derived-mode ztree-mode special-mode "Ztree"
"A major mode for displaying the directory tree in text mode."
;; only spaces
- (setq indent-tabs-mode nil))
+ (setq indent-tabs-mode nil)
+ (setq buffer-read-only t))
+
(defun ztree-find-node-in-line (line)
"Return the node for the LINE specified.
@@ -343,45 +332,66 @@ Optional argument FACE face to use to draw a character."
(goto-char (+ x (-(point) 1)))
(delete-char 1)
(insert-char c 1)
- (put-text-property (1- (point)) (point) 'face (if face face
'ztreep-arrow-face))))
+ (put-text-property (1- (point)) (point) 'font-lock-face (if face face
'ztreep-arrow-face))))
+
+(defun ztree-vertical-line-char ()
+ "Return the character used to draw vertical line"
+ (if ztree-draw-unicode-lines #x2502 ?\|))
+
+(defun ztree-horizontal-line-char ()
+ "Return the character used to draw vertical line"
+ (if ztree-draw-unicode-lines #x2500 ?\-))
+
+(defun ztree-left-bottom-corner-char ()
+ "Return the character used to draw vertical line"
+ (if ztree-draw-unicode-lines #x2514 ?\`))
+
+(defun ztree-left-intersection-char ()
+ "Return left intersection character.
+It is just vertical bar when unicode disabled"
+ (if ztree-draw-unicode-lines #x251C ?\|))
(defun ztree-draw-vertical-line (y1 y2 x &optional face)
"Draw a vertical line of '|' characters from Y1 row to Y2 in X column.
Optional argument FACE face to draw line with."
- (let ((count (abs (- y1 y2))))
+ (let ((ver-line-char (ztree-vertical-line-char))
+ (count (abs (- y1 y2))))
(if (> y1 y2)
(progn
(dotimes (y count)
- (ztree-draw-char ?\| x (+ y2 y) face))
- (ztree-draw-char ?\| x (+ y2 count) face))
+ (ztree-draw-char ver-line-char x (+ y2 y) face))
+ (ztree-draw-char ver-line-char x (+ y2 count) face))
(progn
(dotimes (y count)
- (ztree-draw-char ?\| x (+ y1 y) face))
- (ztree-draw-char ?\| x (+ y1 count) face)))))
+ (ztree-draw-char ver-line-char x (+ y1 y) face))
+ (ztree-draw-char ver-line-char x (+ y1 count) face)))))
(defun ztree-draw-vertical-rounded-line (y1 y2 x &optional face)
"Draw a vertical line of '|' characters finishing with '`' character.
Draws the line from Y1 row to Y2 in X column.
Optional argument FACE facet to draw the line with."
- (let ((count (abs (- y1 y2))))
+ (let ((ver-line-char (ztree-vertical-line-char))
+ (corner-char (ztree-left-bottom-corner-char))
+ (count (abs (- y1 y2))))
(if (> y1 y2)
(progn
(dotimes (y count)
- (ztree-draw-char ?\| x (+ y2 y) face))
- (ztree-draw-char ?\` x (+ y2 count) face))
+ (ztree-draw-char ver-line-char x (+ y2 y) face))
+ (ztree-draw-char corner-char x (+ y2 count) face))
(progn
(dotimes (y count)
- (ztree-draw-char ?\| x (+ y1 y) face))
- (ztree-draw-char ?\` x (+ y1 count) face)))))
+ (ztree-draw-char ver-line-char x (+ y1 y) face))
+ (ztree-draw-char corner-char x (+ y1 count) face)))))
(defun ztree-draw-horizontal-line (x1 x2 y)
"Draw the horizontal line from column X1 to X2 in the row Y."
- (if (> x1 x2)
- (dotimes (x (1+ (- x1 x2)))
- (ztree-draw-char ?\- (+ x2 x) y))
- (dotimes (x (1+ (- x2 x1)))
- (ztree-draw-char ?\- (+ x1 x) y))))
+ (let ((hor-line-char (ztree-horizontal-line-char)))
+ (if (> x1 x2)
+ (dotimes (x (1+ (- x1 x2)))
+ (ztree-draw-char hor-line-char (+ x2 x) y))
+ (dotimes (x (1+ (- x2 x1)))
+ (ztree-draw-char hor-line-char (+ x1 x) y)))))
(defun ztree-draw-tree (tree depth start-offset)
@@ -396,6 +406,8 @@ Argument START-OFFSET column to start drawing from."
(line-start (+ 3 offset))
(line-end-leaf (+ 7 offset))
(line-end-node (+ 4 offset))
+ (corner-char (ztree-left-bottom-corner-char))
+ (intersection-char (ztree-left-intersection-char))
;; determine if the line is visible. It is always the case
;; for 1-sided trees; however for 2 sided trees
;; it depends on which side is the actual element
@@ -417,17 +429,24 @@ Argument START-OFFSET column to start drawing from."
(funcall visible (ztree-car-atom
x)))))
(x-offset (+ 2 offset)))
(when last-child
- (ztree-draw-vertical-rounded-line (1+ root)
- (ztree-car-atom last-child)
- x-offset)))
- ;; draw recursively
- (dolist (child children)
- (ztree-draw-tree child (1+ depth) start-offset)
- (let ((end (if (listp child) line-end-node line-end-leaf)))
- (when (funcall visible (ztree-car-atom child))
- (ztree-draw-horizontal-line line-start
- end
- (ztree-car-atom child)))))))))
+ (ztree-draw-vertical-line (1+ root)
+ (ztree-car-atom last-child)
+ x-offset))
+ ;; draw recursively
+ (dolist (child children)
+ (ztree-draw-tree child (1+ depth) start-offset)
+ (let ((end (if (listp child) line-end-node line-end-leaf))
+ (row (ztree-car-atom child)))
+ (when (funcall visible (ztree-car-atom child))
+ (ztree-draw-char intersection-char (1- line-start) row)
+ (ztree-draw-horizontal-line line-start
+ end
+ row))))
+ ;; finally draw the corner at the end of vertical line
+ (when last-child
+ (ztree-draw-char corner-char
+ x-offset
+ (ztree-car-atom last-child))))))))
(defun ztree-fill-parent-array (tree)
"Set the root lines array.
@@ -538,29 +557,33 @@ Writes a string with given DEPTH, prefixed with [ ] if
EXPANDABLE
and [-] or [+] depending on if it is EXPANDED from the specified OFFSET.
Optional argument FACE face to write text with."
(let ((node-sign #'(lambda (exp)
- (insert "[" (if exp "-" "+") "]")
- (set-text-properties (- (point) 3)
- (point)
- '(face ztreep-expand-sign-face)))))
- (move-to-column offset t)
+ (let ((sign (concat "[" (if exp "-" "+") "]")))
+ (insert (propertize sign
+ 'font-lock-face
+ ztreep-expand-sign-face)))))
+ ;; face to use. if FACE is not null, use it, otherwise
+ ;; deside from the node type
+ (entry-face (cond (face face)
+ (expandable 'ztreep-node-face)
+ (t ztreep-leaf-face))))
+ ;; move-to-column in contrast to insert reuses the last property
+ ;; so need to clear it
+ (let ((start-pos (point)))
+ (move-to-column offset t)
+ (remove-text-properties start-pos (point) '(font-lock-face nil)))
(delete-region (point) (line-end-position))
+ ;; every indentation level is 4 characters
(when (> depth 0)
- (dotimes (_ depth)
- (insert " ")
- (insert-char ?\s 3))) ; insert 3 spaces
+ (insert-char ?\s (* 4 depth))) ; insert 4 spaces
(when (> (length short-name) 0)
- (if expandable
- (progn
- (funcall node-sign expanded) ; for expandable nodes insert
"[+/-]"
- (insert " ")
- (put-text-property 0 (length short-name)
- 'face (if face face 'ztreep-node-face)
short-name)
- (insert short-name))
- (progn
- (insert " ")
- (put-text-property 0 (length short-name)
- 'face (if face face 'ztreep-leaf-face) short-name)
- (insert short-name))))))
+ (let ((start-pos (point)))
+ (if expandable
+ (funcall node-sign expanded)) ; for expandable nodes insert
"[+/-]"
+ ;; indentation for leafs 4 spaces from the node name
+ (insert-char ?\s (- 4 (- (point) start-pos))))
+ (insert (propertize short-name 'font-lock-face entry-face)))))
+
+
(defun ztree-jump-side ()
"Jump to another side for 2-sided trees."
@@ -605,7 +628,8 @@ Optional argument LINE scroll to the line given."
children-fun
face-fun
action-fun
- &optional node-side-fun
+ &optional
+ node-side-fun
)
"Create a ztree view buffer configured with parameters given.
Argument BUFFER-NAME Name of the buffer created.
diff --git a/packages/ztree/ztree.el b/packages/ztree/ztree.el
index b591756..300ed85 100644
--- a/packages/ztree/ztree.el
+++ b/packages/ztree/ztree.el
@@ -3,8 +3,8 @@
;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;;
;; Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
-;; Created: 2013-11-1l
-;; Version: 1.0.2
+;; Created: 2013-11-11
+;; Version: 1.0.3
;; Package-Requires: ((cl-lib "0"))
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
