branch: master
commit 30984c4c4be84d1f2b71ab6f8a57886cc630f080
Merge: b9e7d42 1dbb290
Author: Artur Malabarba <bruce.connor...@gmail.com>
Commit: Artur Malabarba <bruce.connor...@gmail.com>
Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa
---
GNUmakefile | 4 +-
packages/ace-window/README.md | 42 +++
packages/ace-window/ace-window.el | 272 ++++++++++------
packages/csv-mode/csv-mode.el | 35 +-
packages/let-alist/let-alist.el | 10 +-
packages/nlinum/nlinum.el | 42 ++-
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 | 2 +
packages/ztree/ztree-util.el | 133 ++++++++
packages/ztree/ztree-view.el | 650 ++++++++++++++++++++++++++++++++++++
packages/ztree/ztree.el | 39 +++
14 files changed, 2086 insertions(+), 137 deletions(-)
diff --git a/GNUmakefile b/GNUmakefile
index e35b82d..03044dc 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -15,7 +15,9 @@ check_copyrights:
@echo "Compute exceptions >$(CR_EXCEPTIONS)~"
@export LANG=C; \
(cd packages; \
- find . -name '.git' -prune -o -name '*.el' -print0 | \
+ find . -name '.git' -prune -o \
+ -name 'test' -prune -o \
+ -name '*.el' -print0 | \
xargs -0 grep -L 'Free Software Foundation, Inc' | \
grep -v '\(\.dir-locals\|.-\(pkg\|autoloads\)\)\.el$$'; \
find . -name '.git' -prune -o -name '*.el' -print | \
diff --git a/packages/ace-window/README.md b/packages/ace-window/README.md
index 1b2f808..d70548a 100644
--- a/packages/ace-window/README.md
+++ b/packages/ace-window/README.md
@@ -44,6 +44,20 @@ always be `1`.
- You can delete the selected window by calling `ace-window` with a double
prefix argument, i.e. <kbd>C-u C-u</kbd>.
+## Change the action midway
+
+You can also start by calling `ace-window` and then decide to switch the
action to `delete` or `swap` etc. By default the bindings are:
+
+- <kbd>x</kbd> - delete window
+- <kbd>m</kbd> - swap (move) window
+- <kbd>v</kbd> - split window vertically
+- <kbd>b</kbd> - split window horizontally
+- <kbd>n</kbd> - select the previous window
+- <kbd>i</kbd> - maximize window (select which window)
+- <kbd>o</kbd> - maximize current window
+
+In order for it to work, these keys *must not* be in `aw-keys` and you have to
have `aw-dispatch-always` set to `t`.
+
## Customization
Aside from binding `ace-window`:
@@ -76,3 +90,31 @@ where to look, i.e. the top-left corners of each window.
So you can turn off the gray background with:
(setq aw-background nil)
+
+### `aw-dispatch-always`
+
+When non-nil, `ace-window` will issue a `read-char` even for one window.
+This will make `ace-window` act differently from `other-window` for one
+or two windows. This is useful to change the action midway
+and execute other action other than the *jump* default.
+By default is set to `nil`
+
+### `aw-dispatch-alist`
+
+This is the list of actions that you can trigger from `ace-window` other than
the
+*jump* default.
+By default is:
+
+ (defvar aw-dispatch-alist
+ '((?x aw-delete-window " Ace - Delete Window")
+ (?m aw-swap-window " Ace - Swap Window")
+ (?n aw-flip-window)
+ (?v aw-split-window-vert " Ace - Split Vert Window")
+ (?b aw-split-window-horz " Ace - Split Horz Window")
+ (?i delete-other-windows " Ace - Maximize Window")
+ (?o delete-other-windows))
+ "List of actions for `aw-dispatch-default'.")
+
+If the pair key-action is followed by a string, then `ace-window` will be
+invoked again to be able to select on which window you want to select the
+action. Otherwise the current window is selected.
diff --git a/packages/ace-window/ace-window.el
b/packages/ace-window/ace-window.el
index 791b34d..a1c12ed 100644
--- a/packages/ace-window/ace-window.el
+++ b/packages/ace-window/ace-window.el
@@ -5,8 +5,8 @@
;; Author: Oleh Krehel <ohwoeo...@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeo...@gmail.com>
;; URL: https://github.com/abo-abo/ace-window
-;; Version: 0.8.1
-;; Package-Requires: ((avy "0.1.0"))
+;; Version: 0.9.0
+;; Package-Requires: ((avy "0.2.0"))
;; Keywords: window, location
;; This file is part of GNU Emacs.
@@ -60,7 +60,7 @@
;; deleted instead.
;;; Code:
-(require 'avy-jump)
+(require 'avy)
(require 'ring)
;;* Customization
@@ -101,6 +101,12 @@ Use M-0 `ace-window' to toggle this value."
(const :tag "single char" 'char)
(const :tag "full path" 'path)))
+(defcustom aw-dispatch-always nil
+ "When non-nil, `ace-window' will issue a `read-char' even for one window.
+This will make `ace-window' act different from `other-window' for
+ one or two windows."
+ :type 'boolean)
+
(defface aw-leading-char-face
'((((class color)) (:foreground "red"))
(((background dark)) (:foreground "gray100"))
@@ -130,15 +136,11 @@ Use M-0 `ace-window' to toggle this value."
(sort
(cl-remove-if
(lambda (w)
- (let ((f (window-frame w))
- (b (window-buffer w)))
+ (let ((f (window-frame w)))
(or (not (and (frame-live-p f)
(frame-visible-p f)))
(string= "initial_terminal" (terminal-name f))
- (aw-ignored-p w)
- (with-current-buffer b
- (and buffer-read-only
- (= 0 (buffer-size b)))))))
+ (aw-ignored-p w))))
(cl-case aw-scope
(global
(cl-mapcan #'window-list (frame-list)))
@@ -159,49 +161,63 @@ Use M-0 `ace-window' to toggle this value."
(nconc minor-mode-alist
(list '(ace-window-mode ace-window-mode))))
+(defvar aw-empty-buffers-list nil
+ "Store the read-only empty buffers which had to be modified.
+Modify them back eventually.")
+
(defun aw--done ()
"Clean up mode line and overlays."
;; mode line
- (setq ace-window-mode nil)
- (force-mode-line-update)
+ (aw-set-mode-line nil)
;; background
(mapc #'delete-overlay aw-overlays-back)
(setq aw-overlays-back nil)
- (avy--remove-leading-chars))
+ (avy--remove-leading-chars)
+ (dolist (b aw-empty-buffers-list)
+ (with-current-buffer b
+ (when (string= (buffer-string) " ")
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))))))
+ (setq aw-empty-buffers-list nil))
(defun aw--lead-overlay (path leaf)
"Create an overlay using PATH at LEAF.
LEAF is (PT . WND)."
- (let* ((pt (car leaf))
- (wnd (cdr leaf))
- (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
- (old-str (or
- (ignore-errors
- (with-selected-window wnd
- (buffer-substring pt (1+ pt))))
- ""))
- (new-str
- (concat
- (cl-case aw-leading-char-style
- (char
- (apply #'string (last path)))
- (path
- (apply #'string (reverse path)))
- (t
- (error "Bad `aw-leading-char-style': %S"
- aw-leading-char-style)))
- (cond ((string-equal old-str "\t")
- (make-string (1- tab-width) ?\ ))
- ((string-equal old-str "\n")
- "\n")
+ (let ((wnd (cdr leaf)))
+ (with-selected-window wnd
+ (when (= 0 (buffer-size))
+ (push (current-buffer) aw-empty-buffers-list)
+ (let ((inhibit-read-only t))
+ (insert " ")))
+ (let* ((pt (car leaf))
+ (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
+ (old-str (or
+ (ignore-errors
+ (with-selected-window wnd
+ (buffer-substring pt (1+ pt))))
+ ""))
+ (new-str
+ (concat
+ (cl-case aw-leading-char-style
+ (char
+ (apply #'string (last path)))
+ (path
+ (apply #'string (reverse path)))
(t
- (make-string
- (max 0 (1- (string-width old-str)))
- ?\ ))))))
- (overlay-put ol 'face 'aw-leading-char-face)
- (overlay-put ol 'window wnd)
- (overlay-put ol 'display new-str)
- (push ol avy--overlays-lead)))
+ (error "Bad `aw-leading-char-style': %S"
+ aw-leading-char-style)))
+ (cond ((string-equal old-str "\t")
+ (make-string (1- tab-width) ?\ ))
+ ((string-equal old-str "\n")
+ "\n")
+ (t
+ (make-string
+ (max 0 (1- (string-width old-str)))
+ ?\ ))))))
+ (overlay-put ol 'face 'aw-leading-char-face)
+ (overlay-put ol 'window wnd)
+ (overlay-put ol 'display new-str)
+ (push ol avy--overlays-lead)))))
(defun aw--make-backgrounds (wnd-list)
"Create a dim background overlay for each window on WND-LIST."
@@ -216,91 +232,122 @@ LEAF is (PT . WND)."
ol))
wnd-list))))
-(defvar aw--flip-keys nil
- "Pre-processed `aw-flip-keys'.")
-
-(defcustom aw-flip-keys '("n")
- "Keys which should select the last window."
- :set (lambda (sym val)
- (set sym val)
- (setq aw--flip-keys
- (mapcar (lambda (x) (aref (kbd x) 0)) val))))
-
-(defun aw-select (mode-line)
+(define-obsolete-variable-alias
+ 'aw-flip-keys 'aw--flip-keys "0.1.0"
+ "Use `aw-dispatch-alist' instead.")
+
+(defvar aw-dispatch-function 'aw-dispatch-default
+ "Function to call when a character not in `aw-keys' is pressed.")
+
+(defvar aw-action nil
+ "Function to call at the end of `aw-select'.")
+
+(defun aw-set-mode-line (str)
+ "Set mode line indicator to STR."
+ (setq ace-window-mode str)
+ (force-mode-line-update))
+
+(defvar aw-dispatch-alist
+ '((?x aw-delete-window " Ace - Delete Window")
+ (?m aw-swap-window " Ace - Swap Window")
+ (?n aw-flip-window)
+ (?v aw-split-window-vert " Ace - Split Vert Window")
+ (?b aw-split-window-horz " Ace - Split Horz Window")
+ (?i delete-other-windows " Ace - Maximize Window")
+ (?o delete-other-windows))
+ "List of actions for `aw-dispatch-default'.")
+
+(defun aw-dispatch-default (char)
+ "Perform an action depending on CHAR."
+ (let ((val (cdr (assoc char aw-dispatch-alist))))
+ (if val
+ (if (and (car val) (cadr val))
+ (prog1 (setq aw-action (car val))
+ (aw-set-mode-line (cadr val)))
+ (funcall (car val))
+ (throw 'done 'exit))
+ (avy-handler-default char))))
+
+(defun aw-select (mode-line &optional action)
"Return a selected other window.
Amend MODE-LINE to the mode line for the duration of the selection."
+ (setq aw-action action)
(let ((start-window (selected-window))
(next-window-scope (cl-case aw-scope
('global 'visible)
('frame 'frame)))
(wnd-list (aw-window-list))
- final-window)
- (cl-case (length wnd-list)
- (0
- start-window)
- (1
- (car wnd-list))
- (2
- (setq final-window (next-window nil nil next-window-scope))
- (while (and (aw-ignored-p final-window)
- (not (equal final-window start-window)))
- (setq final-window (next-window final-window nil next-window-scope)))
- final-window)
- (t
- (let ((candidate-list
- (mapcar (lambda (wnd)
- ;; can't jump if the buffer is empty
- (with-current-buffer (window-buffer wnd)
- (when (= 0 (buffer-size))
- (insert " ")))
- (cons (aw-offset wnd) wnd))
- wnd-list)))
- (aw--make-backgrounds wnd-list)
- (setq ace-window-mode mode-line)
- (force-mode-line-update)
- ;; turn off helm transient map
- (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
- (unwind-protect
- (condition-case err
- (or (cdr (avy-read (avy-tree candidate-list aw-keys)
- #'aw--lead-overlay
- #'avy--remove-leading-chars))
- start-window)
- (error
- (if (memq (nth 2 err) aw--flip-keys)
- (aw--pop-window)
- (signal (car err) (cdr err)))))
- (aw--done)))))))
+ window)
+ (setq window
+ (cond ((<= (length wnd-list) 1)
+ (when aw-dispatch-always
+ (setq aw-action
+ (unwind-protect
+ (catch 'done
+ (funcall aw-dispatch-function (read-char)))
+ (aw--done)))
+ (when (eq aw-action 'exit)
+ (setq aw-action nil)))
+ (or (car wnd-list) start-window))
+ ((and (= (length wnd-list) 2)
+ (not aw-dispatch-always)
+ (not aw-ignore-current))
+ (let ((wnd (next-window nil nil next-window-scope)))
+ (while (and (aw-ignored-p wnd)
+ (not (equal wnd start-window)))
+ (setq wnd (next-window wnd nil next-window-scope)))
+ wnd))
+ (t
+ (let ((candidate-list
+ (mapcar (lambda (wnd)
+ (cons (aw-offset wnd) wnd))
+ wnd-list)))
+ (aw--make-backgrounds wnd-list)
+ (aw-set-mode-line mode-line)
+ ;; turn off helm transient map
+ (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
+ (unwind-protect
+ (let* ((avy-handler-function aw-dispatch-function)
+ (res (avy-read (avy-tree candidate-list aw-keys)
+ #'aw--lead-overlay
+ #'avy--remove-leading-chars)))
+ (if (eq res 'exit)
+ (setq aw-action nil)
+ (or (cdr res)
+ start-window)))
+ (aw--done))))))
+ (if aw-action
+ (funcall aw-action window)
+ window)))
;;* Interactive
;;;###autoload
(defun ace-select-window ()
"Ace select window."
(interactive)
- (aw-switch-to-window
- (aw-select " Ace - Window")))
+ (aw-select " Ace - Window"
+ #'aw-switch-to-window))
;;;###autoload
(defun ace-delete-window ()
"Ace delete window."
(interactive)
- (aw-delete-window
- (aw-select " Ace - Delete Window")))
+ (aw-select " Ace - Delete Window"
+ #'aw-delete-window))
;;;###autoload
(defun ace-swap-window ()
"Ace swap window."
(interactive)
- (aw-swap-window
- (aw-select " Ace - Swap Window")))
+ (aw-select " Ace - Swap Window"
+ #'aw-swap-window))
;;;###autoload
(defun ace-maximize-window ()
"Ace maximize window."
(interactive)
- (select-window
- (aw-select " Ace - Maximize Window"))
- (delete-other-windows))
+ (aw-select " Ace - Maximize Window"
+ #'delete-other-windows))
;;;###autoload
(defun ace-window (arg)
@@ -360,10 +407,15 @@ Windows are numbered top down, left to right."
"Return the removed top of `aw--window-ring'."
(let (res)
(condition-case nil
- (while (not (window-live-p
- (setq res (ring-remove aw--window-ring 0)))))
+ (while (or (not (window-live-p
+ (setq res (ring-remove aw--window-ring 0))))
+ (equal res (selected-window))))
(error
- (error "No previous windows stored")))
+ (if (= (length (aw-window-list)) 2)
+ (progn
+ (other-window 1)
+ (setq res (selected-window)))
+ (error "No previous windows stored"))))
res))
(defun aw-switch-to-window (window)
@@ -395,6 +447,10 @@ Windows are numbered top down, left to right."
(delete-window window)
(error "Got a dead window %S" window)))))
+(defcustom aw-swap-invert nil
+ "When non-nil, the other of the two swapped windows gets the point."
+ :type 'boolean)
+
(defun aw-swap-window (window)
"Swap buffers of current window and WINDOW."
(cl-labels ((swap-windows (window1 window2)
@@ -412,7 +468,19 @@ Windows are numbered top down, left to right."
(when (and (window-live-p window)
(not (eq window this-window)))
(aw--push-window this-window)
- (swap-windows this-window window)))))
+ (if aw-swap-invert
+ (swap-windows window this-window)
+ (swap-windows this-window window))))))
+
+(defun aw-split-window-vert (window)
+ "Split WINDOW vertically."
+ (select-window window)
+ (split-window-vertically))
+
+(defun aw-split-window-horz (window)
+ "Split WINDOW horizontally."
+ (select-window window)
+ (split-window-horizontally))
(defun aw-offset (window)
"Return point in WINDOW that's closest to top left corner.
diff --git a/packages/csv-mode/csv-mode.el b/packages/csv-mode/csv-mode.el
index effc72e..692579d 100644
--- a/packages/csv-mode/csv-mode.el
+++ b/packages/csv-mode/csv-mode.el
@@ -5,7 +5,7 @@
;; Author: Francis J. Wright <F.J.Wright at qmul.ac.uk>
;; Time-stamp: <23 August 2004>
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/
-;; Version: 1.3
+;; Version: 1.4
;; Keywords: convenience
;; This package is free software; you can redistribute it and/or modify
@@ -332,24 +332,25 @@ It must be either a string or nil."
(list (edit-and-eval-command
"Comment start (string or nil): " csv-comment-start)))
;; Paragraph means a group of contiguous records:
- (setq csv-comment-start string)
(set (make-local-variable 'paragraph-separate) "[:space:]*$") ; White space.
(set (make-local-variable 'paragraph-start) "\n");Must include \n explicitly!
- (if string
- (progn
- (setq paragraph-separate (concat paragraph-separate "\\|" string)
- paragraph-start (concat paragraph-start "\\|" string))
- (set (make-local-variable 'comment-start) string)
- (modify-syntax-entry
- (string-to-char string) "<" csv-mode-syntax-table)
- (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
- (with-syntax-table text-mode-syntax-table
- (modify-syntax-entry (string-to-char string)
- (string (char-syntax (string-to-char string)))
- csv-mode-syntax-table)
- (modify-syntax-entry ?\n
- (string (char-syntax ?\n))
- csv-mode-syntax-table))))
+ ;; Remove old comment-start/end if available
+ (with-syntax-table text-mode-syntax-table
+ (when comment-start
+ (modify-syntax-entry (string-to-char comment-start)
+ (string (char-syntax (string-to-char comment-start)))
+ csv-mode-syntax-table))
+ (modify-syntax-entry ?\n
+ (string (char-syntax ?\n))
+ csv-mode-syntax-table))
+ (when string
+ (setq paragraph-separate (concat paragraph-separate "\\|" string)
+ paragraph-start (concat paragraph-start "\\|" string))
+ (set (make-local-variable 'comment-start) string)
+ (modify-syntax-entry
+ (string-to-char string) "<" csv-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" csv-mode-syntax-table))
+ (setq csv-comment-start string))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Cc][Ss][Vv]\\'" . csv-mode))
diff --git a/packages/let-alist/let-alist.el b/packages/let-alist/let-alist.el
index c490a9f..ca7a904 100644
--- a/packages/let-alist/let-alist.el
+++ b/packages/let-alist/let-alist.el
@@ -4,7 +4,7 @@
;; Author: Artur Malabarba <bruce.connor...@gmail.com>
;; Maintainer: Artur Malabarba <bruce.connor...@gmail.com>
-;; Version: 1.0.3
+;; Version: 1.0.4
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
@@ -72,12 +72,12 @@ symbol, and each cdr is the same symbol without the `.'."
;; Return the cons cell inside a list, so it can be appended
;; with other results in the clause below.
(list (cons data (intern (replace-match "" nil nil name)))))))
- ((not (listp data)) nil)
- (t (apply #'append
- (mapcar #'let-alist--deep-dot-search data)))))
+ ((not (consp data)) nil)
+ (t (append (let-alist--deep-dot-search (car data))
+ (let-alist--deep-dot-search (cdr data))))))
(defun let-alist--access-sexp (symbol variable)
- "Return a sexp used to acess SYMBOL inside VARIABLE."
+ "Return a sexp used to access SYMBOL inside VARIABLE."
(let* ((clean (let-alist--remove-dot symbol))
(name (symbol-name clean)))
(if (string-match "\\`\\." name)
diff --git a/packages/nlinum/nlinum.el b/packages/nlinum/nlinum.el
index 2505c98..98c9cbc 100644
--- a/packages/nlinum/nlinum.el
+++ b/packages/nlinum/nlinum.el
@@ -82,18 +82,36 @@ Linum mode is a buffer-local minor mode."
width)))))
(defun nlinum--setup-window ()
- (let ((width (if (display-graphic-p)
- (ceiling
- (let ((width (nlinum--face-width 'linum)))
- (if width
- (/ (* nlinum--width 1.0 width)
- (frame-char-width))
- (/ (* nlinum--width 1.0
- (nlinum--face-height 'linum))
- (frame-char-height)))))
- nlinum--width)))
- (set-window-margins nil (if nlinum-mode width)
- (cdr (window-margins)))))
+ ;; FIXME: The interaction between different uses of the margin is
+ ;; problematic. We should have a way for different packages to indicate (and
+ ;; change) their preference independently.
+ (let* ((width (if (display-graphic-p)
+ (ceiling
+ (let ((width (nlinum--face-width 'linum)))
+ (if width
+ (/ (* nlinum--width 1.0 width)
+ (frame-char-width))
+ (/ (* nlinum--width 1.0
+ (nlinum--face-height 'linum))
+ (frame-char-height)))))
+ nlinum--width))
+ (cur-margins (window-margins))
+ (cur-margin (car cur-margins))
+ ;; (EXT . OURS) keeps track of the size of the margin, where EXT is
the
+ ;; size chosen by external code and OURS is the size we last set.
+ ;; OURS is used to detect when someone else modifies the margin.
+ (margin-settings (window-parameter nil 'linum--margin)))
+ (if margin-settings
+ (unless (eq (cdr margin-settings) cur-margin)
+ ;; Damn! The margin is not what it used to be! => Update EXT!
+ (setcar margin-settings cur-margin))
+ (set-window-parameter nil 'linum--margin
+ (setq margin-settings (list cur-margin))))
+ (and (car margin-settings) width
+ (setq width (max width (car margin-settings))))
+ (setcdr margin-settings width)
+ (set-window-margins nil (if nlinum-mode width (car margin-settings))
+ (cdr cur-margins))))
(defun nlinum--setup-windows ()
(dolist (win (get-buffer-window-list nil nil t))
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..2ee40ca
--- /dev/null
+++ b/packages/ztree/ztree-pkg.el
@@ -0,0 +1,2 @@
+;; Generated package description from ztree.el
+(define-package "ztree" "1.0.1" "Text mode directory tree" 'nil :url
"https://github.com/fourier/ztree"; :keywords '("files" "tools"))
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
diff --git a/packages/ztree/ztree.el b/packages/ztree/ztree.el
new file mode 100644
index 0000000..3958daa
--- /dev/null
+++ b/packages/ztree/ztree.el
@@ -0,0 +1,39 @@
+;;; ztree.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
+;;
+;; Version: 1.0.1
+;;
+;; 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-dir)
+(require 'ztree-diff)
+
+(provide 'ztree)
+;;; ztree.el ends here
