;;; ztree-view.el --- Text mode tree view (buffer)
-;; Copyright (C) 2013 Alexey Veretennikov
+;; 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
+;;
+;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
-;; Compatibility: GNU Emacs GNU Emacs 24.x
+;; Compatibility: GNU Emacs 24.x
;;
-;; This file is NOT part of GNU Emacs.
+;; This file is 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.
+;; 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.
;;
-;; This program is distributed in the hope that it will be useful,
+;; 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 this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;;; TODO:
;;
;;
-;;; Change Log:
-;;
-;; 2013-11-10 (1.0.0)
-;; Initial Release.
-;;
;;; Code:
(require 'ztree-util)
"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-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")
+ "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")
+ "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")
+ "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
+(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")
+ "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")
+(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)
-(defun ztree-node-equal-fun nil
- "Function which determines if the 2 nodes are equal")
+(defvar 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")
+(defvar ztree-node-contents-fun nil
+ "Function returning list of node contents.")
(make-variable-buffer-local 'ztree-node-contents-fun)
-(defun ztree-node-side-fun nil
+(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-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-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"))
(defface ztreep-arrow-face
'((((background dark)) (:foreground "#7f7f7f"))
- (t (:inherit 'font-lock-comment-face)))
+ (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 (:inherit 'font-lock-comment-face)))
+ (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)
- "A major mode for displaying the directory tree in text mode.")
-
+ (setq indent-tabs-mode nil))
(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))))
+ "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"
+ "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"
+ "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)
+(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)
- ;; do nothing leafs files for now
- nil)
+ ;; 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)))))
+ (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-state (node)
- "Toggle expanded/collapsed state for nodes"
- (if (ztree-is-expanded-node node)
+
+(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: to jump to the line of a parent node or
-if previous key was Backspace - close the node"
+ "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)))
(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))
+(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)))))
nodes) comp))))
-(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 &optional face)
- "Draw char c at the position (1-based) (x y)"
+ "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)
(put-text-property (1- (point)) (point) 'face (if face face 'ztreep-arrow-face))))
(defun ztree-draw-vertical-line (y1 y2 x &optional face)
- (if (> y1 y2)
- (dotimes (y (1+ (- y1 y2)))
- (ztree-draw-char ?\| x (+ y2 y) face))
- (dotimes (y (1+ (- y2 y1)))
- (ztree-draw-char ?\| x (+ y1 y) 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))
(defun ztree-draw-tree (tree depth start-offset)
- "Draw the tree of lines with parents"
+ "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)))
+ (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, the last line
- ;; is the first
- (let ((last-child (car children))
+ ;; 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)))
- (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)))
+ (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)
- (if (listp child)
+ (let ((end (if (listp child) line-end-node line-end-leaf)))
+ (when (funcall visible (car-atom child))
(ztree-draw-horizontal-line line-start
- line-end-node
- (car child))
- (ztree-draw-horizontal-line line-start
- line-end-leaf
- child)))))))
+ end
+ (car-atom child)))))))))
(defun ztree-fill-parent-array (tree)
- ;; set the root line
+ "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)
- (if (atom child)
- (ztree-set-parent-for-line child root)
- (progn
- (ztree-set-parent-for-line (car child) root)
- (ztree-fill-parent-array child))))))
+ (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
+ "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
+ ;; 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)
(1- (+ num-of-items ztree-start-line))
(/ width 2)
'vertical-border)
- (ztree-draw-tree tree 0 (/ width 2))))))
+ (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))
(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)
- (let ((short-node-name (funcall ztree-node-short-name-fun node)))
- ;; if it is not in the filter list
- (unless (ztree-node-is-in-filter-list short-node-name)
- ;; 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))))
+ (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)
- (let ((short-leaf-name (funcall ztree-node-short-name-fun leaf)))
- ;; if not in filter list
- (when (not (ztree-node-is-in-filter-list short-leaf-name))
- ;; insert the leaf and add it to children
- (push (ztree-insert-entry leaf (1+ depth) nil)
- children))))))
+ ;; 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
+ ;; 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 short-name)
+ (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)
- (ztree-insert-single-entry right-short-name depth expandable expanded
- (1+ (/ width 2))))
+ (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))
- (push (cons node line) ztree-node-to-line-list)
- (newline)
+ (puthash line node ztree-line-to-node-table)
+ (newline-and-begin)
line))
-(defun ztree-insert-single-entry (short-name depth expandable expanded offset)
- (let ((node-sign #'(lambda (exp)
+(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)
(dotimes (i depth)
(insert " ")
(insert-char ?\s 3))) ; insert 3 spaces
- (if expandable
- (progn
- (funcall node-sign expanded) ; for expandable nodes insert "[+/-]"
- (insert " ")
+ (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 '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)))))
+ '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-node-to-line-list nil)
+ (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)
- (let ((start (point)))
- (funcall ztree-tree-header-fun)
- (set-text-properties start (point) '(face ztreep-header-face)))
+ (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))
(defun ztree-view (
buffer-name
start-node
- filter-list
+ 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 to work with directories
+ ;; configure ztree-view
(setq ztree-start-node start-node)
(setq ztree-expanded-nodes-list (list ztree-start-node))
- (setq ztree-filter-list filter-list)
+ (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.el ends here
+;;; ztree-view.el ends here