[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 60d88e2 88/92: Added ztree package
|
From: |
Alexey Veretennikov |
|
Subject: |
[elpa] master 60d88e2 88/92: Added ztree package |
|
Date: |
Thu, 11 Jun 2015 19:48:22 +0000 |
branch: master
commit 60d88e26ee92f0b2dac31a1634f1489a842e5899
Author: Alexey Veretennikov <address@hidden>
Commit: Alexey Veretennikov <address@hidden>
Added ztree package
---
packages/ztree/README.md | 72 ++++
packages/ztree/ztree-diff-model.el | 349 +++++++++++++++++++
packages/ztree/ztree-diff.el | 455 +++++++++++++++++++++++++
packages/ztree/ztree-dir.el | 118 +++++++
packages/ztree/ztree-pkg.el | 4 +
packages/ztree/ztree-util.el | 133 ++++++++
packages/ztree/ztree-view.el | 650 ++++++++++++++++++++++++++++++++++++
7 files changed, 1781 insertions(+), 0 deletions(-)
diff --git a/packages/ztree/README.md b/packages/ztree/README.md
new file mode 100644
index 0000000..30443a2
--- /dev/null
+++ b/packages/ztree/README.md
@@ -0,0 +1,72 @@
+ztree
+=====
+
+Ztree is a project dedicated to implementation of several text-tree
applications inside Emacs. It consists of 2 subprojects: **ztree-diff** and
**ztree-dir**(the basis of **ztree-diff**). Available in **GNU ELPA** and
**MELPA**.
+
+ztree-diff
+==========
+**ztree-diff** is a directory-diff tool for Emacs inspired by commercial tools
like Beyond Compare or Araxis Merge. It supports showing the difference between
two directories; calling **Ediff** for not matching files, copying between
directories, deleting file/directories, hiding/showing equal files/directories.
+
+The comparison itself performed with the external **GNU diff** tool, so make
sure to have one in the executable path. Verified on OSX and Linux.
+
+If one wants to have a stand-alone application, consider the
(WIP)[zdircmp](https://github.com/fourier/zdircmp) project based on
**ztree-diff**.
+
+Add the following to your .emacs file:
+
+```scheme
+(push (substitute-in-file-name "path-to-ztree-directory") load-path)
+(require 'ztree-diff)
+```
+
+Call the `ztree-diff` interactive function:
+
+```
+M-x ztree-diff
+```
+Then you need to specify the left and right directories to compare.
+
+###Hotkeys supported
+The basic hotkeys are the same as in the **ztree-dir**. Additionally:
+ * `RET` on different files starts the **Ediff** (or open file if one absent
or the same)
+ * `Space` show the simple diff window for the current file instead of
**Ediff** (or view file if one absent or the same)
+ * `TAB` to fast switch between panels
+ * `h` key to toggle show/hide identical files/directories
+ * `C` key to copy current file or directory to the left or right panel
+ * `D` key to delete current file or directory
+ * `v` key to quick view the current file
+ * `r` initiates the rescan/refresh of current file or subdirectory
+ * `F5` forces the full rescan.
+
+Screenshots:
+
+
+
+
+
+
+ztree-dir
+---------
+**ztree-dir** is a simple text-mode directory tree for Emacs. See screenshots
below for the GUI and the terminal versions of the **ztree-dir**.
+
+As above Add the following to your .emacs file:
+
+```scheme
+(push (substitute-in-file-name "path-to-ztree-directory") load-path)
+(require 'ztree-dir)
+```
+
+Call the `ztree-dir` interactive function:
+
+```
+M-x ztree-dir
+```
+
+* Open/close directories with double-click, `RET` or `Space` keys.
+* To jump to the parent directory, hit the `Backspace` key.
+* To toggle open/closed state of the subtree of the current directory, hit the
`x` key.
+
+
+
+
+
+
diff --git a/packages/ztree/ztree-diff-model.el
b/packages/ztree/ztree-diff-model.el
new file mode 100644
index 0000000..572d976
--- /dev/null
+++ b/packages/ztree/ztree-diff-model.el
@@ -0,0 +1,349 @@
+;;; ztree-diff-model.el --- diff model for directory trees
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;;
+;; Created: 2013-11-1l
+;;
+;; Keywords: files tools
+;; URL: https://github.com/fourier/ztree
+;; Compatibility: GNU Emacs GNU Emacs 24.x
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+
+;; Diff model
+
+;;; Code:
+(require 'ztree-util)
+
+(defvar ztree-diff-model-wait-message nil
+ "Message showing while constructing the diff tree.")
+(make-variable-buffer-local 'ztree-diff-model-wait-message)
+
+
+(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)))
+
+
+
+;; Create a record ztree-diff-node with defined fielsd and getters/setters
+;; here:
+;; parent - parent node
+;; left-path is the full path on the left side of the diff window,
+;; 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
+(defrecord ztree-diff-node (parent left-path right-path short-name
right-short-name children different))
+
+(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 ""))
+ (dolist (x children)
+ (setq ch-str (concat ch-str "\n * " (ztree-diff-node-short-name 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"
+ " * 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))
+ "\n"
+ " * Children: " ch-str
+ "\n")))
+
+
+(defun ztree-diff-node-short-name-wrapper (node &optional right-side)
+ "Return the short name of the NODE given.
+If the RIGHT-SIDE is true, take the right leaf"
+ (if (not right-side)
+ (ztree-diff-node-short-name node)
+ (ztree-diff-node-right-short-name node)))
+
+
+(defun ztree-diff-node-is-directory (node)
+ "Determines if the NODE is a directory."
+ (let ((left (ztree-diff-node-left-path node))
+ (right (ztree-diff-node-right-path node)))
+ (if left
+ (file-directory-p left)
+ (file-directory-p right))))
+
+(defun ztree-diff-node-side (node)
+ "Determine the side there the file is present for NODE.
+Return BOTH if the file present on both sides;
+LEFT if only on the left side and
+RIGHT if only on the right side."
+ (let ((left (ztree-diff-node-left-path node))
+ (right (ztree-diff-node-right-path node)))
+ (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)
+ (ztree-diff-node-short-name node2))
+ (string-equal (ztree-diff-node-left-path node1)
+ (ztree-diff-node-left-path node2))
+ (string-equal (ztree-diff-node-right-path node1)
+ (ztree-diff-node-right-path node1))))
+
+(defun ztree-diff-untrampify-filename (file)
+ "Return FILE as the local file name."
+ (require 'tramp)
+ (if (not (tramp-tramp-file-p file))
+ file
+ (tramp-file-name-localname (tramp-dissect-file-name file))))
+
+(defun ztree-diff-modef-quotify-string (x)
+ "Surround string X with quotes."
+ (concat "\"" x "\""))
+
+(defun ztree-diff-model-files-equal (file1 file2)
+ "Compare files FILE1 and FILE2 using external diff.
+Returns t if equal."
+ (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-output (shell-command-to-string diff-command)))
+ (not (> (length diff-output) 2))))
+
+(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)))
+ (not (or (string-equal simple-name ".")
+ (string-equal simple-name "..")))))
+ (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 ((parent (ztree-diff-node-parent node))
+ (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)))
+ (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
+ (if (ztree-diff-model-files-equal left right)
+ nil
+ 'diff))))))
+
+(defun ztree-diff-model-subtree (parent path side)
+ "Create a subtree with given PARENT for the given PATH.
+Argument SIDE either 'left or 'right side."
+ (let ((files (ztree-directory-files path))
+ (result nil))
+ (dolist (file files)
+ (if (file-directory-p file)
+ (let* ((node (ztree-diff-node-create
+ parent
+ (when (eq side 'left) file)
+ (when (eq side 'right) file)
+ (file-short-name file)
+ (file-short-name file)
+ nil
+ 'new))
+ (children (ztree-diff-model-subtree node file side)))
+ (ztree-diff-node-set-children node children)
+ (push node result))
+ (push (ztree-diff-node-create
+ parent
+ (when (eq side 'left) file)
+ (when (eq side 'right) file)
+ (file-short-name file)
+ (file-short-name file)
+ nil
+ 'new)
+ 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)
+ (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)
+ "Recursively update all parents diff status for the NODE."
+ (let ((parent node))
+ (while (setq parent (ztree-diff-node-parent parent))
+ (ztree-diff-node-update-diff-from-children parent))))
+
+
+(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)
+ ;; 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 (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 simple-name
simple-name 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
(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)))))
+ ;; 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)
+ ;; push the created node to the result list
+ (push node result)))
+ ;; 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 (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 simple-name
simple-name nil '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
(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)
+ ;; 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)
+ ;; 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))
+ (error "Path %s is not a directory" dir1))
+ (when (not (file-directory-p dir2))
+ (error "Path %s is not a directory" dir2))
+ (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)
+ nil
+ nil))
+ (traverse (ztree-diff-node-traverse model dir1 dir2)))
+ (ztree-diff-node-set-children model (cdr traverse))
+ (ztree-diff-node-set-different model (car traverse))
+ (message "Done.")
+ model))
+
+(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))))
+ (ztree-diff-node-set-children node (cdr traverse))
+ (ztree-diff-node-set-different node (car traverse))
+ (message "Done.")))
+
+
+
+(provide 'ztree-diff-model)
+
+;;; ztree-diff-model.el ends here
diff --git a/packages/ztree/ztree-diff.el b/packages/ztree/ztree-diff.el
new file mode 100644
index 0000000..8d1d9d0
--- /dev/null
+++ b/packages/ztree/ztree-diff.el
@@ -0,0 +1,455 @@
+;;; ztree-diff.el --- Text mode diff for directory trees
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;;
+;; Created: 2013-11-1l
+;;
+;; Keywords: files tools
+;; URL: https://github.com/fourier/ztree
+;; Compatibility: GNU Emacs GNU Emacs 24.x
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+
+;;; Code:
+(require 'ztree-view)
+(require 'ztree-diff-model)
+
+(defconst ztree-diff-hidden-files-regexp "^\\."
+ "Hidden files regexp.
+By default all filest starting with dot '.', including . and ..")
+
+(defface ztreep-diff-header-face
+ '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
+ (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
+ (t :height 1.2 :foreground "darkblue" :weight bold))
+ "*Face used for the header in Ztree Diff buffer."
+ :group 'Ztree-diff :group 'font-lock-highlighting-faces)
+(defvar ztreep-diff-header-face 'ztreep-diff-header-face)
+
+(defface ztreep-diff-header-small-face
+ '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
+ (((background dark)) (:foreground "lightblue" :weight bold))
+ (t :weight bold :foreground "darkblue"))
+ "*Face used for the header in Ztree Diff buffer."
+ :group 'Ztree-diff :group 'font-lock-highlighting-faces)
+(defvar ztreep-diff-header-small-face 'ztreep-diff-header-small-face)
+
+(defface ztreep-diff-model-diff-face
+ '((t (:foreground "red")))
+ "*Face used for different files in Ztree-diff."
+ :group 'Ztree-diff :group 'font-lock-highlighting-faces)
+(defvar ztreep-diff-model-diff-face 'ztreep-diff-model-diff-face)
+
+(defface ztreep-diff-model-add-face
+ '((t (:foreground "blue")))
+ "*Face used for added files in Ztree-diff."
+ :group 'Ztree-diff :group 'font-lock-highlighting-faces)
+(defvar ztreep-diff-model-add-face 'ztreep-diff-model-add-face)
+
+(defface ztreep-diff-model-normal-face
+ '((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)
+ "List of regexp file names to filter out.
+By default paths starting with dot (like .git) are ignored")
+(make-variable-buffer-local 'ztree-diff-filter-list)
+
+(defvar ztree-diff-dirs-pair nil
+ "Pair of the directories stored. Used to perform the full rescan.")
+(make-variable-buffer-local 'ztree-diff-dirs-pair)
+
+(defvar ztree-diff-show-equal-files t
+ "Show or not equal files/directories on both sides.")
+(make-variable-buffer-local 'ztree-diff-show-equal-files)
+
+;;;###autoload
+(define-minor-mode ztreediff-mode
+ "A minor mode for displaying the difference of the directory trees in text
mode."
+ ;; initial value
+ nil
+ ;; modeline name
+ " Diff"
+ ;; The minor mode keymap
+ `(
+ (,(kbd "C") . ztree-diff-copy)
+ (,(kbd "h") . ztree-diff-toggle-show-equal-files)
+ (,(kbd "D") . ztree-diff-delete-file)
+ (,(kbd "v") . ztree-diff-view-file)
+ (,(kbd "d") . ztree-diff-simple-diff-files)
+ (,(kbd "r") . ztree-diff-partial-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)
+ ((eq diff 'new) ztreep-diff-model-add-face)
+ (t ztreep-diff-model-normal-face))))
+
+(defun ztree-diff-insert-buffer-header ()
+ "Insert the header to the ztree buffer."
+ (insert-with-face "Differences tree" ztreep-diff-header-face)
+ (newline-and-begin)
+ (when ztree-diff-dirs-pair
+ (insert-with-face (concat "Left: " (car ztree-diff-dirs-pair))
+ ztreep-diff-header-small-face)
+ (newline-and-begin)
+ (insert-with-face (concat "Right: " (cdr ztree-diff-dirs-pair))
+ ztreep-diff-header-small-face)
+ (newline-and-begin))
+ (insert-with-face "Legend:" ztreep-diff-header-small-face)
+ (newline-and-begin)
+ (insert-with-face " Normal file " ztreep-diff-model-normal-face)
+ (insert-with-face "- same on both sides" ztreep-diff-header-small-face)
+ (newline-and-begin)
+ (insert-with-face " Orphan file " ztreep-diff-model-add-face)
+ (insert-with-face "- does not exist on other side"
ztreep-diff-header-small-face)
+ (newline-and-begin)
+ (insert-with-face " Mismatch file " ztreep-diff-model-diff-face)
+ (insert-with-face "- different from other side"
ztreep-diff-header-small-face)
+ (newline-and-begin)
+ (insert-with-face "==============" ztreep-diff-header-face)
+ (newline-and-begin))
+
+(defun ztree-diff-full-rescan ()
+ "Force full rescan of the directory trees."
+ (interactive)
+ (when (and ztree-diff-dirs-pair
+ (yes-or-no-p (format "Force full rescan?")))
+ (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair))))
+
+
+
+(defun ztree-diff-existing-common (node)
+ "Return the NODE if both left and right sides exist."
+ (let ((left (ztree-diff-node-left-path node))
+ (right (ztree-diff-node-right-path node)))
+ (if (and left right
+ (file-exists-p left)
+ (file-exists-p right))
+ node
+ nil)))
+
+(defun ztree-diff-existing-common-parent (node)
+ "Return the first node in up in hierarchy of the NODE which has both sides."
+ (let ((common (ztree-diff-existing-common node)))
+ (if common
+ common
+ (ztree-diff-existing-common-parent (ztree-diff-node-parent node)))))
+
+(defun ztree-diff-do-partial-rescan (node)
+ "Partly rescan the NODE."
+ (let* ((common (ztree-diff-existing-common-parent node))
+ (parent (ztree-diff-node-parent common)))
+ (if (not parent)
+ (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))))))
+
+
+(defun ztree-diff-partial-rescan ()
+ "Perform partial rescan on the current node."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (ztree-diff-do-partial-rescan (car found)))))
+
+
+(defun ztree-diff-simple-diff (node)
+ "Create a simple diff buffer for files from left and right panels.
+Argument NODE node containing paths to files to call a diff on."
+ (let* ((node-left (ztree-diff-node-left-path node))
+ (node-right (ztree-diff-node-right-path node)))
+ (when (and
+ node-left
+ node-right
+ (not (file-directory-p node-left)))
+ ;; show the diff window on the bottom
+ ;; to not to crush tree appearance
+ (let ((split-width-threshold nil))
+ (diff node-left node-right)))))
+
+
+(defun ztree-diff-simple-diff-files ()
+ "Create a simple diff buffer for files from left and right panels."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (let ((node (car found)))
+ (ztree-diff-simple-diff node)))))
+
+(defun ztree-diff-node-action (node hard)
+ "Perform action on NODE:
+1 if both left and right sides present:
+ 1.1 if they are differend
+ 1.1.1 if HARD ediff
+ 1.1.2 simple diff otherwiste
+ 1.2 if they are the same - view left
+2 if left or right present - view left or rigth"
+ (let ((left (ztree-diff-node-left-path node))
+ (right (ztree-diff-node-right-path node))
+ (open-f '(lambda (path) (if hard (find-file path)
+ (let ((split-width-threshold nil))
+ (view-file-other-window path))))))
+ (cond ((and left right)
+ (if (not (ztree-diff-node-different node))
+ (funcall open-f left)
+ (if hard
+ (ediff left right)
+ (ztree-diff-simple-diff node))))
+ (left (funcall open-f left))
+ (right (funcall open-f right))
+ (t nil))))
+
+
+
+(defun ztree-diff-copy-file (node source-path destination-path copy-to-right)
+ "Update the NODE status and copy the file.
+File copied from SOURCE-PATH to DESTINATION-PATH.
+COPY-TO-RIGHT specifies which side of the NODE to update."
+ (let ((target-path (concat
+ (file-name-as-directory destination-path)
+ (file-name-nondirectory
+ (directory-file-name source-path)))))
+ (let ((err (condition-case error-trap
+ (progn
+ ;; don't ask for overwrite
+ ;; keep time stamp
+ (copy-file source-path target-path t t)
+ nil)
+ (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)))))))
+
+
+(defun ztree-diff-copy-dir (node source-path destination-path copy-to-right)
+ "Update the NODE status and copy the directory.
+Directory copied from SOURCE-PATH to DESTINATION-PATH.
+COPY-TO-RIGHT specifies which side of the NODE to update."
+ (let* ((src-path (file-name-as-directory source-path))
+ (target-path (file-name-as-directory destination-path))
+ (target-full-path (concat
+ target-path
+ (file-name-nondirectory
+ (directory-file-name source-path)))))
+ (let ((err (condition-case error-trap
+ (progn
+ ;; keep time stamp
+ ;; ask for overwrite
+ (copy-directory src-path target-path t t)
+ 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)))))))
+
+
+(defun ztree-diff-copy ()
+ "Copy the file under the cursor to other side."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (let* ((node (car found))
+ (side (cdr found))
+ (node-side (ztree-diff-node-side node))
+ (copy-to-right t) ; copy from left to right
+ (node-left (ztree-diff-node-left-path node))
+ (node-right (ztree-diff-node-right-path node))
+ (source-path nil)
+ (destination-path nil)
+ (parent (ztree-diff-node-parent node)))
+ (when parent ; do not copy the root node
+ ;; determine a side to copy from/to
+ ;; algorithm:
+ ;; 1) if both side are present, use the side
+ ;; variable
+ (setq copy-to-right (if (eq node-side 'both)
+ (eq side 'left)
+ ;; 2) if one of sides is absent, copy from
+ ;; the side where the file is present
+ (eq node-side 'left)))
+ ;; 3) in both cases determine if the destination
+ ;; directory is in place
+ (setq source-path (if copy-to-right node-left node-right)
+ destination-path (if copy-to-right
+ (ztree-diff-node-right-path parent)
+ (ztree-diff-node-left-path parent)))
+ (when (and source-path destination-path
+ (yes-or-no-p (format "Copy [%s]%s to [%s]%s/ ?"
+ (if copy-to-right "LEFT" "RIGHT")
+ (ztree-diff-node-short-name node)
+ (if copy-to-right "RIGHT" "LEFT")
+ destination-path)))
+ (if (file-directory-p source-path)
+ (ztree-diff-copy-dir node
+ source-path
+ destination-path
+ copy-to-right)
+ (ztree-diff-copy-file node
+ source-path
+ destination-path
+ copy-to-right))))))))
+
+(defun ztree-diff-view-file ()
+ "View file at point, depending on side."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (let* ((node (car found))
+ (side (cdr found))
+ (node-side (ztree-diff-node-side node))
+ (node-left (ztree-diff-node-left-path node))
+ (node-right (ztree-diff-node-right-path node)))
+ (when (or (eq node-side 'both)
+ (eq side node-side))
+ (cond ((and (eq side 'left)
+ node-left)
+ (view-file node-left))
+ ((and (eq side 'right)
+ node-right)
+ (view-file node-right))))))))
+
+
+(defun ztree-diff-delete-file ()
+ "Delete the file under the cursor."
+ (interactive)
+ (let ((found (ztree-find-node-at-point)))
+ (when found
+ (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 remove-path t)
+ '(delete-file remove-path t)))
+ (children (ztree-diff-node-children parent))
+ (err
+ (condition-case error-trap
+ (progn
+ (eval delete-command)
+ nil)
+ (error error-trap))))
+ (if err (message (concat "Error: " (nth 2 err)))
+ (progn
+ (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-refresh-buffer (line-number-at-pos))))))))))
+
+
+
+(defun ztree-node-is-in-filter-list (node)
+ "Determine if the NODE is in filter list.
+If the node is in the filter list it shall not be visible"
+ (ztree-find ztree-diff-filter-list #'(lambda (rx) (string-match rx node))))
+
+
+(defun ztree-node-is-visible (node)
+ "Determine if the NODE should be visible."
+ (and (ztree-diff-node-parent node) ; parent is always visible
+ (not (ztree-node-is-in-filter-list (ztree-diff-node-short-name node)))
+ (or ztree-diff-show-equal-files
+ (ztree-diff-node-different node))))
+
+(defun ztree-diff-toggle-show-equal-files ()
+ "Toggle visibility of the equal files."
+ (interactive)
+ (setq ztree-diff-show-equal-files (not ztree-diff-show-equal-files))
+ (ztree-refresh-buffer))
+
+;;;###autoload
+(defun ztree-diff (dir1 dir2)
+ "Create an interactive buffer with the directory tree of the path given.
+Argument DIR1 left directory.
+Argument DIR2 right directory."
+ (interactive "DLeft directory \nDRight directory ")
+ (let* ((difference (ztree-diff-model-create dir1 dir2))
+ (buf-name (concat "*"
+ (ztree-diff-node-short-name difference)
+ " <--> "
+ (ztree-diff-node-right-short-name difference)
+ "*")))
+ (ztree-view buf-name
+ difference
+ 'ztree-node-is-visible
+ 'ztree-diff-insert-buffer-header
+ 'ztree-diff-node-short-name-wrapper
+ 'ztree-diff-node-is-directory
+ 'ztree-diff-node-equal
+ 'ztree-diff-node-children
+ 'ztree-diff-node-face
+ 'ztree-diff-node-action
+ 'ztree-diff-node-side)
+ (ztreediff-mode)
+ (setq ztree-diff-dirs-pair (cons dir1 dir2))
+ (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
new file mode 100644
index 0000000..47a57cd
--- /dev/null
+++ b/packages/ztree/ztree-dir.el
@@ -0,0 +1,118 @@
+;;; ztree-dir.el --- Text mode directory tree
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;;
+;; Created: 2013-11-1l
+;;
+;; Keywords: files tools
+;; URL: https://github.com/fourier/ztree
+;; Compatibility: GNU Emacs GNU Emacs 24.x
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; Add the following to your .emacs file:
+;;
+;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
+;; (require 'ztree-dir)
+;;
+;; Call the ztree interactive function:
+;; M-x ztree-dir
+;; Open/close directories with double-click, Enter or Space keys
+;;
+;;; Issues:
+;;
+;;; TODO:
+;; 1) Add some file-handling and marking abilities
+;;
+;;; Code:
+
+(require 'ztree-util)
+(require 'ztree-view)
+
+;;
+;; Constants
+;;
+
+(defconst ztree-hidden-files-regexp "^\\."
+ "Hidden files regexp.
+By default all filest starting with dot '.', including . and ..")
+
+
+;;
+;; Faces
+;;
+
+(defface ztreep-header-face
+ '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
+ (((background dark)) (:height 1.2 :foreground "lightblue" :weight bold))
+ (t :height 1.2 :foreground "darkblue" :weight bold))
+ "*Face used for the header in Ztree buffer."
+ :group 'Ztree :group 'font-lock-highlighting-faces)
+(defvar ztreep-header-face 'ztreep-header-face)
+
+
+;;
+;; File bindings to the directory tree control
+;;
+
+(defun ztree-insert-buffer-header ()
+ "Insert the header to the ztree buffer."
+ (let ((start (point)))
+ (insert "Directory tree")
+ (newline-and-begin)
+ (insert "==============")
+ (set-text-properties start (point) '(face ztreep-header-face)))
+ (newline-and-begin))
+
+(defun ztree-file-not-hidden (filename)
+ "Determines if the file with FILENAME should be visible."
+ (not (string-match ztree-hidden-files-regexp
+ (file-short-name filename))))
+
+(defun ztree-find-file (node hard)
+ "Find the file at NODE.
+
+If HARD is non-nil, the file is opened in another window.
+Otherwise, the ztree window is used to find the file."
+ (when (and (stringp node) (file-readable-p node))
+ (if hard
+ (save-selected-window (find-file-other-window node))
+ (find-file node))))
+
+;;;###autoload
+(defun ztree-dir (path)
+ "Create an interactive buffer with the directory tree of the PATH given."
+ (interactive "DDirectory: ")
+ (when (and (file-exists-p path) (file-directory-p path))
+ (let ((buf-name (concat "*Directory " path " tree*")))
+ (ztree-view buf-name
+ (expand-file-name (substitute-in-file-name path))
+ 'ztree-file-not-hidden
+ 'ztree-insert-buffer-header
+ 'file-short-name
+ 'file-directory-p
+ 'string-equal
+ '(lambda (x) (directory-files x 'full))
+ nil ; face
+ 'ztree-find-file)))) ; action
+
+
+(provide 'ztree-dir)
+;;; ztree-dir.el ends here
diff --git a/packages/ztree/ztree-pkg.el b/packages/ztree/ztree-pkg.el
new file mode 100644
index 0000000..4665dae
--- /dev/null
+++ b/packages/ztree/ztree-pkg.el
@@ -0,0 +1,4 @@
+;;; ztree-pkg.el --- Package file for MELPA/ELPA
+(define-package "ztree" "1.0.1" "Several text-tree applications" :url
"https://github.com/fourier/ztree"; :keywords '("files" "tools"))
+
+;;; ztree-pkg.el ends here
diff --git a/packages/ztree/ztree-util.el b/packages/ztree/ztree-util.el
new file mode 100644
index 0000000..f5d3506
--- /dev/null
+++ b/packages/ztree/ztree-util.el
@@ -0,0 +1,133 @@
+;;; ztree-util.el --- Auxulary utilities for the ztree package
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;;
+;; Created: 2013-11-1l
+;;
+;; Keywords: files tools
+;; URL: https://github.com/fourier/ztree
+;; Compatibility: GNU Emacs GNU Emacs 24.x
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+
+;;; Code:
+(defun ztree-find (where which)
+ "Find element of the list WHERE matching predicate WHICH."
+ (catch 'found
+ (dolist (elt where)
+ (when (funcall which elt)
+ (throw 'found elt)))
+ nil))
+
+(defun ztree-filter (condp lst)
+ "Filter out elements not satisfying predicate CONDP in the list LST.
+Taken from http://www.emacswiki.org/emacs/ElispCookbook#toc39";
+ (delq nil
+ (mapcar (lambda (x) (and (funcall condp x) x)) lst)))
+
+
+(defun printable-string (string)
+ "Strip newline character from file names, like 'Icon\n.
+Argument STRING string to process.'."
+ (replace-regexp-in-string "\n" "" string))
+
+(defun file-short-name (file)
+ "By given FILE name return base file/directory name.
+Taken from http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01238.html";
+ (printable-string (file-name-nondirectory (directory-file-name file))))
+
+
+(defun newline-and-begin ()
+ "Move a point to the beginning of the next line."
+ (newline)
+ (beginning-of-line))
+
+(defun car-atom (value)
+ "Return VALUE if value is an atom, otherwise (car value) or nil.
+Used since `car-safe' returns nil for atoms"
+ (if (atom value) value (car value)))
+
+
+(defun insert-with-face (text face)
+ "Insert TEXT with the FACE provided."
+ (let ((start (point)))
+ (insert text)
+ (put-text-property start (point) 'face face)))
+
+
+(defmacro defrecord (record-name record-fields)
+ "Create a record (structure) and getters/setters.
+
+Record is the following set of functions:
+ - Record constructor with name \"RECORD-NAME\"-create and list of
+arguments which will be assigned to RECORD-FIELDS
+ - Record getters with names \"record-name\"-\"field\" accepting one
+argument - the record; \"field\" is from \"record-fields\" symbols
+ - Record setters with names \"record-name\"-set-\"field\" accepting two
+arguments - the record and the field value
+
+Example:
+\(defrecord person (name age))
+
+will be expanded to the following functions:
+
+\(defun person-create (name age) (...)
+\(defun person-name (record) (...)
+\(defun person-age (record) (...)
+\(defun person-set-name (record value) (...)
+\(defun person-set-age (record value) (...)"
+ (let ((ctor-name (intern (concat (symbol-name record-name) "-create")))
+ (rec-var (make-symbol "record")))
+ `(progn
+ ;; constructor with the name "record-name-create"
+ ;; with arguments list "record-fields" expanded
+ (defun ,ctor-name (,@record-fields)
+ (let ((,rec-var))
+ ,@(mapcar #'(lambda (x)
+ (list 'setq rec-var (list 'plist-put rec-var (list
'quote x) x)))
+ record-fields)))
+ ;; getters with names "record-name-field" where the "field"
+ ;; is from record-fields
+ ,@(mapcar #'(lambda (x)
+ (let ((getter-name (intern (concat (symbol-name
record-name)
+ "-"
+ (symbol-name x)))))
+ `(progn
+ (defun ,getter-name (,rec-var)
+ (plist-get ,rec-var ',x)
+ ))))
+ record-fields)
+ ;; setters wit names "record-name-set-field where the "field"
+ ;; is from record-fields
+ ;; arguments for setters: (record value)
+ ,@(mapcar #'(lambda (x)
+ (let ((setter-name (intern (concat (symbol-name
record-name)
+ "-set-"
+ (symbol-name x)))))
+ `(progn
+ (defun ,setter-name (,rec-var value)
+ (setq ,rec-var (plist-put ,rec-var ',x value))
+ ))))
+ record-fields))))
+
+
+(provide 'ztree-util)
+
+;;; ztree-util.el ends here
diff --git a/packages/ztree/ztree-view.el b/packages/ztree/ztree-view.el
new file mode 100644
index 0000000..c623bd6
--- /dev/null
+++ b/packages/ztree/ztree-view.el
@@ -0,0 +1,650 @@
+;;; ztree-view.el --- Text mode tree view (buffer)
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+;;
+;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;;
+;; Created: 2013-11-1l
+;;
+;; Keywords: files tools
+;; URL: https://github.com/fourier/ztree
+;; Compatibility: GNU Emacs GNU Emacs 24.x
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; Add the following to your .emacs file:
+;;
+;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
+;; (require 'ztree-view)
+;;
+;; Call the ztree interactive function:
+;; Use the following function: ztree-view
+;;
+;;; Issues:
+;;
+;;; TODO:
+;;
+;;
+;;; Code:
+
+(require 'ztree-util)
+
+;;
+;; Globals
+;;
+
+(defvar 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
+ "Start node(i.e. directory) for the window.")
+(make-variable-buffer-local 'ztree-start-node)
+
+(defvar 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
+ "Index of the start line - the root.")
+(make-variable-buffer-local 'ztree-start-line)
+
+(defvar 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
+ "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
+ "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
+ "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
+ "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
+ "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
+ "Function which determines if the 2 nodes are equal.")
+(make-variable-buffer-local 'ztree-node-equal-fun)
+
+(defvar 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
+ "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
+ "Function returning face for the node.")
+(make-variable-buffer-local 'ztree-node-face-fun)
+
+(defvar 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
+ "Function called to decide if the node should be visible.")
+(make-variable-buffer-local 'ztree-node-showp-fun)
+
+
+;;
+;; Major mode definitions
+;;
+
+(defvar ztree-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "\r") 'ztree-perform-action)
+ (define-key map (kbd "SPC") 'ztree-perform-soft-action)
+ (define-key map [double-mouse-1] 'ztree-perform-action)
+ (define-key map (kbd "TAB") 'ztree-jump-side)
+ (define-key map (kbd "g") 'ztree-refresh-buffer)
+ (define-key map (kbd "x") 'ztree-toggle-expand-subtree)
+ (if window-system
+ (define-key map (kbd "<backspace>") 'ztree-move-up-in-tree)
+ (define-key map "\177" 'ztree-move-up-in-tree))
+ map)
+ "Keymap for `ztree-mode'.")
+
+
+(defface ztreep-node-face
+ '((((background dark)) (:foreground "#ffffff"))
+ (((type nil)) (:inherit 'font-lock-function-name-face))
+ (t (:foreground "Blue")))
+ "*Face used for expandable entries(directories etc) in Ztree buffer."
+ :group 'Ztree :group 'font-lock-highlighting-faces)
+(defvar ztreep-node-face 'ztreep-node-face)
+
+(defface ztreep-leaf-face
+ '((((background dark)) (:foreground "cyan1"))
+ (((type nil)) (:inherit 'font-lock-variable-name-face))
+ (t (:foreground "darkblue")))
+ "*Face used for not expandable nodes(leafs, i.e. files) in Ztree buffer."
+ :group 'Ztree :group 'font-lock-highlighting-faces)
+(defvar ztreep-leaf-face 'ztreep-leaf-face)
+
+(defface ztreep-arrow-face
+ '((((background dark)) (:foreground "#7f7f7f"))
+ (t (:foreground "#8d8d8d")))
+ "*Face used for arrows in Ztree buffer."
+ :group 'Ztree :group 'font-lock-highlighting-faces)
+(defvar ztreep-arrow-face 'ztreep-arrow-face)
+
+(defface ztreep-expand-sign-face
+ '((((background dark)) (:foreground "#7f7fff"))
+ (t (:foreground "#8d8d8d")))
+ "*Face used for expand sign [+] in Ztree buffer."
+ :group 'Ztree :group 'font-lock-highlighting-faces)
+(defvar ztreep-expand-sign-face 'ztreep-expand-sign-face)
+
+
+;;;###autoload
+(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)
+ ;; fix for electric-indent-mode
+ ;; for emacs 24.4
+ (if (fboundp 'electric-indent-local-mode)
+ (electric-indent-local-mode -1)
+ ;; for emacs 24.3 or less
+ (add-hook 'electric-indent-functions
+ (lambda (arg) 'no-indent) nil 'local)))
+
+
+(defun ztree-find-node-in-line (line)
+ "Return the node for the LINE specified.
+Search through the array of node-line pairs."
+ (gethash line ztree-line-to-node-table))
+
+(defun ztree-find-node-at-point ()
+ "Find the node at point.
+Returns cons pair (node, side) for the current point
+or nil if there is no node"
+ (let ((center (/ (window-width) 2))
+ (node (ztree-find-node-in-line (line-number-at-pos))))
+ (when node
+ (cons node (if (> (current-column) center) 'right 'left)))))
+
+
+(defun ztree-is-expanded-node (node)
+ "Find if the NODE is in the list of expanded nodes."
+ (ztree-find ztree-expanded-nodes-list
+ #'(lambda (x) (funcall ztree-node-equal-fun x node))))
+
+
+(defun ztree-set-parent-for-line (line parent)
+ "For given LINE set the PARENT in the global array."
+ (aset ztree-parent-lines-array (- line ztree-start-line) parent))
+
+(defun ztree-get-parent-for-line (line)
+ "For given LINE return a parent."
+ (when (and (>= line ztree-start-line)
+ (< line (+ (length ztree-parent-lines-array) ztree-start-line)))
+ (aref ztree-parent-lines-array (- line ztree-start-line))))
+
+(defun scroll-to-line (line)
+ "Recommended way to set the cursor to specified LINE."
+ (goto-char (point-min))
+ (forward-line (1- line)))
+
+
+(defun ztree-do-toggle-expand-subtree-iter (node state)
+ "Iteration in expanding subtree.
+Argument NODE current node.
+Argument STATE node state."
+ (when (funcall ztree-node-is-expandable-fun node)
+ (let ((children (funcall ztree-node-contents-fun node)))
+ (ztree-do-toggle-expand-state node state)
+ (dolist (child children)
+ (ztree-do-toggle-expand-subtree-iter child state)))))
+
+
+(defun ztree-do-toggle-expand-subtree ()
+ "Implements the subtree expand."
+ (let* ((line (line-number-at-pos))
+ (node (ztree-find-node-in-line line))
+ ;; save the current window start position
+ (current-pos (window-start)))
+ ;; only for expandable nodes
+ (when (funcall ztree-node-is-expandable-fun node)
+ ;; get the current expand state and invert it
+ (let ((do-expand (not (ztree-is-expanded-node node))))
+ (ztree-do-toggle-expand-subtree-iter node do-expand))
+ ;; refresh buffer and scroll back to the saved line
+ (ztree-refresh-buffer line)
+ ;; restore window start position
+ (set-window-start (selected-window) current-pos))))
+
+
+(defun ztree-do-perform-action (hard)
+ "Toggle expand/collapsed state for nodes or perform an action.
+HARD specifies (t or nil) if the hard action, binded on RET,
+should be performed on node."
+ (let* ((line (line-number-at-pos))
+ (node (ztree-find-node-in-line line)))
+ (when node
+ (if (funcall ztree-node-is-expandable-fun node)
+ ;; only for expandable nodes
+ (ztree-toggle-expand-state node)
+ ;; perform action
+ (when ztree-node-action-fun
+ (funcall ztree-node-action-fun node hard)))
+ ;; save the current window start position
+ (let ((current-pos (window-start)))
+ ;; refresh buffer and scroll back to the saved line
+ (ztree-refresh-buffer line)
+ ;; restore window start position
+ (set-window-start (selected-window) current-pos)))))
+
+
+(defun ztree-perform-action ()
+ "Toggle expand/collapsed state for nodes or perform the action.
+Performs the hard action, binded on RET, on node."
+ (interactive)
+ (ztree-do-perform-action t))
+
+(defun ztree-perform-soft-action ()
+ "Toggle expand/collapsed state for nodes or perform the action.
+Performs the soft action, binded on Space, on node."
+ (interactive)
+ (ztree-do-perform-action nil))
+
+
+(defun ztree-toggle-expand-subtree()
+ "Toggle Expanded/Collapsed state on all nodes of the subtree"
+ (interactive)
+ (ztree-do-toggle-expand-subtree))
+
+(defun ztree-do-toggle-expand-state (node do-expand)
+ "Set the expanded state of the NODE to DO-EXPAND."
+ (if (not do-expand)
+ (setq ztree-expanded-nodes-list
+ (ztree-filter
+ #'(lambda (x) (not (funcall ztree-node-equal-fun node x)))
+ ztree-expanded-nodes-list))
+ (push node ztree-expanded-nodes-list)))
+
+
+(defun ztree-toggle-expand-state (node)
+ "Toggle expanded/collapsed state for NODE."
+ (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node))))
+
+
+(defun ztree-move-up-in-tree ()
+ "Action on Backspace key.
+Jump to the line of a parent node. If previous key was Backspace
+then close the node."
+ (interactive)
+ (when ztree-parent-lines-array
+ (let* ((line (line-number-at-pos (point)))
+ (parent (ztree-get-parent-for-line line)))
+ (when parent
+ (if (and (equal last-command 'ztree-move-up-in-tree)
+ (not ztree-count-subsequent-bs))
+ (let ((node (ztree-find-node-in-line line)))
+ (when (ztree-is-expanded-node node)
+ (ztree-toggle-expand-state node))
+ (setq ztree-count-subsequent-bs t)
+ (ztree-refresh-buffer line))
+ (progn (setq ztree-count-subsequent-bs nil)
+ (scroll-to-line parent)))))))
+
+
+(defun ztree-get-splitted-node-contens (node)
+ "Return pair of 2 elements: list of expandable nodes and list of leafs.
+Argument NODE node which contents will be returned."
+ (let ((nodes (funcall ztree-node-contents-fun node))
+ (comp #'(lambda (x y)
+ (string< (funcall ztree-node-short-name-fun x)
+ (funcall ztree-node-short-name-fun y)))))
+ (cons (sort (ztree-filter
+ #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
+ nodes) comp)
+ (sort (ztree-filter
+ #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
+ nodes) comp))))
+
+
+(defun ztree-draw-char (c x y &optional face)
+ "Draw char C at the position (1-based) (X Y).
+Optional argument FACE face to use to draw a character."
+ (save-excursion
+ (scroll-to-line y)
+ (beginning-of-line)
+ (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))))
+
+(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))))
+ (if (> y1 y2)
+ (progn
+ (dotimes (y count)
+ (ztree-draw-char ?\| x (+ y2 y) face))
+ (ztree-draw-char ?\| x (+ y2 count) face))
+ (progn
+ (dotimes (y count)
+ (ztree-draw-char ?\| x (+ y1 y) face))
+ (ztree-draw-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))))
+ (if (> y1 y2)
+ (progn
+ (dotimes (y count)
+ (ztree-draw-char ?\| x (+ y2 y) face))
+ (ztree-draw-char ?\` x (+ y2 count) face))
+ (progn
+ (dotimes (y count)
+ (ztree-draw-char ?\| x (+ y1 y) face))
+ (ztree-draw-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))))
+
+
+(defun ztree-draw-tree (tree depth start-offset)
+ "Draw the TREE of lines with parents.
+Argument DEPTH current depth.
+Argument START-OFFSET column to start drawing from."
+ (if (atom tree)
+ nil
+ (let* ((root (car tree))
+ (children (cdr tree))
+ (offset (+ start-offset (* depth 4)))
+ (line-start (+ 3 offset))
+ (line-end-leaf (+ 7 offset))
+ (line-end-node (+ 4 offset))
+ ;; 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
+ ;; and which tree (left with offset 0 or right with offset > 0
+ ;; we are drawing
+ (visible #'(lambda (line) ()
+ (if (not ztree-node-side-fun) t
+ (let ((side
+ (gethash line ztree-line-tree-properties)))
+ (cond ((eq side 'left) (= start-offset 0))
+ ((eq side 'right) (> start-offset 0))
+ (t t)))))))
+ (when children
+ ;; draw the line to the last child
+ ;; since we push'd children to the list, it's the first visible line
+ ;; from the children list
+ (let ((last-child (ztree-find children
+ #'(lambda (x)
+ (funcall visible (car-atom x)))))
+ (x-offset (+ 2 offset)))
+ (when last-child
+ (ztree-draw-vertical-rounded-line (1+ root)
+ (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 (car-atom child))
+ (ztree-draw-horizontal-line line-start
+ end
+ (car-atom child)))))))))
+
+(defun ztree-fill-parent-array (tree)
+ "Set the root lines array.
+Argument TREE nodes tree to create an array of lines from."
+ (let ((root (car tree))
+ (children (cdr tree)))
+ (dolist (child children)
+ (ztree-set-parent-for-line (car-atom child) root)
+ (when (listp child)
+ (ztree-fill-parent-array child)))))
+
+
+(defun ztree-insert-node-contents (path)
+ "Insert node contents with initial depth 0.
+`ztree-insert-node-contents-1' return the tree of line
+numbers to determine who is parent line of the
+particular line. This tree is used to draw the
+graph.
+Argument PATH start node."
+ (let ((tree (ztree-insert-node-contents-1 path 0))
+ ;; number of 'rows' in tree is last line minus start line
+ (num-of-items (- (line-number-at-pos (point)) ztree-start-line)))
+ ;; create a parents array to store parents of lines
+ ;; parents array used for navigation with the BS
+ (setq ztree-parent-lines-array (make-vector num-of-items 0))
+ ;; set the root node in lines parents array
+ (ztree-set-parent-for-line ztree-start-line ztree-start-line)
+ ;; fill the parent arrray from the tree
+ (ztree-fill-parent-array tree)
+ ;; draw the tree starting with depth 0 and offset 0
+ (ztree-draw-tree tree 0 0)
+ ;; for the 2-sided tree we need to draw the vertical line
+ ;; and an additional tree
+ (if ztree-node-side-fun ; 2-sided tree
+ (let ((width (window-width)))
+ ;; draw the vertical line in the middle of the window
+ (ztree-draw-vertical-line ztree-start-line
+ (1- (+ num-of-items ztree-start-line))
+ (/ width 2)
+ 'vertical-border)
+ (ztree-draw-tree tree 0 (1+ (/ width 2)))))))
+
+
+(defun ztree-insert-node-contents-1 (node depth)
+ "Recursively insert contents of the NODE with current DEPTH."
+ (let* ((expanded (ztree-is-expanded-node node))
+ ;; insert node entry with defined depth
+ (root-line (ztree-insert-entry node depth expanded))
+ ;; children list is the list of lines which are children
+ ;; of the root line
+ (children nil))
+ (when expanded ;; if expanded we need to add all subnodes
+ (let* ((contents (ztree-get-splitted-node-contens node))
+ ;; contents is the list of 2 elements:
+ (nodes (car contents)) ; expandable entries - nodes
+ (leafs (cdr contents))) ; leafs - which doesn't have subleafs
+ ;; iterate through all expandable entries to insert them first
+ (dolist (node nodes)
+ ;; if it is not in the filter list
+ (when (funcall ztree-node-showp-fun node)
+ ;; insert node on the next depth level
+ ;; and push the returning result (in form (root children))
+ ;; to the children list
+ (push (ztree-insert-node-contents-1 node (1+ depth))
+ children)))
+ ;; now iterate through all the leafs
+ (dolist (leaf leafs)
+ ;; if not in filter list
+ (when (funcall ztree-node-showp-fun leaf)
+ ;; insert the leaf and add it to children
+ (push (ztree-insert-entry leaf (1+ depth) nil)
+ children)))))
+ ;; result value is the list - head is the root line,
+ ;; rest are children
+ (cons root-line children)))
+
+(defun ztree-insert-entry (node depth expanded)
+ "Inselt the NODE to the current line with specified DEPTH and EXPANDED
state."
+ (let ((line (line-number-at-pos))
+ (expandable (funcall ztree-node-is-expandable-fun node))
+ (short-name (funcall ztree-node-short-name-fun node)))
+ (if ztree-node-side-fun ; 2-sided tree
+ (let ((right-short-name (funcall ztree-node-short-name-fun node t))
+ (side (funcall ztree-node-side-fun node))
+ (width (window-width)))
+ (when (eq side 'left) (setq right-short-name ""))
+ (when (eq side 'right) (setq short-name ""))
+ (ztree-insert-single-entry short-name depth
+ expandable expanded 0
+ (when ztree-node-face-fun
+ (funcall ztree-node-face-fun node)))
+ (ztree-insert-single-entry right-short-name depth
+ expandable expanded (1+ (/ width 2))
+ (when ztree-node-face-fun
+ (funcall ztree-node-face-fun node)))
+ (puthash line side ztree-line-tree-properties))
+ (ztree-insert-single-entry short-name depth expandable expanded 0))
+ (puthash line node ztree-line-to-node-table)
+ (newline-and-begin)
+ line))
+
+(defun ztree-insert-single-entry (short-name depth
+ expandable expanded
+ offset
+ &optional face)
+ "Writes a SHORT-NAME in a proper position with the type given.
+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)
+ (delete-region (point) (line-end-position))
+ (when (> depth 0)
+ (dotimes (i depth)
+ (insert " ")
+ (insert-char ?\s 3))) ; insert 3 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))))))
+
+(defun ztree-jump-side ()
+ "Jump to another side for 2-sided trees."
+ (interactive)
+ (when ztree-node-side-fun ; 2-sided tree
+ (let ((center (/ (window-width) 2)))
+ (cond ((< (current-column) center)
+ (move-to-column (1+ center)))
+ ((> (current-column) center)
+ (move-to-column 1))
+ (t nil)))))
+
+
+
+(defun ztree-refresh-buffer (&optional line)
+ "Refresh the buffer.
+Optional argument LINE scroll to the line given."
+ (interactive)
+ (when (and (equal major-mode 'ztree-mode)
+ (boundp 'ztree-start-node))
+ (setq ztree-line-to-node-table (make-hash-table))
+ ;; create a hash table of node properties for line
+ ;; used in 2-side tree mode
+ (when ztree-node-side-fun
+ (setq ztree-line-tree-properties (make-hash-table)))
+ (toggle-read-only)
+ (erase-buffer)
+ (funcall ztree-tree-header-fun)
+ (setq ztree-start-line (line-number-at-pos (point)))
+ (ztree-insert-node-contents ztree-start-node)
+ (scroll-to-line (if line line ztree-start-line))
+ (toggle-read-only)))
+
+
+(defun ztree-view (
+ buffer-name
+ start-node
+ filter-fun
+ header-fun
+ short-name-fun
+ expandable-p
+ equal-fun
+ children-fun
+ face-fun
+ action-fun
+ &optional node-side-fun
+ )
+ "Create a ztree view buffer configured with parameters given.
+Argument BUFFER-NAME Name of the buffer created.
+Argument START-NODE Starting node - the root of the tree.
+Argument FILTER-FUN Function which will define if the node should not be
+visible.
+Argument HEADER-FUN Function which inserts the header into the buffer
+before drawing the tree.
+Argument SHORT-NAME-FUN Function which return the short name for a node given.
+Argument EXPANDABLE-P Function to determine if the node is expandable.
+Argument EQUAL-FUN An equality function for nodes.
+Argument CHILDREN-FUN Function to get children from the node.
+Argument FACE-FUN Function to determine face of the node.
+Argument ACTION-FUN an action to perform when the Return is pressed.
+Optional argument NODE-SIDE-FUN Determines the side of the node."
+ (let ((buf (get-buffer-create buffer-name)))
+ (switch-to-buffer buf)
+ (ztree-mode)
+ ;; configure ztree-view
+ (setq ztree-start-node start-node)
+ (setq ztree-expanded-nodes-list (list ztree-start-node))
+ (setq ztree-node-showp-fun filter-fun)
+ (setq ztree-tree-header-fun header-fun)
+ (setq ztree-node-short-name-fun short-name-fun)
+ (setq ztree-node-is-expandable-fun expandable-p)
+ (setq ztree-node-equal-fun equal-fun)
+ (setq ztree-node-contents-fun children-fun)
+ (setq ztree-node-face-fun face-fun)
+ (setq ztree-node-action-fun action-fun)
+ (setq ztree-node-side-fun node-side-fun)
+ (ztree-refresh-buffer)))
+
+
+(provide 'ztree-view)
+;;; ztree-view.el ends here
- [elpa] master 7156104 81/92: Updated ztree-diff-filter-list, (continued)
- [elpa] master 7156104 81/92: Updated ztree-diff-filter-list, Alexey Veretennikov, 2015/06/11
- [elpa] master c7a05e8 83/92: Merge pull request #16 from syohex/fix-declarations, Alexey Veretennikov, 2015/06/11
- [elpa] master 39854cd 82/92: Fix variable declarations, Alexey Veretennikov, 2015/06/11
- [elpa] master 22c97ab 87/92: Updated readme with info about ELPA, Alexey Veretennikov, 2015/06/11
- [elpa] master ffd97be 89/92: Preparation for GNU ELPA, Alexey Veretennikov, 2015/06/11
- [elpa] master 1dbb290 92/92: Merge remote-tracking branch 'ztree/master', Alexey Veretennikov, 2015/06/11
- [elpa] master f4e5784 86/92: Updated copyright, Alexey Veretennikov, 2015/06/11
- [elpa] master acdfae0 91/92: Updated pkg file, Alexey Veretennikov, 2015/06/11
- [elpa] master b34a45a 90/92: Merge remote-tracking branch 'ztree/master', Alexey Veretennikov, 2015/06/11
- [elpa] master 568f3cd 84/92: Fixed checkdoc comments, Alexey Veretennikov, 2015/06/11
- [elpa] master 60d88e2 88/92: Added ztree package,
Alexey Veretennikov <=
- [elpa] master fa8b3f5 85/92: Preparing to submit to GNU ELPA, Alexey Veretennikov, 2015/06/11