mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-18 21067e7cbe6d7a0f65ff5c317a96b5c337b0b3d8
commit | author | age
5cb5f7 1 ;;; ztree-view.el --- Text mode tree view (buffer) -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2013-2016  Free Software Foundation, Inc.
4 ;;
5 ;; Author: Alexey Veretennikov <alexey.veretennikov@gmail.com>
6 ;;
7 ;; Created: 2013-11-11
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 (eval-when-compile (require 'cl))
46 (require 'subr-x)
47 (require 'ztree-util)
48
49 ;;
50 ;; Globals
51 ;;
52
53 (defvar ztree-draw-unicode-lines nil
54   "If set forces ztree to draw lines with unicode characters.")
55
56 (defvar ztree-show-number-of-children nil
57   "If set forces ztree show number of child entries in the braces.")
58
59 (defvar-local ztree-expanded-nodes-list nil
60   "A list of Expanded nodes (i.e. directories) entries.")
61
62 (defvar-local ztree-start-node nil
63   "Start node(i.e. directory) for the window.")
64
65 (defvar-local ztree-line-to-node-table nil
66   "List of tuples with full node(i.e. file/directory name and the line.")
67
68 (defvar-local ztree-start-line nil
69   "Index of the start line - the root.")
70
71 (defvar-local ztree-parent-lines-array nil
72   "Array of parent lines.
73 The ith value of the array is the parent line for line i.
74 If ith value is i - it is the root line")
75
76 (defvar-local ztree-count-subsequent-bs nil
77   "Counter for the subsequest BS keys (to identify double BS).
78 Used in order to not to use cl package and `lexical-let'")
79
80 (defvar-local ztree-line-tree-properties nil
81   "Hash table, with key - line number, value - property list of the line.
82 The property list has the following keys:
83 - side (`left', `right', `both').
84 Used for 2-side trees, to determine if the node exists on left or right
85 or both sides
86 - offset - the column there the text starts ")
87
88 (defvar-local ztree-prev-position nil
89   "The cons pair of the previous line and column. Used
90 to restore cursor position after refresh")
91
92 (defvar-local ztree-tree-header-fun nil
93   "Function inserting the header into the tree buffer.
94 MUST inster newline at the end!")
95
96 (defvar-local ztree-node-short-name-fun nil
97   "Function which creates a pretty-printable short string from the node.")
98
99 (defvar-local ztree-node-is-expandable-fun nil
100   "Function which determines if the node is expandable.
101 For example if the node is a directory")
102
103 (defvar-local ztree-node-equal-fun nil
104   "Function which determines if the 2 nodes are equal.")
105
106 (defvar-local ztree-node-contents-fun nil
107   "Function returning list of node contents.")
108
109 (defvar-local ztree-node-side-fun nil
110   "Function returning position of the node: `left', `right' or `both'.
111 If not defined (by default) - using single screen tree, otherwise
112 the buffer is split to 2 trees")
113
114 (defvar-local ztree-node-face-fun nil
115   "Function returning face for the node.")
116
117 (defvar-local ztree-node-action-fun nil
118   "Function called when Enter/Space pressed on the node.")
119
120 (defvar-local ztree-node-showp-fun nil
121   "Function called to decide if the node should be visible.")
122
123
124 ;;
125 ;; Major mode definitions
126 ;;
127
128 (defvar ztree-mode-map
129   (let ((map (make-sparse-keymap)))
130     (define-key map (kbd "\r") 'ztree-perform-action)
131     (define-key map (kbd "SPC") 'ztree-perform-soft-action)
132     (define-key map [double-mouse-1] 'ztree-perform-action)
133     (define-key map (kbd "TAB") 'ztree-jump-side)
134     (define-key map (kbd "g") 'ztree-refresh-buffer)
135     (define-key map (kbd "x") 'ztree-toggle-expand-subtree)
136     (define-key map [remap next-line] 'ztree-next-line)
137     (define-key map [remap previous-line] 'ztree-previous-line)
138     (if window-system
139         (define-key map (kbd "<backspace>") 'ztree-move-up-in-tree)
140       (define-key map "\177" 'ztree-move-up-in-tree))
141     map)
142   "Keymap for `ztree-mode'.")
143
144
145 (defface ztreep-node-face
146   '((((background dark)) (:foreground "#ffffff"))
147     (((type nil))        (:inherit 'font-lock-function-name-face))
148     (t                   (:foreground "Blue")))
149   "*Face used for expandable entries(directories etc) in Ztree buffer."
150   :group 'Ztree :group 'font-lock-highlighting-faces)
151 (defvar ztreep-node-face 'ztreep-node-face)
152
153 (defface ztreep-leaf-face
154   '((((background dark)) (:foreground "cyan1"))
155     (((type nil))        (:inherit 'font-lock-variable-name-face))
156     (t                   (:foreground "darkblue")))
157   "*Face used for not expandable nodes(leafs, i.e. files) in Ztree buffer."
158   :group 'Ztree :group 'font-lock-highlighting-faces)
159 (defvar ztreep-leaf-face 'ztreep-leaf-face)
160
161 (defface ztreep-arrow-face
162   '((((background dark)) (:foreground "#7f7f7f"))
163     (t                   (:foreground "#8d8d8d")))
164   "*Face used for arrows in Ztree buffer."
165   :group 'Ztree :group 'font-lock-highlighting-faces)
166 (defvar ztreep-arrow-face 'ztreep-arrow-face)
167
168 (defface ztreep-expand-sign-face
169   '((((background dark)) (:foreground "#7f7fff"))
170     (t                   (:foreground "#8d8d8d")))
171   "*Face used for expand sign [+] in Ztree buffer."
172   :group 'Ztree :group 'font-lock-highlighting-faces)
173 (defvar ztreep-expand-sign-face 'ztreep-expand-sign-face)
174
175 (defface ztreep-node-count-children-face
176   '((t                   (:inherit 'font-lock-comment-face :slant italic)))
177   "*Face used for count of number of child entries in Ztree buffer."
178   :group 'Ztree :group 'font-lock-highlighting-faces)
179 (defvar ztreep-node-count-children-face 'ztreep-node-count-children-face)
180
181
182
183 ;;;###autoload
184 (define-derived-mode ztree-mode special-mode "Ztree"
185   "A major mode for displaying the directory tree in text mode."
186   ;; only spaces
187   (setq indent-tabs-mode nil)
188   (setq    buffer-read-only t))
189
190
191 (defun ztree-scroll-to-line (line)
192   "Set the cursor to specified LINE and to the text offset (if possible)."
193   (let ((center (/ (window-width) 2))
194         (cur-line (line-number-at-pos)))
195     ;; based on dired-next-line
196     ;; set line-move to move by logical lines
197     (let ((line-move-visual)
198           (goal-column))
199       (line-move (- line cur-line) t)
200       (when-let (offset (plist-get
201                          (gethash (line-number-at-pos)
202                                   ztree-line-tree-properties)
203                          'offset))
204         (when (and ztree-node-side-fun
205                    (>= (current-column) center))
206           (incf offset (1+ center)))
207         (beginning-of-line)
208         (goto-char (+ (point) offset))))))
209
210
211 (defun ztree-find-node-in-line (line)
212   "Return the node for the LINE specified.
213 Search through the array of node-line pairs."
214   (gethash line ztree-line-to-node-table))
215
216 (defun ztree-find-node-at-point ()
217   "Find the node at point.
218 Returns cons pair (node, side) for the current point
219 or nil if there is no node"
220   (let ((center (/ (window-width) 2))
221         (node (ztree-find-node-in-line (line-number-at-pos))))
222     (when node
223       (cons node (if (> (current-column) center) 'right 'left)))))
224
225
226 (defun ztree-is-expanded-node (node)
227   "Find if the NODE is in the list of expanded nodes."
228   (ztree-find ztree-expanded-nodes-list
229               #'(lambda (x) (funcall ztree-node-equal-fun x node))))
230
231
232 (defun ztree-set-parent-for-line (line parent)
233   "For given LINE set the PARENT in the global array."
234   (aset ztree-parent-lines-array (- line ztree-start-line) parent))
235
236
237 (defun ztree-get-parent-for-line (line)
238   "For given LINE return a parent."
239   (when (and (>= line ztree-start-line)
240              (< line (+ (length ztree-parent-lines-array) ztree-start-line)))
241     (aref ztree-parent-lines-array (- line ztree-start-line))))
242
243
244 (defun ztree-do-toggle-expand-subtree-iter (node state)
245   "Iteration in expanding subtree.
246 Argument NODE current node.
247 Argument STATE node state."
248   (when (funcall ztree-node-is-expandable-fun node)
249     (let ((children (funcall ztree-node-contents-fun node)))
250       (ztree-do-toggle-expand-state node state)
251       (dolist (child children)
252         (ztree-do-toggle-expand-subtree-iter child state)))))
253
254
255 (defun ztree-do-toggle-expand-subtree ()
256   "Implements the subtree expand."
257   (let* ((line (line-number-at-pos))
258          (node (ztree-find-node-in-line line))
259          ;; save the current window start position
260          (current-pos (window-start)))
261     ;; only for expandable nodes
262     (when (funcall ztree-node-is-expandable-fun node)
263       ;; get the current expand state and invert it
264       (let ((do-expand (not (ztree-is-expanded-node node))))
265         (ztree-do-toggle-expand-subtree-iter node do-expand))
266       ;; refresh buffer and scroll back to the saved line
267       (ztree-refresh-buffer line)
268       ;; restore window start position
269       (set-window-start (selected-window) current-pos))))
270
271
272 (defun ztree-do-perform-action (hard)
273   "Toggle expand/collapsed state for nodes or perform an action.
274 HARD specifies (t or nil) if the hard action, binded on RET,
275 should be performed on node."
276   (let* ((line (line-number-at-pos))
277          (node (ztree-find-node-in-line line)))
278     (when node
279       (if (funcall ztree-node-is-expandable-fun node)
280           ;; only for expandable nodes
281           (ztree-toggle-expand-state node)
282         ;; perform action
283         (when ztree-node-action-fun
284           (funcall ztree-node-action-fun node hard)))
285       ;; save the current window start position
286       (let ((current-pos (window-start)))
287         ;; refresh buffer and scroll back to the saved line
288         (ztree-refresh-buffer line)
289         ;; restore window start position
290         (set-window-start (selected-window) current-pos)))))
291
292
293 (defun ztree-perform-action ()
294   "Toggle expand/collapsed state for nodes or perform the action.
295 Performs the hard action, binded on RET, on node."
296   (interactive)
297   (ztree-do-perform-action t))
298
299 (defun ztree-perform-soft-action ()
300   "Toggle expand/collapsed state for nodes or perform the action.
301 Performs the soft action, binded on Space, on node."
302   (interactive)
303   (ztree-do-perform-action nil))
304
305
306 (defun ztree-toggle-expand-subtree()
307   "Toggle Expanded/Collapsed state on all nodes of the subtree"
308   (interactive)
309   (ztree-do-toggle-expand-subtree))
310
311 (defun ztree-do-toggle-expand-state (node do-expand)
312   "Set the expanded state of the NODE to DO-EXPAND."
313   (if (not do-expand)
314       (setq ztree-expanded-nodes-list
315             (ztree-filter
316              #'(lambda (x) (not (funcall ztree-node-equal-fun node x)))
317              ztree-expanded-nodes-list))
318     (push node ztree-expanded-nodes-list)))
319
320
321 (defun ztree-toggle-expand-state (node)
322   "Toggle expanded/collapsed state for NODE."
323   (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node))))
324
325
326 (defun ztree-move-up-in-tree ()
327   "Action on Backspace key.
328 Jump to the line of a parent node.  If previous key was Backspace
329 then close the node."
330   (interactive)
331   (when ztree-parent-lines-array
332     (let* ((line (line-number-at-pos (point)))
333            (parent (ztree-get-parent-for-line line)))
334       (when parent
335         (if (and (equal last-command 'ztree-move-up-in-tree)
336                  (not ztree-count-subsequent-bs))
337             (let ((node (ztree-find-node-in-line line)))
338               (when (ztree-is-expanded-node node)
339                 (ztree-toggle-expand-state node))
340               (setq ztree-count-subsequent-bs t)
341               (ztree-refresh-buffer line))
342           (progn (setq ztree-count-subsequent-bs nil)
343                  (ztree-scroll-to-line parent)))))))
344
345
346 (defun ztree-get-splitted-node-contens (node)
347   "Return pair of 2 elements: list of expandable nodes and list of leafs.
348 Argument NODE node which contents will be returned."
349   (let ((nodes (funcall ztree-node-contents-fun node))
350         (comp  #'(lambda (x y)
351                    (string< (funcall ztree-node-short-name-fun x)
352                             (funcall ztree-node-short-name-fun y)))))
353     (cons (sort (ztree-filter
354                  #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
355                  nodes)
356                 comp)
357           (sort (ztree-filter
358                  #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
359                  nodes)
360                 comp))))
361
362
363 (defun ztree-draw-char (c x y &optional face)
364   "Draw char C at the position (1-based) (X Y).
365 Optional argument FACE face to use to draw a character."
366   (save-excursion
367     (goto-char (point-min))
368     (forward-line (1- y))
369     (beginning-of-line)
370     (goto-char (+ x (-(point) 1)))
371     (delete-char 1)
372     (insert-char c 1)
373     (put-text-property (1- (point)) (point) 'font-lock-face (if face face 'ztreep-arrow-face))))
374
375 (defun ztree-vertical-line-char ()
376   "Return the character used to draw vertical line."
377   (if ztree-draw-unicode-lines #x2502 ?\|))
378
379 (defun ztree-horizontal-line-char ()
380   "Return the character used to draw vertical line."
381   (if ztree-draw-unicode-lines #x2500 ?\-))
382
383 (defun ztree-left-bottom-corner-char ()
384   "Return the character used to draw vertical line."
385   (if ztree-draw-unicode-lines #x2514 ?\`))
386
387 (defun ztree-left-intersection-char ()
388   "Return left intersection character.
389 It is just vertical bar when unicode disabled"
390   (if ztree-draw-unicode-lines #x251C ?\|))
391
392 (defun ztree-draw-vertical-line (y1 y2 x &optional face)
393   "Draw a vertical line of `|' characters from Y1 row to Y2 in X column.
394 Optional argument FACE face to draw line with."
395   (let ((ver-line-char (ztree-vertical-line-char))
396         (count (abs (- y1 y2))))
397     (if (> y1 y2)
398         (progn
399           (dotimes (y count)
400             (ztree-draw-char ver-line-char x (+ y2 y) face))
401           (ztree-draw-char ver-line-char x (+ y2 count) face))
402       (progn
403         (dotimes (y count)
404           (ztree-draw-char ver-line-char x (+ y1 y) face))
405         (ztree-draw-char ver-line-char x (+ y1 count) face)))))
406
407 (defun ztree-draw-vertical-rounded-line (y1 y2 x &optional face)
408   "Draw a vertical line of `|' characters finishing with `\\=`' character.
409 Draws the line from Y1 row to Y2 in X column.
410 Optional argument FACE facet to draw the line with."
411   (let ((ver-line-char (ztree-vertical-line-char))
412         (corner-char (ztree-left-bottom-corner-char))
413         (count (abs (- y1 y2))))
414     (if (> y1 y2)
415         (progn
416           (dotimes (y count)
417             (ztree-draw-char ver-line-char x (+ y2 y) face))
418           (ztree-draw-char corner-char x (+ y2 count) face))
419       (progn
420         (dotimes (y count)
421           (ztree-draw-char ver-line-char x (+ y1 y) face))
422         (ztree-draw-char corner-char x (+ y1 count) face)))))
423
424
425 (defun ztree-draw-horizontal-line (x1 x2 y)
426   "Draw the horizontal line from column X1 to X2 in the row Y."
427   (let ((hor-line-char (ztree-horizontal-line-char)))
428     (if (> x1 x2)
429         (dotimes (x (1+ (- x1 x2)))
430           (ztree-draw-char hor-line-char (+ x2 x) y))
431       (dotimes (x (1+ (- x2 x1)))
432         (ztree-draw-char hor-line-char (+ x1 x) y)))))
433
434
435 (defun ztree-draw-tree (tree depth start-offset)
436   "Draw the TREE of lines with parents.
437 Argument DEPTH current depth.
438 Argument START-OFFSET column to start drawing from."
439   (if (atom tree)
440       nil
441     (let* ((root (car tree))
442            (children (cdr tree))
443            (offset (+ start-offset (* depth 4)))
444            (line-start (+ 3 offset))
445            (line-end-leaf (+ 7 offset))
446            (line-end-node (+ 4 offset))
447            (corner-char (ztree-left-bottom-corner-char))
448            (intersection-char (ztree-left-intersection-char))
449            ;; determine if the line is visible. It is always the case
450            ;; for 1-sided trees; however for 2 sided trees
451            ;; it depends on which side is the actual element
452            ;; and which tree (left with offset 0 or right with offset > 0
453            ;; we are drawing
454            (visible #'(lambda (line) ()
455                         (if (not ztree-node-side-fun) t
456                           (let ((side
457                                  (plist-get (gethash line ztree-line-tree-properties) 'side)))
458                             (cond ((eq side 'left) (= start-offset 0))
459                                   ((eq side 'right) (> start-offset 0))
460                                   (t t)))))))
461       (when children
462         ;; draw the line to the last child
463         ;; since we push'd children to the list, it's the first visible line
464         ;; from the children list
465         (let ((last-child (ztree-find children
466                                       #'(lambda (x)
467                                           (funcall visible (ztree-car-atom x)))))
468               (x-offset (+ 2 offset)))
469           (when last-child
470             (ztree-draw-vertical-line (1+ root)
471                                       (ztree-car-atom last-child)
472                                       x-offset))
473           ;; draw recursively
474           (dolist (child children)
475             (ztree-draw-tree child (1+ depth) start-offset)
476             (let ((end (if (listp child) line-end-node line-end-leaf))
477                   (row (ztree-car-atom child)))
478               (when (funcall visible (ztree-car-atom child))
479                 (ztree-draw-char intersection-char (1- line-start) row)
480                 (ztree-draw-horizontal-line line-start
481                                             end
482                                             row))))
483           ;; finally draw the corner at the end of vertical line
484           (when last-child
485             (ztree-draw-char corner-char
486                              x-offset
487                              (ztree-car-atom last-child))))))))
488
489 (defun ztree-fill-parent-array (tree)
490   "Set the root lines array.
491 Argument TREE nodes tree to create an array of lines from."
492   (let ((root (car tree))
493         (children (cdr tree)))
494     (dolist (child children)
495       (ztree-set-parent-for-line (ztree-car-atom child) root)
496       (when (listp child)
497         (ztree-fill-parent-array child)))))
498
499
500 (defun ztree-insert-node-contents (path)
501   "Insert node contents with initial depth 0.
502 `ztree-insert-node-contents-1' return the tree of line
503 numbers to determine who is parent line of the
504 particular line.  This tree is used to draw the
505 graph.
506 Argument PATH start node."
507   (let ((tree (ztree-insert-node-contents-1 path 0))
508         ;; number of 'rows' in tree is last line minus start line
509         (num-of-items (- (line-number-at-pos (point)) ztree-start-line)))
510     ;; create a parents array to store parents of lines
511     ;; parents array used for navigation with the BS
512     (setq ztree-parent-lines-array (make-vector num-of-items 0))
513     ;; set the root node in lines parents array
514     (ztree-set-parent-for-line ztree-start-line ztree-start-line)
515     ;; fill the parent arrray from the tree
516     (ztree-fill-parent-array tree)
517     ;; draw the tree starting with depth 0 and offset 0
518     (ztree-draw-tree tree 0 0)
519     ;; for the 2-sided tree we need to draw the vertical line
520     ;; and an additional tree
521     (if ztree-node-side-fun             ; 2-sided tree
522         (let ((width (window-width)))
523           ;; draw the vertical line in the middle of the window
524           (ztree-draw-vertical-line ztree-start-line
525                                     (1- (+ num-of-items ztree-start-line))
526                                     (/ width 2)
527                                     'vertical-border)
528           (ztree-draw-tree tree 0 (1+ (/ width 2)))))))
529
530
531 (defun ztree-insert-node-contents-1 (node depth)
532   "Recursively insert contents of the NODE with current DEPTH."
533   (let* ((expanded (ztree-is-expanded-node node))
534          ;; insert node entry with defined depth
535          (root-line (ztree-insert-entry node depth expanded))
536          ;; children list is the list of lines which are children
537          ;; of the root line
538          (children nil))
539     (when expanded ;; if expanded we need to add all subnodes
540       (let* ((contents (ztree-get-splitted-node-contens node))
541              ;; contents is the list of 2 elements:
542              (nodes (car contents))     ; expandable entries - nodes
543              (leafs (cdr contents)))    ; leafs - which doesn't have subleafs
544         ;; iterate through all expandable entries to insert them first
545         (dolist (node nodes)
546           ;; if it is not in the filter list
547           (when (funcall ztree-node-showp-fun node)
548             ;; insert node on the next depth level
549             ;; and push the returning result (in form (root children))
550             ;; to the children list
551             (push (ztree-insert-node-contents-1 node (1+ depth))
552                   children)))
553         ;; now iterate through all the leafs
554         (dolist (leaf leafs)
555           ;; if not in filter list
556           (when (funcall ztree-node-showp-fun leaf)
557             ;; insert the leaf and add it to children
558             (push (ztree-insert-entry leaf (1+ depth) nil)
559                   children)))))
560     ;; result value is the list - head is the root line,
561     ;; rest are children
562     (cons root-line children)))
563
564 (defun ztree-insert-entry (node depth expanded)
565   "Inselt the NODE to the current line with specified DEPTH and EXPANDED state."
566   (let* ((line (line-number-at-pos))
567          ;; the properties of the line. they will be updated
568          ;; with the offset of the text and relevant side information
569          (line-properties (gethash line ztree-line-tree-properties))
570          (expandable (funcall ztree-node-is-expandable-fun node))
571          (short-name (funcall ztree-node-short-name-fun node))
572          (count-children-left 
573           (when (and expandable ztree-show-number-of-children)
574             (ignore-errors
575               (length (cl-remove-if (lambda (n)
576                                       (and ztree-node-side-fun
577                                            (eql 
578                                             (funcall ztree-node-side-fun n)
579                                             'right)))
580                                     (funcall ztree-node-contents-fun node))))))
581          (count-children-right
582           (when (and expandable ztree-show-number-of-children)
583             (ignore-errors
584               (length (cl-remove-if (lambda (n)
585                                       (and ztree-node-side-fun
586                                            (eql
587                                             (funcall ztree-node-side-fun n)
588                                             'left)))
589                                     (funcall ztree-node-contents-fun node)))))))
590     (if ztree-node-side-fun           ; 2-sided tree
591         (let ((right-short-name (funcall ztree-node-short-name-fun node t))
592               (side (funcall ztree-node-side-fun node))
593               (width (window-width)))
594           (when (eq side 'left)  (setq right-short-name ""))
595           (when (eq side 'right) (setq short-name ""))
596           (setq line-properties
597                 (plist-put line-properties 'offset 
598                            ;; insert left side and save the offset
599                            (ztree-insert-single-entry short-name depth
600                                                       expandable expanded 0
601                                                       count-children-left
602                                                       (when ztree-node-face-fun
603                                                         (funcall ztree-node-face-fun node)))))
604           ;; right side
605           (ztree-insert-single-entry right-short-name depth
606                                      expandable expanded (1+ (/ width 2))
607                                      count-children-right
608                                      (when ztree-node-face-fun
609                                        (funcall ztree-node-face-fun node)))
610           (setq line-properties (plist-put line-properties 'side side)))
611       ;; one sided view
612       (setq line-properties (plist-put line-properties 'offset
613                                        (ztree-insert-single-entry short-name depth
614                                                                   expandable expanded
615                                                                   0 (when expandable
616                                                                       count-children-left)))))
617     (puthash line node ztree-line-to-node-table)
618     ;; save the properties for the line - side and text offset
619     (puthash line line-properties ztree-line-tree-properties)
620     (insert "\n")
621     line))
622
623 (defun ztree-insert-single-entry (short-name depth
624                                              expandable expanded
625                                              offset
626                                              count-children
627                                              &optional face)
628   "Writes a SHORT-NAME in a proper position with the type given.
629 Writes a string with given DEPTH, prefixed with [ ] if EXPANDABLE
630 and [-] or [+] depending on if it is EXPANDED from the specified OFFSET.
631 If `ztree-show-number-of-children' is set to t the COUNT-CHILDREN
632 argument is used to present number of entries in the expandable item.
633 COUNT-CHILDREN might be null if the contents of expandable node are
634 not accessible.
635 Optional argument FACE face to write text with.
636 Returns the position where the text starts."
637   (let ((result 0)
638         (node-sign #'(lambda (exp)
639                        (let ((sign (concat "[" (if exp "-" "+") "]")))
640                          (insert (propertize sign
641                                              'font-lock-face
642                                              ztreep-expand-sign-face)))))
643         ;; face to use. if FACE is not null, use it, otherwise
644         ;; deside from the node type
645         (entry-face (cond (face face)
646                           (expandable 'ztreep-node-face)
647                           (t ztreep-leaf-face))))
648     ;; move-to-column in contrast to insert reuses the last property
649     ;; so need to clear it
650     (let ((start-pos (point)))
651       (move-to-column offset t)
652       (remove-text-properties start-pos (point) '(font-lock-face nil)))
653     (delete-region (point) (line-end-position))
654     ;; every indentation level is 4 characters
655     (when (> depth 0)
656       (insert-char ?\s (* 4 depth)))           ; insert 4 spaces
657     (when (> (length short-name) 0)
658       (let ((start-pos (point)))
659         (if expandable
660             (funcall node-sign expanded))   ; for expandable nodes insert "[+/-]"
661         ;; indentation for leafs 4 spaces from the node name
662         (insert-char ?\s (- 4 (- (point) start-pos))))
663       ;; save the position of the beginning of the text
664       (setq result (current-column))
665       (insert (propertize short-name 'font-lock-face entry-face))
666       ;; optionally add number of children in braces
667       (when (and ztree-show-number-of-children expandable)
668         (let ((count-str (format " [%s]"
669                                  (if count-children (number-to-string count-children) "N/A"))))
670           (insert (propertize count-str 'font-lock-face ztreep-node-count-children-face)))))
671     result))
672
673
674 (defun ztree-jump-side ()
675   "Jump to another side for 2-sided trees."
676   (interactive)
677   (when ztree-node-side-fun             ; 2-sided tree
678     (let ((center (/ (window-width) 2)))
679       (if (< (current-column) center)
680           (move-to-column (1+ center))
681         (move-to-column 1))
682       ;; just recalculate and move to proper column
683       (ztree-scroll-to-line (line-number-at-pos)))))
684
685
686 (defun ztree-save-current-position ()
687   "Save the current position into the global variable."
688   (setq ztree-prev-position (cons (line-number-at-pos (point))
689                                   (current-column))))
690
691
692 (defun ztree-refresh-buffer (&optional line)
693   "Refresh the buffer.
694 Optional argument LINE scroll to the line given."
695   (interactive)
696   (when (and (equal major-mode 'ztree-mode)
697              (boundp 'ztree-start-node))
698     (let ((prev-pos ztree-prev-position))
699       (setq ztree-line-to-node-table (make-hash-table))
700       ;; create a hash table of node properties for line
701       (setq ztree-line-tree-properties (make-hash-table))
702       (let ((inhibit-read-only t))
703         (ztree-save-current-position)
704         (erase-buffer)
705         (funcall ztree-tree-header-fun)
706         (setq ztree-start-line (line-number-at-pos (point)))
707         (ztree-insert-node-contents ztree-start-node)
708         (cond (line ;; local refresh, scroll to line
709                (ztree-scroll-to-line line)
710                (when prev-pos
711                  (beginning-of-line)
712                  (goto-char (+ (cdr ztree-prev-position) (point)))))
713               ((and (null line) (null prev-pos)) ;; first refresh
714                (ztree-scroll-to-line ztree-start-line)
715                (ztree-save-current-position))
716               ((and (null line) prev-pos) ;; not first refresh
717                ;; restore cursor position if possible
718                (ztree-scroll-to-line (car ztree-prev-position))
719                (beginning-of-line)
720                (goto-char (+ (cdr ztree-prev-position) (point)))))))))
721
722              
723
724 (defun ztree-change-start-node (node)
725   "Refresh the buffer setting the new root NODE.
726 This will reuse all other settings for the current ztree buffer, but
727 change the root node to the node specified."
728   (setq ztree-start-node node
729         ztree-expanded-nodes-list (list ztree-start-node)
730         ;; then the new root node is given, no sense to preserve
731         ;; a cursor position
732         ztree-prev-position nil)
733   (ztree-refresh-buffer))
734
735 (defun ztree-previous-line (arg)
736   "Move the point to ARG lines up"
737   (interactive "^p")
738   (ztree-next-line (- (or arg 1))))
739
740
741 (defun ztree-next-line (arg)
742   "Move the point to ARG lines down"  
743   (interactive "^p")
744   (ztree-move-line arg))
745
746
747 (defun ztree-move-line (count)
748   "Move the point COUNT lines and place at the beginning of the node."
749   (ztree-scroll-to-line
750    (+ count (line-number-at-pos))))
751
752 ;;;###autoload
753 (defun ztree-view-on-window-configuration-changed ()
754   "Hook called then window configuration changed to resize buffer's contents"
755   ;; refresh visible ztree buffers
756   (walk-windows (lambda (win) 
757                   (with-current-buffer (window-buffer win)
758                     (when (derived-mode-p 'ztree-mode)
759                       (ztree-refresh-buffer))))
760                 nil 'visible))
761
762 (defun ztree-view (
763                    buffer-name
764                    start-node
765                    filter-fun
766                    header-fun
767                    short-name-fun
768                    expandable-p
769                    equal-fun
770                    children-fun
771                    face-fun
772                    action-fun
773                    &optional
774                    node-side-fun
775                    )
776   "Create a ztree view buffer configured with parameters given.
777 Argument BUFFER-NAME Name of the buffer created.
778 Argument START-NODE Starting node - the root of the tree.
779 Argument FILTER-FUN Function which will define if the node should not be
780 visible.
781 Argument HEADER-FUN Function which inserts the header into the buffer
782 before drawing the tree.
783 Argument SHORT-NAME-FUN Function which return the short name for a node given.
784 Argument EXPANDABLE-P Function to determine if the node is expandable.
785 Argument EQUAL-FUN An equality function for nodes.
786 Argument CHILDREN-FUN Function to get children from the node.
787 Argument FACE-FUN Function to determine face of the node.
788 Argument ACTION-FUN an action to perform when the Return is pressed.
789 Optional argument NODE-SIDE-FUN Determines the side of the node."
790   (let ((buf (get-buffer-create buffer-name)))
791     (switch-to-buffer buf)
792     (ztree-mode)
793     ;; configure ztree-view
794     (setq ztree-start-node start-node)
795     (setq ztree-expanded-nodes-list (list ztree-start-node))
796     (setq ztree-node-showp-fun filter-fun)
797     (setq ztree-tree-header-fun header-fun)
798     (setq ztree-node-short-name-fun short-name-fun)
799     (setq ztree-node-is-expandable-fun expandable-p)
800     (setq ztree-node-equal-fun equal-fun)
801     (setq ztree-node-contents-fun children-fun)
802     (setq ztree-node-face-fun face-fun)
803     (setq ztree-node-action-fun action-fun)
804     (setq ztree-node-side-fun node-side-fun)
805     (add-hook 'window-configuration-change-hook #'ztree-view-on-window-configuration-changed)
806     (ztree-refresh-buffer)))
807
808
809 (provide 'ztree-view)
810 ;;; ztree-view.el ends here