branch: master
commit 6154ab86fe73aa5cfd664a89e8e8824cd9f20d0d
Author: Alexey Veretennikov <alexey.veretenni...@gmail.com>
Commit: Alexey Veretennikov <alexey.veretenni...@gmail.com>
Split view and models - for directory tree and for diff tree
---
ztree-diff-model.el | 38 ++++-
ztree-diff.el | 59 +++++++
ztree.el => ztree-view.el | 79 +++------
ztree.el | 393 ++-------------------------------------------
4 files changed, 133 insertions(+), 436 deletions(-)
diff --git a/ztree-diff-model.el b/ztree-diff-model.el
index b4360da..02ee290 100644
--- a/ztree-diff-model.el
+++ b/ztree-diff-model.el
@@ -15,6 +15,24 @@
(defun ztree-diff-model-get-right-path (node)
(plist-get node 'right))
+(defun ztree-diff-model-short-name (node)
+ (plist-get node 'short))
+
+(defun ztree-diff-model-children (node)
+ (plist-get node 'children))
+
+(defun ztree-diff-model-differet (node)
+ (plist-get node 'different))
+
+(defun ztree-diff-model-is-directory (node)
+ (let ((left (plist-get node 'left))
+ (right (plist-get node 'right)))
+ (if left
+ (file-directory-p left)
+ (file-directory-p right))))
+
+
+
(defun ztree-diff-model-files-equal (file1 file2)
"Compare files using external diff. Returns t if equal"
@@ -134,10 +152,22 @@ the rest is the combined list of nodes"
result))))
(cons different-dir result)))
-
-(ztree-diff-model-traverse "path1" "path2")
-
-
+(defun ztree-diff-model-create (dir1 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))
+ (let ((traverse (ztree-diff-model-traverse dir1 dir2)))
+ (ztree-diff-model-create-node dir1 dir2
+ (concat (file-short-name dir1)
+ " vs "
+ (file-short-name dir2))
+ (cdr traverse)
+ (car traverse))))
+
+
+(provide 'ztree-diff-model)
+
diff --git a/ztree-diff.el b/ztree-diff.el
new file mode 100644
index 0000000..9101db3
--- /dev/null
+++ b/ztree-diff.el
@@ -0,0 +1,59 @@
+;;; ztree-diff.el --- Text mode diff for directory trees
+
+;; Copyright (C) 2013 Alexey Veretennikov
+;;
+;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
+;; Created: 2013-11-1l
+;; Version: 1.0.0
+;; Keywords: files
+;; URL: https://github.com/fourier/ztree
+;; Compatibility: GNU Emacs GNU Emacs 24.x
+;;
+;; This file is NOT part of GNU Emacs.
+;;
+;; This program 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 2
+;; of the License, or (at your option) any later version.
+;;
+;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+
+(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 ..")
+
+(defun ztree-diff-insert-buffer-header ()
+ (insert "Differences tree")
+ (newline)
+ (insert "==============")
+ (newline))
+
+
+(defun ztree-diff (dir1 dir2)
+ "Creates an interactive buffer with the directory tree of the path given"
+ (interactive "DLeft directory \nDRight directory")
+ (let* ((difference (ztree-diff-model-create dir1 dir2))
+ (buf-name (concat "*" (ztree-diff-model-short-name difference) "*")))
+ (ztree-view buf-name
+ difference
+ (list ztree-diff-hidden-files-regexp)
+ 'ztree-diff-insert-buffer-header
+ 'ztree-diff-model-short-name
+ 'ztree-diff-model-is-directory
+ 'equal
+ 'ztree-diff-model-children)))
+
+
+(provide 'ztree-diff)
+;;; ztree-diff.el ends here
diff --git a/ztree.el b/ztree-view.el
similarity index 89%
copy from ztree.el
copy to ztree-view.el
index 5a76e94..b7731ab 100644
--- a/ztree.el
+++ b/ztree-view.el
@@ -1,10 +1,10 @@
-;;; ztree.el --- Text mode directory tree
+;;; ztree-view.el --- Text mode tree view (buffer)
;; Copyright (C) 2013 Alexey Veretennikov
;;
;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
;; Created: 2013-11-1l
-;; Version: 1.0.0
+;; Version: 1.0.1
;; Keywords: files
;; URL: https://github.com/fourier/ztree
;; Compatibility: GNU Emacs GNU Emacs 24.x
@@ -27,36 +27,26 @@
;;; Commentary:
;;
;; Add the following to your .emacs file:
-;;
-;; (require 'ztree)
+;;
+;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
+;; (require 'ztree-view)
;;
;; Call the ztree interactive function:
-;; M-x ztree
-;; Open/close directories with double-click, Enter or Space keys
+;; Use the following function: ztree-view
;;
;;; Issues:
;;
;;; TODO:
-;; 1) Add some file-handling and marking abilities
-;; 2) Extract tree code as as separate package
;;
;;
;;; Change Log:
-;;
+;;
;; 2013-11-10 (1.0.0)
;; Initial Release.
;;
;;; Code:
;;
-;; Constants
-;;
-
-(defconst ztree-hidden-files-regexp "^\\."
- "Hidden files regexp. By default all filest starting with dot '.',
-including . and ..")
-
-;;
;; Globals
;;
@@ -422,45 +412,30 @@ apparently shall not be visible"
(toggle-read-only)))
-;;
-;; File bindings to the tree control
-;;
-
-(defun ztree-insert-buffer-header ()
- (insert "Directory tree")
- (newline)
- (insert "==============")
- (newline))
-
-(defun printable-string (string)
- "Strip newline character from file names, like 'Icon\n'"
- (replace-regexp-in-string "\n" "" string))
-
-(defun file-short-name (file)
- "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 ztree (path)
- "Creates 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 (get-buffer-create (concat "*Directory " path " tree*"))))
+(defun ztree-view (
+ buffer-name
+ start-node
+ filter-list
+ header-fun
+ short-name-fun
+ expandable-p
+ equal-fun
+ children-fun
+ )
+ (let ((buf (get-buffer-create buffer-name)))
(switch-to-buffer buf)
(ztree-mode)
;; configure ztree to work with directories
- (setq ztree-start-node (expand-file-name (substitute-in-file-name path)))
+ (setq ztree-start-node start-node)
(setq ztree-expanded-nodes-list (list ztree-start-node))
- (setq ztree-filter-list (list ztree-hidden-files-regexp))
- (setq ztree-tree-header-fun 'ztree-insert-buffer-header)
- (setq ztree-node-short-name-fun 'file-short-name)
- (setq ztree-node-is-expandable-fun 'file-directory-p)
- (setq ztree-node-equal-fun 'string-equal)
- (setq ztree-node-contents-fun #'(lambda (x) (directory-files x 'full)))
- (ztree-refresh-buffer))))
+ (setq ztree-filter-list filter-list)
+ (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)
+ (ztree-refresh-buffer)))
-(provide 'ztree)
+(provide 'ztree-view)
;;; ztree.el ends here
diff --git a/ztree.el b/ztree.el
index 5a76e94..2973ba6 100644
--- a/ztree.el
+++ b/ztree.el
@@ -28,6 +28,7 @@
;;
;; Add the following to your .emacs file:
;;
+;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
;; (require 'ztree)
;;
;; Call the ztree interactive function:
@@ -48,6 +49,8 @@
;;
;;; Code:
+(require 'ztree-view)
+
;;
;; Constants
;;
@@ -56,374 +59,9 @@
"Hidden files regexp. By default all filest starting with dot '.',
including . and ..")
-;;
-;; 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-node-to-line-list nil
- "List of tuples with full node(i.e. file/directory name
- and the line.")
-(make-variable-buffer-local 'ztree-node-to-line-list)
-
-(defvar ztree-filter-list nil
- "List of regexp for node names to filter out")
-(make-variable-buffer-local 'ztree-filter-list)
-
-(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, there 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)
-
-(defun 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)
-
-(defun 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)
-
-(defun ztree-node-equal-fun nil
- "Function which determines if the 2 nodes are equal")
-(make-variable-buffer-local 'ztree-node-equal-fun)
-
-(defun ztree-node-contents-fun nil
- "Function returning list of node contents")
-(make-variable-buffer-local 'ztree-node-contents-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-action)
- (define-key map [double-mouse-1] 'ztree-perform-action)
- (define-key map (kbd "g") 'ztree-refresh-buffer)
- (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-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)
-
-
-(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 (:inherit 'font-lock-comment-face)))
- "*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 (:inherit 'font-lock-comment-face)))
- "*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.")
-
-(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 of the list `lst` not satisfying predicate `condp`.
-Taken from http://www.emacswiki.org/emacs/ElispCookbook#toc39";
- (delq nil
- (mapcar (lambda (x) (and (funcall condp x) x)) lst)))
-
-(defun ztree-find-node-in-line (line)
- "Search through the array of node-line pairs and return the
-node name for the line specified"
- (let ((found (ztree-find ztree-node-to-line-list
- #'(lambda (entry) (eq line (cdr entry))))))
- (when found
- (car found))))
-
-(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)
- (aset ztree-parent-lines-array (- line ztree-start-line) parent))
-
-(defun ztree-get-parent-for-line (line)
- (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-perform-action ()
- "Toggle expand/collapsed state for nodes"
- (interactive)
- (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)
- ;; do nothing leafs files for now
- nil)
- ;; 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-toggle-expand-state (node)
- "Toggle expanded/collapsed state for nodes"
- (if (ztree-is-expanded-node node)
- (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-move-up-in-tree ()
- "Action on Backspace key: to jump to the line of a parent node or
-if previous key was Backspace - 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))
- (progn
- (ztree-toggle-expand-state
- (ztree-find-node-in-line line))
- (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 (path)
- "Returns pair of 2 elements: list of expandable nodes and
-list of leafs"
- (let ((nodes (funcall ztree-node-contents-fun path)))
- (cons (ztree-filter
- #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
- nodes)
- (ztree-filter
- #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
- nodes))))
-
-(defun ztree-node-is-in-filter-list (node)
- "Determine if the node is in filter list (and therefore
-apparently shall not be visible"
- (ztree-find ztree-filter-list #'(lambda (rx) (string-match rx node))))
-
-(defun ztree-draw-char (c x y)
- "Draw char c at the position (1-based) (x y)"
- (save-excursion
- (scroll-to-line y)
- (beginning-of-line)
- (goto-char (+ x (-(point) 1)))
- (delete-char 1)
- (insert-char c 1)
- (set-text-properties (1- (point)) (point) '(face ztreep-arrow-face))))
-
-(defun ztree-draw-vertical-line (y1 y2 x)
- (if (> y1 y2)
- (dotimes (y (1+ (- y1 y2)))
- (ztree-draw-char ?\| x (+ y2 y)))
- (dotimes (y (1+ (- y2 y1)))
- (ztree-draw-char ?\| x (+ y1 y)))))
-
-(defun ztree-draw-horizontal-line (x1 x2 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 offset)
- "Draw the tree of lines with parents"
- (if (atom tree)
- nil
- (let ((root (car tree))
- (children (cdr tree)))
- (when children
- ;; draw the line to the last child
- ;; since we push'd children to the list, the last line
- ;; is the first
- (let ((last-child (car children))
- (x-offset (+ 2 (* offset 4))))
- (if (atom last-child)
- (ztree-draw-vertical-line (1+ root) last-child x-offset)
- (ztree-draw-vertical-line (1+ root) (car last-child) x-offset)))
- ;; draw recursively
- (dolist (child children)
- (ztree-draw-tree child (1+ offset))
- (if (listp child)
- (ztree-draw-horizontal-line (+ 3 (* offset 4))
- (+ 4 (* offset 4))
- (car child))
- (ztree-draw-horizontal-line (+ 3 (* offset 4))
- (+ 7 (* offset 4))
- child)))))))
-
-(defun ztree-fill-parent-array (tree)
- ;; set the root line
- (let ((root (car tree))
- (children (cdr tree)))
- (dolist (child children)
- (if (atom child)
- (ztree-set-parent-for-line child root)
- (progn
- (ztree-set-parent-for-line (car child) root)
- (ztree-fill-parent-array child))))))
-
-
-(defun ztree-insert-node-contents (path)
- ;; insert node contents with initial offset 0
- (let ((tree (ztree-insert-node-contents-1 path 0))
- (num-of-items (- (line-number-at-pos (point)) ztree-start-line)))
- (setq ztree-parent-lines-array (make-vector num-of-items 0))
- (ztree-set-parent-for-line ztree-start-line ztree-start-line)
- (ztree-fill-parent-array tree)
- (ztree-draw-tree tree 0)))
-
-
-
-(defun ztree-insert-node-contents-1 (node offset)
- (let* ((expanded (ztree-is-expanded-node node))
- (root-line (ztree-insert-entry node offset expanded))
- (children nil))
- (when expanded
- (let* ((contents (ztree-get-splitted-node-contens node))
- (nodes (car contents))
- (leafs (cdr contents)))
- (dolist (node nodes)
- (let ((short-node-name (funcall ztree-node-short-name-fun node)))
- (unless (ztree-node-is-in-filter-list short-node-name)
- (push (ztree-insert-node-contents-1 node (1+ offset))
- children))))
- (dolist (leaf leafs)
- (let ((short-leaf-name (funcall ztree-node-short-name-fun leaf)))
- (when (not (ztree-node-is-in-filter-list short-leaf-name))
- (push (ztree-insert-entry leaf (1+ offset) nil)
- children))))))
- (cons root-line children)))
-
-(defun ztree-insert-entry (node offset expanded)
- (let ((short-name (funcall ztree-node-short-name-fun node))
- (node-sign #'(lambda (exp)
- (insert "[" (if exp "-" "+") "]")
- (set-text-properties (- (point) 3)
- (point)
- '(face ztreep-expand-sign-face))))
- (is-expandable (funcall ztree-node-is-expandable-fun node))
- (line (line-number-at-pos)))
- (when (> offset 0)
- (dotimes (i offset)
- (insert " ")
- (insert-char ?\s 3))) ; insert 3 spaces
- (if is-expandable
- (progn
- (funcall node-sign expanded) ; for expandable nodes insert "[+/-]"
- (insert " ")
- (put-text-property 0 (length short-name)
- 'face 'ztreep-node-face short-name)
- (insert short-name))
- (progn
- (insert " ")
- (put-text-property 0 (length short-name)
- 'face 'ztreep-leaf-face short-name)
- (insert short-name)))
- (push (cons node (line-number-at-pos)) ztree-node-to-line-list)
- (newline)
- line))
-
-
-(defun ztree-refresh-buffer (&optional line)
- (interactive)
- (when (and (equal major-mode 'ztree-mode)
- (boundp 'ztree-start-node))
- (setq ztree-node-to-line-list nil)
- (toggle-read-only)
- (erase-buffer)
- (let ((start (point)))
- (funcall ztree-tree-header-fun)
- (set-text-properties start (point) '(face ztreep-header-face)))
- (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)))
-
-
-;;
-;; File bindings to the tree control
+;; File bindings to the directory tree control
;;
(defun ztree-insert-buffer-header ()
@@ -442,24 +80,19 @@ apparently shall not be visible"
(printable-string (file-name-nondirectory (directory-file-name file))))
-
(defun ztree (path)
"Creates 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 (get-buffer-create (concat "*Directory " path " tree*"))))
- (switch-to-buffer buf)
- (ztree-mode)
- ;; configure ztree to work with directories
- (setq ztree-start-node (expand-file-name (substitute-in-file-name path)))
- (setq ztree-expanded-nodes-list (list ztree-start-node))
- (setq ztree-filter-list (list ztree-hidden-files-regexp))
- (setq ztree-tree-header-fun 'ztree-insert-buffer-header)
- (setq ztree-node-short-name-fun 'file-short-name)
- (setq ztree-node-is-expandable-fun 'file-directory-p)
- (setq ztree-node-equal-fun 'string-equal)
- (setq ztree-node-contents-fun #'(lambda (x) (directory-files x 'full)))
- (ztree-refresh-buffer))))
+ (let ((buf-name (concat "*Directory " path " tree*")))
+ (ztree-view buf-name
+ (expand-file-name (substitute-in-file-name path))
+ (list ztree-hidden-files-regexp)
+ 'ztree-insert-buffer-header
+ 'file-short-name
+ 'file-directory-p
+ 'string-equal
+ '(lambda (x) (directory-files x 'full))))))
(provide 'ztree)
