.emacs.d.git - Gitblit

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