]> code.delx.au - gnu-emacs-elpa/blob - ztree-view.el
Fixed Delete method
[gnu-emacs-elpa] / ztree-view.el
1 ;;; ztree-view.el --- Text mode tree view (buffer) -*- lexical-binding: t; -*-
2
3 ;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
6 ;;
7 ;; Created: 2013-11-1l
8 ;;
9 ;; Keywords: files tools
10 ;; URL: https://github.com/fourier/ztree
11 ;; Compatibility: GNU Emacs 24.x
12 ;;
13 ;; This file is part of GNU Emacs.
14 ;;
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
19 ;;
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
24 ;;
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;
28 ;;; Commentary:
29 ;;
30 ;; Add the following to your .emacs file:
31 ;;
32 ;; (push (substitute-in-file-name "path-to-ztree-directory") load-path)
33 ;; (require 'ztree-view)
34 ;;
35 ;; Call the ztree interactive function:
36 ;; Use the following function: ztree-view
37 ;;
38 ;;; Issues:
39 ;;
40 ;;; TODO:
41 ;;
42 ;;
43 ;;; Code:
44
45 (require 'ztree-util)
46
47 ;;
48 ;; Globals
49 ;;
50
51 (defvar ztree-draw-unicode-lines nil
52 "If set forces ztree to draw lines with unicode characters.")
53
54 (defvar-local ztree-expanded-nodes-list nil
55 "A list of Expanded nodes (i.e. directories) entries.")
56
57 (defvar-local ztree-start-node nil
58 "Start node(i.e. directory) for the window.")
59
60 (defvar-local ztree-line-to-node-table nil
61 "List of tuples with full node(i.e. file/directory name and the line.")
62
63 (defvar-local ztree-start-line nil
64 "Index of the start line - the root.")
65
66 (defvar-local ztree-parent-lines-array nil
67 "Array of parent lines.
68 The ith value of the array is the parent line for line i.
69 If ith value is i - it is the root line")
70
71 (defvar-local ztree-count-subsequent-bs nil
72 "Counter for the subsequest BS keys (to identify double BS).
73 Used in order to not to use cl package and `lexical-let'")
74
75 (defvar-local ztree-line-tree-properties nil
76 "Hash with key - line number, value - property ('left, 'right, 'both).
77 Used for 2-side trees, to determine if the node exists on left or right
78 or both sides")
79
80 (defvar-local ztree-tree-header-fun nil
81 "Function inserting the header into the tree buffer.
82 MUST inster newline at the end!")
83
84 (defvar-local ztree-node-short-name-fun nil
85 "Function which creates a pretty-printable short string from the node.")
86
87 (defvar-local ztree-node-is-expandable-fun nil
88 "Function which determines if the node is expandable.
89 For example if the node is a directory")
90
91 (defvar-local ztree-node-equal-fun nil
92 "Function which determines if the 2 nodes are equal.")
93
94 (defvar-local ztree-node-contents-fun nil
95 "Function returning list of node contents.")
96
97 (defvar-local ztree-node-side-fun nil
98 "Function returning position of the node: 'left, 'right or 'both.
99 If not defined(by default) - using single screen tree, otherwise
100 the buffer is split to 2 trees")
101
102 (defvar-local ztree-node-face-fun nil
103 "Function returning face for the node.")
104
105 (defvar-local ztree-node-action-fun nil
106 "Function called when Enter/Space pressed on the node.")
107
108 (defvar-local ztree-node-showp-fun nil
109 "Function called to decide if the node should be visible.")
110
111
112 ;;
113 ;; Major mode definitions
114 ;;
115
116 (defvar ztree-mode-map
117 (let ((map (make-sparse-keymap)))
118 (define-key map (kbd "\r") 'ztree-perform-action)
119 (define-key map (kbd "SPC") 'ztree-perform-soft-action)
120 (define-key map [double-mouse-1] 'ztree-perform-action)
121 (define-key map (kbd "TAB") 'ztree-jump-side)
122 (define-key map (kbd "g") 'ztree-refresh-buffer)
123 (define-key map (kbd "x") 'ztree-toggle-expand-subtree)
124 (if window-system
125 (define-key map (kbd "<backspace>") 'ztree-move-up-in-tree)
126 (define-key map "\177" 'ztree-move-up-in-tree))
127 map)
128 "Keymap for `ztree-mode'.")
129
130
131 (defface ztreep-node-face
132 '((((background dark)) (:foreground "#ffffff"))
133 (((type nil)) (:inherit 'font-lock-function-name-face))
134 (t (:foreground "Blue")))
135 "*Face used for expandable entries(directories etc) in Ztree buffer."
136 :group 'Ztree :group 'font-lock-highlighting-faces)
137 (defvar ztreep-node-face 'ztreep-node-face)
138
139 (defface ztreep-leaf-face
140 '((((background dark)) (:foreground "cyan1"))
141 (((type nil)) (:inherit 'font-lock-variable-name-face))
142 (t (:foreground "darkblue")))
143 "*Face used for not expandable nodes(leafs, i.e. files) in Ztree buffer."
144 :group 'Ztree :group 'font-lock-highlighting-faces)
145 (defvar ztreep-leaf-face 'ztreep-leaf-face)
146
147 (defface ztreep-arrow-face
148 '((((background dark)) (:foreground "#7f7f7f"))
149 (t (:foreground "#8d8d8d")))
150 "*Face used for arrows in Ztree buffer."
151 :group 'Ztree :group 'font-lock-highlighting-faces)
152 (defvar ztreep-arrow-face 'ztreep-arrow-face)
153
154 (defface ztreep-expand-sign-face
155 '((((background dark)) (:foreground "#7f7fff"))
156 (t (:foreground "#8d8d8d")))
157 "*Face used for expand sign [+] in Ztree buffer."
158 :group 'Ztree :group 'font-lock-highlighting-faces)
159 (defvar ztreep-expand-sign-face 'ztreep-expand-sign-face)
160
161
162 ;;;###autoload
163 (define-derived-mode ztree-mode special-mode "Ztree"
164 "A major mode for displaying the directory tree in text mode."
165 ;; only spaces
166 (setq indent-tabs-mode nil))
167
168 (defun ztree-find-node-in-line (line)
169 "Return the node for the LINE specified.
170 Search through the array of node-line pairs."
171 (gethash line ztree-line-to-node-table))
172
173 (defun ztree-find-node-at-point ()
174 "Find the node at point.
175 Returns cons pair (node, side) for the current point
176 or nil if there is no node"
177 (let ((center (/ (window-width) 2))
178 (node (ztree-find-node-in-line (line-number-at-pos))))
179 (when node
180 (cons node (if (> (current-column) center) 'right 'left)))))
181
182
183 (defun ztree-is-expanded-node (node)
184 "Find if the NODE is in the list of expanded nodes."
185 (ztree-find ztree-expanded-nodes-list
186 #'(lambda (x) (funcall ztree-node-equal-fun x node))))
187
188
189 (defun ztree-set-parent-for-line (line parent)
190 "For given LINE set the PARENT in the global array."
191 (aset ztree-parent-lines-array (- line ztree-start-line) parent))
192
193 (defun ztree-get-parent-for-line (line)
194 "For given LINE return a parent."
195 (when (and (>= line ztree-start-line)
196 (< line (+ (length ztree-parent-lines-array) ztree-start-line)))
197 (aref ztree-parent-lines-array (- line ztree-start-line))))
198
199 (defun scroll-to-line (line)
200 "Recommended way to set the cursor to specified LINE."
201 (goto-char (point-min))
202 (forward-line (1- line)))
203
204
205 (defun ztree-do-toggle-expand-subtree-iter (node state)
206 "Iteration in expanding subtree.
207 Argument NODE current node.
208 Argument STATE node state."
209 (when (funcall ztree-node-is-expandable-fun node)
210 (let ((children (funcall ztree-node-contents-fun node)))
211 (ztree-do-toggle-expand-state node state)
212 (dolist (child children)
213 (ztree-do-toggle-expand-subtree-iter child state)))))
214
215
216 (defun ztree-do-toggle-expand-subtree ()
217 "Implements the subtree expand."
218 (let* ((line (line-number-at-pos))
219 (node (ztree-find-node-in-line line))
220 ;; save the current window start position
221 (current-pos (window-start)))
222 ;; only for expandable nodes
223 (when (funcall ztree-node-is-expandable-fun node)
224 ;; get the current expand state and invert it
225 (let ((do-expand (not (ztree-is-expanded-node node))))
226 (ztree-do-toggle-expand-subtree-iter node do-expand))
227 ;; refresh buffer and scroll back to the saved line
228 (ztree-refresh-buffer line)
229 ;; restore window start position
230 (set-window-start (selected-window) current-pos))))
231
232
233 (defun ztree-do-perform-action (hard)
234 "Toggle expand/collapsed state for nodes or perform an action.
235 HARD specifies (t or nil) if the hard action, binded on RET,
236 should be performed on node."
237 (let* ((line (line-number-at-pos))
238 (node (ztree-find-node-in-line line)))
239 (when node
240 (if (funcall ztree-node-is-expandable-fun node)
241 ;; only for expandable nodes
242 (ztree-toggle-expand-state node)
243 ;; perform action
244 (when ztree-node-action-fun
245 (funcall ztree-node-action-fun node hard)))
246 ;; save the current window start position
247 (let ((current-pos (window-start)))
248 ;; refresh buffer and scroll back to the saved line
249 (ztree-refresh-buffer line)
250 ;; restore window start position
251 (set-window-start (selected-window) current-pos)))))
252
253
254 (defun ztree-perform-action ()
255 "Toggle expand/collapsed state for nodes or perform the action.
256 Performs the hard action, binded on RET, on node."
257 (interactive)
258 (ztree-do-perform-action t))
259
260 (defun ztree-perform-soft-action ()
261 "Toggle expand/collapsed state for nodes or perform the action.
262 Performs the soft action, binded on Space, on node."
263 (interactive)
264 (ztree-do-perform-action nil))
265
266
267 (defun ztree-toggle-expand-subtree()
268 "Toggle Expanded/Collapsed state on all nodes of the subtree"
269 (interactive)
270 (ztree-do-toggle-expand-subtree))
271
272 (defun ztree-do-toggle-expand-state (node do-expand)
273 "Set the expanded state of the NODE to DO-EXPAND."
274 (if (not do-expand)
275 (setq ztree-expanded-nodes-list
276 (ztree-filter
277 #'(lambda (x) (not (funcall ztree-node-equal-fun node x)))
278 ztree-expanded-nodes-list))
279 (push node ztree-expanded-nodes-list)))
280
281
282 (defun ztree-toggle-expand-state (node)
283 "Toggle expanded/collapsed state for NODE."
284 (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node))))
285
286
287 (defun ztree-move-up-in-tree ()
288 "Action on Backspace key.
289 Jump to the line of a parent node. If previous key was Backspace
290 then close the node."
291 (interactive)
292 (when ztree-parent-lines-array
293 (let* ((line (line-number-at-pos (point)))
294 (parent (ztree-get-parent-for-line line)))
295 (when parent
296 (if (and (equal last-command 'ztree-move-up-in-tree)
297 (not ztree-count-subsequent-bs))
298 (let ((node (ztree-find-node-in-line line)))
299 (when (ztree-is-expanded-node node)
300 (ztree-toggle-expand-state node))
301 (setq ztree-count-subsequent-bs t)
302 (ztree-refresh-buffer line))
303 (progn (setq ztree-count-subsequent-bs nil)
304 (scroll-to-line parent)))))))
305
306
307 (defun ztree-get-splitted-node-contens (node)
308 "Return pair of 2 elements: list of expandable nodes and list of leafs.
309 Argument NODE node which contents will be returned."
310 (let ((nodes (funcall ztree-node-contents-fun node))
311 (comp #'(lambda (x y)
312 (string< (funcall ztree-node-short-name-fun x)
313 (funcall ztree-node-short-name-fun y)))))
314 (cons (sort (ztree-filter
315 #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
316 nodes) comp)
317 (sort (ztree-filter
318 #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
319 nodes) comp))))
320
321
322 (defun ztree-draw-char (c x y &optional face)
323 "Draw char C at the position (1-based) (X Y).
324 Optional argument FACE face to use to draw a character."
325 (save-excursion
326 (scroll-to-line y)
327 (beginning-of-line)
328 (goto-char (+ x (-(point) 1)))
329 (delete-char 1)
330 (insert-char c 1)
331 (put-text-property (1- (point)) (point) 'font-lock-face (if face face 'ztreep-arrow-face))))
332
333 (defun ztree-vertical-line-char ()
334 "Return the character used to draw vertical line"
335 (if ztree-draw-unicode-lines #x2502 ?\|))
336
337 (defun ztree-horizontal-line-char ()
338 "Return the character used to draw vertical line"
339 (if ztree-draw-unicode-lines #x2500 ?\-))
340
341 (defun ztree-left-bottom-corner-char ()
342 "Return the character used to draw vertical line"
343 (if ztree-draw-unicode-lines #x2514 ?\`))
344
345 (defun ztree-left-intersection-char ()
346 "Return left intersection character.
347 It is just vertical bar when unicode disabled"
348 (if ztree-draw-unicode-lines #x251C ?\|))
349
350 (defun ztree-draw-vertical-line (y1 y2 x &optional face)
351 "Draw a vertical line of '|' characters from Y1 row to Y2 in X column.
352 Optional argument FACE face to draw line with."
353 (let ((ver-line-char (ztree-vertical-line-char))
354 (count (abs (- y1 y2))))
355 (if (> y1 y2)
356 (progn
357 (dotimes (y count)
358 (ztree-draw-char ver-line-char x (+ y2 y) face))
359 (ztree-draw-char ver-line-char x (+ y2 count) face))
360 (progn
361 (dotimes (y count)
362 (ztree-draw-char ver-line-char x (+ y1 y) face))
363 (ztree-draw-char ver-line-char x (+ y1 count) face)))))
364
365 (defun ztree-draw-vertical-rounded-line (y1 y2 x &optional face)
366 "Draw a vertical line of '|' characters finishing with '`' character.
367 Draws the line from Y1 row to Y2 in X column.
368 Optional argument FACE facet to draw the line with."
369 (let ((ver-line-char (ztree-vertical-line-char))
370 (corner-char (ztree-left-bottom-corner-char))
371 (count (abs (- y1 y2))))
372 (if (> y1 y2)
373 (progn
374 (dotimes (y count)
375 (ztree-draw-char ver-line-char x (+ y2 y) face))
376 (ztree-draw-char corner-char x (+ y2 count) face))
377 (progn
378 (dotimes (y count)
379 (ztree-draw-char ver-line-char x (+ y1 y) face))
380 (ztree-draw-char corner-char x (+ y1 count) face)))))
381
382
383 (defun ztree-draw-horizontal-line (x1 x2 y)
384 "Draw the horizontal line from column X1 to X2 in the row Y."
385 (let ((hor-line-char (ztree-horizontal-line-char)))
386 (if (> x1 x2)
387 (dotimes (x (1+ (- x1 x2)))
388 (ztree-draw-char hor-line-char (+ x2 x) y))
389 (dotimes (x (1+ (- x2 x1)))
390 (ztree-draw-char hor-line-char (+ x1 x) y)))))
391
392
393 (defun ztree-draw-tree (tree depth start-offset)
394 "Draw the TREE of lines with parents.
395 Argument DEPTH current depth.
396 Argument START-OFFSET column to start drawing from."
397 (if (atom tree)
398 nil
399 (let* ((root (car tree))
400 (children (cdr tree))
401 (offset (+ start-offset (* depth 4)))
402 (line-start (+ 3 offset))
403 (line-end-leaf (+ 7 offset))
404 (line-end-node (+ 4 offset))
405 (corner-char (ztree-left-bottom-corner-char))
406 (intersection-char (ztree-left-intersection-char))
407 ;; determine if the line is visible. It is always the case
408 ;; for 1-sided trees; however for 2 sided trees
409 ;; it depends on which side is the actual element
410 ;; and which tree (left with offset 0 or right with offset > 0
411 ;; we are drawing
412 (visible #'(lambda (line) ()
413 (if (not ztree-node-side-fun) t
414 (let ((side
415 (gethash line ztree-line-tree-properties)))
416 (cond ((eq side 'left) (= start-offset 0))
417 ((eq side 'right) (> start-offset 0))
418 (t t)))))))
419 (when children
420 ;; draw the line to the last child
421 ;; since we push'd children to the list, it's the first visible line
422 ;; from the children list
423 (let ((last-child (ztree-find children
424 #'(lambda (x)
425 (funcall visible (ztree-car-atom x)))))
426 (x-offset (+ 2 offset)))
427 (when last-child
428 (ztree-draw-vertical-line (1+ root)
429 (ztree-car-atom last-child)
430 x-offset))
431 ;; draw recursively
432 (dolist (child children)
433 (ztree-draw-tree child (1+ depth) start-offset)
434 (let ((end (if (listp child) line-end-node line-end-leaf))
435 (row (ztree-car-atom child)))
436 (when (funcall visible (ztree-car-atom child))
437 (ztree-draw-char intersection-char (1- line-start) row)
438 (ztree-draw-horizontal-line line-start
439 end
440 row))))
441 ;; finally draw the corner at the end of vertical line
442 (when last-child
443 (ztree-draw-char corner-char
444 x-offset
445 (ztree-car-atom last-child))))))))
446
447 (defun ztree-fill-parent-array (tree)
448 "Set the root lines array.
449 Argument TREE nodes tree to create an array of lines from."
450 (let ((root (car tree))
451 (children (cdr tree)))
452 (dolist (child children)
453 (ztree-set-parent-for-line (ztree-car-atom child) root)
454 (when (listp child)
455 (ztree-fill-parent-array child)))))
456
457
458 (defun ztree-insert-node-contents (path)
459 "Insert node contents with initial depth 0.
460 `ztree-insert-node-contents-1' return the tree of line
461 numbers to determine who is parent line of the
462 particular line. This tree is used to draw the
463 graph.
464 Argument PATH start node."
465 (let ((tree (ztree-insert-node-contents-1 path 0))
466 ;; number of 'rows' in tree is last line minus start line
467 (num-of-items (- (line-number-at-pos (point)) ztree-start-line)))
468 ;; create a parents array to store parents of lines
469 ;; parents array used for navigation with the BS
470 (setq ztree-parent-lines-array (make-vector num-of-items 0))
471 ;; set the root node in lines parents array
472 (ztree-set-parent-for-line ztree-start-line ztree-start-line)
473 ;; fill the parent arrray from the tree
474 (ztree-fill-parent-array tree)
475 ;; draw the tree starting with depth 0 and offset 0
476 (ztree-draw-tree tree 0 0)
477 ;; for the 2-sided tree we need to draw the vertical line
478 ;; and an additional tree
479 (if ztree-node-side-fun ; 2-sided tree
480 (let ((width (window-width)))
481 ;; draw the vertical line in the middle of the window
482 (ztree-draw-vertical-line ztree-start-line
483 (1- (+ num-of-items ztree-start-line))
484 (/ width 2)
485 'vertical-border)
486 (ztree-draw-tree tree 0 (1+ (/ width 2)))))))
487
488
489 (defun ztree-insert-node-contents-1 (node depth)
490 "Recursively insert contents of the NODE with current DEPTH."
491 (let* ((expanded (ztree-is-expanded-node node))
492 ;; insert node entry with defined depth
493 (root-line (ztree-insert-entry node depth expanded))
494 ;; children list is the list of lines which are children
495 ;; of the root line
496 (children nil))
497 (when expanded ;; if expanded we need to add all subnodes
498 (let* ((contents (ztree-get-splitted-node-contens node))
499 ;; contents is the list of 2 elements:
500 (nodes (car contents)) ; expandable entries - nodes
501 (leafs (cdr contents))) ; leafs - which doesn't have subleafs
502 ;; iterate through all expandable entries to insert them first
503 (dolist (node nodes)
504 ;; if it is not in the filter list
505 (when (funcall ztree-node-showp-fun node)
506 ;; insert node on the next depth level
507 ;; and push the returning result (in form (root children))
508 ;; to the children list
509 (push (ztree-insert-node-contents-1 node (1+ depth))
510 children)))
511 ;; now iterate through all the leafs
512 (dolist (leaf leafs)
513 ;; if not in filter list
514 (when (funcall ztree-node-showp-fun leaf)
515 ;; insert the leaf and add it to children
516 (push (ztree-insert-entry leaf (1+ depth) nil)
517 children)))))
518 ;; result value is the list - head is the root line,
519 ;; rest are children
520 (cons root-line children)))
521
522 (defun ztree-insert-entry (node depth expanded)
523 "Inselt the NODE to the current line with specified DEPTH and EXPANDED state."
524 (let ((line (line-number-at-pos))
525 (expandable (funcall ztree-node-is-expandable-fun node))
526 (short-name (funcall ztree-node-short-name-fun node)))
527 (if ztree-node-side-fun ; 2-sided tree
528 (let ((right-short-name (funcall ztree-node-short-name-fun node t))
529 (side (funcall ztree-node-side-fun node))
530 (width (window-width)))
531 (when (eq side 'left) (setq right-short-name ""))
532 (when (eq side 'right) (setq short-name ""))
533 (ztree-insert-single-entry short-name depth
534 expandable expanded 0
535 (when ztree-node-face-fun
536 (funcall ztree-node-face-fun node)))
537 (ztree-insert-single-entry right-short-name depth
538 expandable expanded (1+ (/ width 2))
539 (when ztree-node-face-fun
540 (funcall ztree-node-face-fun node)))
541 (puthash line side ztree-line-tree-properties))
542 (ztree-insert-single-entry short-name depth expandable expanded 0))
543 (puthash line node ztree-line-to-node-table)
544 (insert "\n")
545 line))
546
547 (defun ztree-insert-single-entry (short-name depth
548 expandable expanded
549 offset
550 &optional face)
551 "Writes a SHORT-NAME in a proper position with the type given.
552 Writes a string with given DEPTH, prefixed with [ ] if EXPANDABLE
553 and [-] or [+] depending on if it is EXPANDED from the specified OFFSET.
554 Optional argument FACE face to write text with."
555 (let ((node-sign #'(lambda (exp)
556 (let ((sign (concat "[" (if exp "-" "+") "]")))
557 (insert (propertize sign
558 'font-lock-face
559 ztreep-expand-sign-face)))))
560 ;; face to use. if FACE is not null, use it, otherwise
561 ;; deside from the node type
562 (entry-face (cond (face face)
563 (expandable 'ztreep-node-face)
564 (t ztreep-leaf-face))))
565 ;; move-to-column in contrast to insert reuses the last property
566 ;; so need to clear it
567 (let ((start-pos (point)))
568 (move-to-column offset t)
569 (remove-text-properties start-pos (point) '(font-lock-face nil)))
570 (delete-region (point) (line-end-position))
571 ;; every indentation level is 4 characters
572 (when (> depth 0)
573 (dotimes (i depth)
574 (insert-char ?\s 4))) ; insert 4 spaces
575 (when (> (length short-name) 0)
576 (let ((start-pos (point)))
577 (if expandable
578 (funcall node-sign expanded)) ; for expandable nodes insert "[+/-]"
579 ;; indentation for leafs 4 spaces from the node name
580 (insert-char ?\s (- 4 (- (point) start-pos))))
581 (insert (propertize short-name 'font-lock-face entry-face)))))
582
583
584
585 (defun ztree-jump-side ()
586 "Jump to another side for 2-sided trees."
587 (interactive)
588 (when ztree-node-side-fun ; 2-sided tree
589 (let ((center (/ (window-width) 2)))
590 (cond ((< (current-column) center)
591 (move-to-column (1+ center)))
592 ((> (current-column) center)
593 (move-to-column 1))
594 (t nil)))))
595
596
597
598 (defun ztree-refresh-buffer (&optional line)
599 "Refresh the buffer.
600 Optional argument LINE scroll to the line given."
601 (interactive)
602 (when (and (equal major-mode 'ztree-mode)
603 (boundp 'ztree-start-node))
604 (setq ztree-line-to-node-table (make-hash-table))
605 ;; create a hash table of node properties for line
606 ;; used in 2-side tree mode
607 (when ztree-node-side-fun
608 (setq ztree-line-tree-properties (make-hash-table)))
609 (toggle-read-only)
610 (erase-buffer)
611 (funcall ztree-tree-header-fun)
612 (setq ztree-start-line (line-number-at-pos (point)))
613 (ztree-insert-node-contents ztree-start-node)
614 (scroll-to-line (if line line ztree-start-line))
615 (toggle-read-only)))
616
617
618 (defun ztree-view (
619 buffer-name
620 start-node
621 filter-fun
622 header-fun
623 short-name-fun
624 expandable-p
625 equal-fun
626 children-fun
627 face-fun
628 action-fun
629 &optional
630 node-side-fun
631 post-create-hook
632 )
633 "Create a ztree view buffer configured with parameters given.
634 Argument BUFFER-NAME Name of the buffer created.
635 Argument START-NODE Starting node - the root of the tree.
636 Argument FILTER-FUN Function which will define if the node should not be
637 visible.
638 Argument HEADER-FUN Function which inserts the header into the buffer
639 before drawing the tree.
640 Argument SHORT-NAME-FUN Function which return the short name for a node given.
641 Argument EXPANDABLE-P Function to determine if the node is expandable.
642 Argument EQUAL-FUN An equality function for nodes.
643 Argument CHILDREN-FUN Function to get children from the node.
644 Argument FACE-FUN Function to determine face of the node.
645 Argument ACTION-FUN an action to perform when the Return is pressed.
646 Optional argument NODE-SIDE-FUN Determines the side of the node.
647 Optional argument POST-CREATE-FUN"
648 (let ((buf (get-buffer-create buffer-name)))
649 (switch-to-buffer buf)
650 (ztree-mode)
651 ;; configure ztree-view
652 (setq ztree-start-node start-node)
653 (setq ztree-expanded-nodes-list (list ztree-start-node))
654 (setq ztree-node-showp-fun filter-fun)
655 (setq ztree-tree-header-fun header-fun)
656 (setq ztree-node-short-name-fun short-name-fun)
657 (setq ztree-node-is-expandable-fun expandable-p)
658 (setq ztree-node-equal-fun equal-fun)
659 (setq ztree-node-contents-fun children-fun)
660 (setq ztree-node-face-fun face-fun)
661 (setq ztree-node-action-fun action-fun)
662 (setq ztree-node-side-fun node-side-fun)
663 (ztree-refresh-buffer)))
664
665
666 (provide 'ztree-view)
667 ;;; ztree-view.el ends here