code.delx.au - gnu-emacs-elpa/blob - packages/ztree/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-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 (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   (setq buffer-read-only t))
 168
 169
 170 (defun ztree-find-node-in-line (line)
 171   "Return the node for the LINE specified.
 172 Search through the array of node-line pairs."
 173   (gethash line ztree-line-to-node-table))
 174
 175 (defun ztree-find-node-at-point ()
 176   "Find the node at point.
 177 Returns cons pair (node, side) for the current point
 178 or nil if there is no node"
 179   (let ((center (/ (window-width) 2))
 180         (node (ztree-find-node-in-line (line-number-at-pos))))
 181     (when node
 182       (cons node (if (> (current-column) center) 'right 'left)))))
 183
 184
 185 (defun ztree-is-expanded-node (node)
 186   "Find if the NODE is in the list of expanded nodes."
 187   (ztree-find ztree-expanded-nodes-list
 188               #'(lambda (x) (funcall ztree-node-equal-fun x node))))
 189
 190
 191 (defun ztree-set-parent-for-line (line parent)
 192   "For given LINE set the PARENT in the global array."
 193   (aset ztree-parent-lines-array (- line ztree-start-line) parent))
 194
 195 (defun ztree-get-parent-for-line (line)
 196   "For given LINE return a parent."
 197   (when (and (>= line ztree-start-line)
 198              (< line (+ (length ztree-parent-lines-array) ztree-start-line)))
 199     (aref ztree-parent-lines-array (- line ztree-start-line))))
 200
 201 (defun scroll-to-line (line)
 202   "Recommended way to set the cursor to specified LINE."
 203   (goto-char (point-min))
 204   (forward-line (1- line)))
 205
 206
 207 (defun ztree-do-toggle-expand-subtree-iter (node state)
 208   "Iteration in expanding subtree.
 209 Argument NODE current node.
 210 Argument STATE node state."
 211   (when (funcall ztree-node-is-expandable-fun node)
 212     (let ((children (funcall ztree-node-contents-fun node)))
 213       (ztree-do-toggle-expand-state node state)
 214       (dolist (child children)
 215         (ztree-do-toggle-expand-subtree-iter child state)))))
 216
 217
 218 (defun ztree-do-toggle-expand-subtree ()
 219   "Implements the subtree expand."
 220   (let* ((line (line-number-at-pos))
 221          (node (ztree-find-node-in-line line))
 222          ;; save the current window start position
 223          (current-pos (window-start)))
 224     ;; only for expandable nodes
 225     (when (funcall ztree-node-is-expandable-fun node)
 226       ;; get the current expand state and invert it
 227       (let ((do-expand (not (ztree-is-expanded-node node))))
 228         (ztree-do-toggle-expand-subtree-iter node do-expand))
 229       ;; refresh buffer and scroll back to the saved line
 230       (ztree-refresh-buffer line)
 231       ;; restore window start position
 232       (set-window-start (selected-window) current-pos))))
 233
 234
 235 (defun ztree-do-perform-action (hard)
 236   "Toggle expand/collapsed state for nodes or perform an action.
 237 HARD specifies (t or nil) if the hard action, binded on RET,
 238 should be performed on node."
 239   (let* ((line (line-number-at-pos))
 240          (node (ztree-find-node-in-line line)))
 241     (when node
 242       (if (funcall ztree-node-is-expandable-fun node)
 243           ;; only for expandable nodes
 244           (ztree-toggle-expand-state node)
 245         ;; perform action
 246         (when ztree-node-action-fun
 247           (funcall ztree-node-action-fun node hard)))
 248       ;; save the current window start position
 249       (let ((current-pos (window-start)))
 250         ;; refresh buffer and scroll back to the saved line
 251         (ztree-refresh-buffer line)
 252         ;; restore window start position
 253         (set-window-start (selected-window) current-pos)))))
 254
 255
 256 (defun ztree-perform-action ()
 257   "Toggle expand/collapsed state for nodes or perform the action.
 258 Performs the hard action, binded on RET, on node."
 259   (interactive)
 260   (ztree-do-perform-action t))
 261
 262 (defun ztree-perform-soft-action ()
 263   "Toggle expand/collapsed state for nodes or perform the action.
 264 Performs the soft action, binded on Space, on node."
 265   (interactive)
 266   (ztree-do-perform-action nil))
 267
 268
 269 (defun ztree-toggle-expand-subtree()
 270   "Toggle Expanded/Collapsed state on all nodes of the subtree"
 271   (interactive)
 272   (ztree-do-toggle-expand-subtree))
 273
 274 (defun ztree-do-toggle-expand-state (node do-expand)
 275   "Set the expanded state of the NODE to DO-EXPAND."
 276   (if (not do-expand)
 277       (setq ztree-expanded-nodes-list
 278             (ztree-filter
 279              #'(lambda (x) (not (funcall ztree-node-equal-fun node x)))
 280              ztree-expanded-nodes-list))
 281     (push node ztree-expanded-nodes-list)))
 282
 283
 284 (defun ztree-toggle-expand-state (node)
 285   "Toggle expanded/collapsed state for NODE."
 286   (ztree-do-toggle-expand-state node (not (ztree-is-expanded-node node))))
 287
 288
 289 (defun ztree-move-up-in-tree ()
 290   "Action on Backspace key.
 291 Jump to the line of a parent node.  If previous key was Backspace
 292 then close the node."
 293   (interactive)
 294   (when ztree-parent-lines-array
 295     (let* ((line (line-number-at-pos (point)))
 296            (parent (ztree-get-parent-for-line line)))
 297       (when parent
 298         (if (and (equal last-command 'ztree-move-up-in-tree)
 299                  (not ztree-count-subsequent-bs))
 300             (let ((node (ztree-find-node-in-line line)))
 301               (when (ztree-is-expanded-node node)
 302                 (ztree-toggle-expand-state node))
 303               (setq ztree-count-subsequent-bs t)
 304               (ztree-refresh-buffer line))
 305           (progn (setq ztree-count-subsequent-bs nil)
 306                  (scroll-to-line parent)))))))
 307
 308
 309 (defun ztree-get-splitted-node-contens (node)
 310   "Return pair of 2 elements: list of expandable nodes and list of leafs.
 311 Argument NODE node which contents will be returned."
 312   (let ((nodes (funcall ztree-node-contents-fun node))
 313         (comp  #'(lambda (x y)
 314                    (string< (funcall ztree-node-short-name-fun x)
 315                             (funcall ztree-node-short-name-fun y)))))
 316     (cons (sort (ztree-filter
 317                  #'(lambda (f) (funcall ztree-node-is-expandable-fun f))
 318                  nodes)
 319                 comp)
 320           (sort (ztree-filter
 321                  #'(lambda (f) (not (funcall ztree-node-is-expandable-fun f)))
 322                  nodes)
 323                 comp))))
 324
 325
 326 (defun ztree-draw-char (c x y &optional face)
 327   "Draw char C at the position (1-based) (X Y).
 328 Optional argument FACE face to use to draw a character."
 329   (save-excursion
 330     (scroll-to-line y)
 331     (beginning-of-line)
 332     (goto-char (+ x (-(point) 1)))
 333     (delete-char 1)
 334     (insert-char c 1)
 335     (put-text-property (1- (point)) (point) 'font-lock-face (if face face 'ztreep-arrow-face))))
 336
 337 (defun ztree-vertical-line-char ()
 338   "Return the character used to draw vertical line"
 339   (if ztree-draw-unicode-lines #x2502 ?\|))
 340
 341 (defun ztree-horizontal-line-char ()
 342   "Return the character used to draw vertical line"
 343   (if ztree-draw-unicode-lines #x2500 ?\-))
 344
 345 (defun ztree-left-bottom-corner-char ()
 346   "Return the character used to draw vertical line"
 347   (if ztree-draw-unicode-lines #x2514 ?\`))
 348
 349 (defun ztree-left-intersection-char ()
 350   "Return left intersection character.
 351 It is just vertical bar when unicode disabled"
 352   (if ztree-draw-unicode-lines #x251C ?\|))
 353
 354 (defun ztree-draw-vertical-line (y1 y2 x &optional face)
 355   "Draw a vertical line of `|' characters from Y1 row to Y2 in X column.
 356 Optional argument FACE face to draw line with."
 357   (let ((ver-line-char (ztree-vertical-line-char))
 358         (count (abs (- y1 y2))))
 359     (if (> y1 y2)
 360         (progn
 361           (dotimes (y count)
 362             (ztree-draw-char ver-line-char x (+ y2 y) face))
 363           (ztree-draw-char ver-line-char x (+ y2 count) face))
 364       (progn
 365         (dotimes (y count)
 366           (ztree-draw-char ver-line-char x (+ y1 y) face))
 367         (ztree-draw-char ver-line-char x (+ y1 count) face)))))
 368
 369 (defun ztree-draw-vertical-rounded-line (y1 y2 x &optional face)
 370   "Draw a vertical line of `|' characters finishing with `\\=`' character.
 371 Draws the line from Y1 row to Y2 in X column.
 372 Optional argument FACE facet to draw the line with."
 373   (let ((ver-line-char (ztree-vertical-line-char))
 374         (corner-char (ztree-left-bottom-corner-char))
 375         (count (abs (- y1 y2))))
 376     (if (> y1 y2)
 377         (progn
 378           (dotimes (y count)
 379             (ztree-draw-char ver-line-char x (+ y2 y) face))
 380           (ztree-draw-char corner-char x (+ y2 count) face))
 381       (progn
 382         (dotimes (y count)
 383           (ztree-draw-char ver-line-char x (+ y1 y) face))
 384         (ztree-draw-char corner-char x (+ y1 count) face)))))
 385
 386
 387 (defun ztree-draw-horizontal-line (x1 x2 y)
 388   "Draw the horizontal line from column X1 to X2 in the row Y."
 389   (let ((hor-line-char (ztree-horizontal-line-char)))
 390     (if (> x1 x2)
 391         (dotimes (x (1+ (- x1 x2)))
 392           (ztree-draw-char hor-line-char (+ x2 x) y))
 393       (dotimes (x (1+ (- x2 x1)))
 394         (ztree-draw-char hor-line-char (+ x1 x) y)))))
 395
 396
 397 (defun ztree-draw-tree (tree depth start-offset)
 398   "Draw the TREE of lines with parents.
 399 Argument DEPTH current depth.
 400 Argument START-OFFSET column to start drawing from."
 401   (if (atom tree)
 402       nil
 403     (let* ((root (car tree))
 404            (children (cdr tree))
 405            (offset (+ start-offset (* depth 4)))
 406            (line-start (+ 3 offset))
 407            (line-end-leaf (+ 7 offset))
 408            (line-end-node (+ 4 offset))
 409            (corner-char (ztree-left-bottom-corner-char))
 410            (intersection-char (ztree-left-intersection-char))
 411            ;; determine if the line is visible. It is always the case
 412            ;; for 1-sided trees; however for 2 sided trees
 413            ;; it depends on which side is the actual element
 414            ;; and which tree (left with offset 0 or right with offset > 0
 415            ;; we are drawing
 416            (visible #'(lambda (line) ()
 417                         (if (not ztree-node-side-fun) t
 418                           (let ((side
 419                                  (gethash line ztree-line-tree-properties)))
 420                             (cond ((eq side 'left) (= start-offset 0))
 421                                   ((eq side 'right) (> start-offset 0))
 422                                   (t t)))))))
 423       (when children
 424         ;; draw the line to the last child
 425         ;; since we push'd children to the list, it's the first visible line
 426         ;; from the children list
 427         (let ((last-child (ztree-find children
 428                                       #'(lambda (x)
 429                                           (funcall visible (ztree-car-atom x)))))
 430               (x-offset (+ 2 offset)))
 431           (when last-child
 432             (ztree-draw-vertical-line (1+ root)
 433                                       (ztree-car-atom last-child)
 434                                       x-offset))
 435           ;; draw recursively
 436           (dolist (child children)
 437             (ztree-draw-tree child (1+ depth) start-offset)
 438             (let ((end (if (listp child) line-end-node line-end-leaf))
 439                   (row (ztree-car-atom child)))
 440               (when (funcall visible (ztree-car-atom child))
 441                 (ztree-draw-char intersection-char (1- line-start) row)
 442                 (ztree-draw-horizontal-line line-start
 443                                             end
 444                                             row))))
 445           ;; finally draw the corner at the end of vertical line
 446           (when last-child
 447             (ztree-draw-char corner-char
 448                              x-offset
 449                              (ztree-car-atom last-child))))))))
 450
 451 (defun ztree-fill-parent-array (tree)
 452   "Set the root lines array.
 453 Argument TREE nodes tree to create an array of lines from."
 454   (let ((root (car tree))
 455         (children (cdr tree)))
 456     (dolist (child children)
 457       (ztree-set-parent-for-line (ztree-car-atom child) root)
 458       (when (listp child)
 459         (ztree-fill-parent-array child)))))
 460
 461
 462 (defun ztree-insert-node-contents (path)
 463   "Insert node contents with initial depth 0.
 464 `ztree-insert-node-contents-1' return the tree of line
 465 numbers to determine who is parent line of the
 466 particular line.  This tree is used to draw the
 467 graph.
 468 Argument PATH start node."
 469   (let ((tree (ztree-insert-node-contents-1 path 0))
 470         ;; number of 'rows' in tree is last line minus start line
 471         (num-of-items (- (line-number-at-pos (point)) ztree-start-line)))
 472     ;; create a parents array to store parents of lines
 473     ;; parents array used for navigation with the BS
 474     (setq ztree-parent-lines-array (make-vector num-of-items 0))
 475     ;; set the root node in lines parents array
 476     (ztree-set-parent-for-line ztree-start-line ztree-start-line)
 477     ;; fill the parent arrray from the tree
 478     (ztree-fill-parent-array tree)
 479     ;; draw the tree starting with depth 0 and offset 0
 480     (ztree-draw-tree tree 0 0)
 481     ;; for the 2-sided tree we need to draw the vertical line
 482     ;; and an additional tree
 483     (if ztree-node-side-fun             ; 2-sided tree
 484         (let ((width (window-width)))
 485           ;; draw the vertical line in the middle of the window
 486           (ztree-draw-vertical-line ztree-start-line
 487                                     (1- (+ num-of-items ztree-start-line))
 488                                     (/ width 2)
 489                                     'vertical-border)
 490           (ztree-draw-tree tree 0 (1+ (/ width 2)))))))
 491
 492
 493 (defun ztree-insert-node-contents-1 (node depth)
 494   "Recursively insert contents of the NODE with current DEPTH."
 495   (let* ((expanded (ztree-is-expanded-node node))
 496          ;; insert node entry with defined depth
 497          (root-line (ztree-insert-entry node depth expanded))
 498          ;; children list is the list of lines which are children
 499          ;; of the root line
 500          (children nil))
 501     (when expanded ;; if expanded we need to add all subnodes
 502       (let* ((contents (ztree-get-splitted-node-contens node))
 503              ;; contents is the list of 2 elements:
 504              (nodes (car contents))     ; expandable entries - nodes
 505              (leafs (cdr contents)))    ; leafs - which doesn't have subleafs
 506         ;; iterate through all expandable entries to insert them first
 507         (dolist (node nodes)
 508           ;; if it is not in the filter list
 509           (when (funcall ztree-node-showp-fun node)
 510             ;; insert node on the next depth level
 511             ;; and push the returning result (in form (root children))
 512             ;; to the children list
 513             (push (ztree-insert-node-contents-1 node (1+ depth))
 514                   children)))
 515         ;; now iterate through all the leafs
 516         (dolist (leaf leafs)
 517           ;; if not in filter list
 518           (when (funcall ztree-node-showp-fun leaf)
 519             ;; insert the leaf and add it to children
 520             (push (ztree-insert-entry leaf (1+ depth) nil)
 521                   children)))))
 522     ;; result value is the list - head is the root line,
 523     ;; rest are children
 524     (cons root-line children)))
 525
 526 (defun ztree-insert-entry (node depth expanded)
 527   "Inselt the NODE to the current line with specified DEPTH and EXPANDED state."
 528   (let ((line (line-number-at-pos))
 529         (expandable (funcall ztree-node-is-expandable-fun node))
 530         (short-name (funcall ztree-node-short-name-fun node)))
 531     (if ztree-node-side-fun           ; 2-sided tree
 532         (let ((right-short-name (funcall ztree-node-short-name-fun node t))
 533               (side (funcall ztree-node-side-fun node))
 534               (width (window-width)))
 535           (when (eq side 'left)  (setq right-short-name ""))
 536           (when (eq side 'right) (setq short-name ""))
 537           (ztree-insert-single-entry short-name depth
 538                                      expandable expanded 0
 539                                      (when ztree-node-face-fun
 540                                        (funcall ztree-node-face-fun node)))
 541           (ztree-insert-single-entry right-short-name depth
 542                                      expandable expanded (1+ (/ width 2))
 543                                      (when ztree-node-face-fun
 544                                        (funcall ztree-node-face-fun node)))
 545           (puthash line side ztree-line-tree-properties))
 546       (ztree-insert-single-entry short-name depth expandable expanded 0))
 547     (puthash line node ztree-line-to-node-table)
 548     (insert "\n")
 549     line))
 550
 551 (defun ztree-insert-single-entry (short-name depth
 552                                              expandable expanded
 553                                              offset
 554                                              &optional face)
 555   "Writes a SHORT-NAME in a proper position with the type given.
 556 Writes a string with given DEPTH, prefixed with [ ] if EXPANDABLE
 557 and [-] or [+] depending on if it is EXPANDED from the specified OFFSET.
 558 Optional argument FACE face to write text with."
 559   (let ((node-sign #'(lambda (exp)
 560                        (let ((sign (concat "[" (if exp "-" "+") "]")))
 561                          (insert (propertize sign
 562                                              'font-lock-face
 563                                              ztreep-expand-sign-face)))))
 564         ;; face to use. if FACE is not null, use it, otherwise
 565         ;; deside from the node type
 566         (entry-face (cond (face face)
 567                           (expandable 'ztreep-node-face)
 568                           (t ztreep-leaf-face))))
 569     ;; move-to-column in contrast to insert reuses the last property
 570     ;; so need to clear it
 571     (let ((start-pos (point)))
 572       (move-to-column offset t)
 573       (remove-text-properties start-pos (point) '(font-lock-face nil)))
 574     (delete-region (point) (line-end-position))
 575     ;; every indentation level is 4 characters
 576     (when (> depth 0)
 577       (insert-char ?\s (* 4 depth)))           ; insert 4 spaces
 578     (when (> (length short-name) 0)
 579       (let ((start-pos (point)))
 580         (if expandable
 581             (funcall node-sign expanded))   ; for expandable nodes insert "[+/-]"
 582         ;; indentation for leafs 4 spaces from the node name
 583         (insert-char ?\s (- 4 (- (point) start-pos))))
 584       (insert (propertize short-name 'font-lock-face entry-face)))))
 585
 586
 587
 588 (defun ztree-jump-side ()
 589   "Jump to another side for 2-sided trees."
 590   (interactive)
 591   (when ztree-node-side-fun             ; 2-sided tree
 592     (let ((center (/ (window-width) 2)))
 593       (cond ((< (current-column) center)
 594              (move-to-column (1+ center)))
 595             ((> (current-column) center)
 596              (move-to-column 1))
 597             (t nil)))))
 598
 599
 600
 601 (defun ztree-refresh-buffer (&optional line)
 602   "Refresh the buffer.
 603 Optional argument LINE scroll to the line given."
 604   (interactive)
 605   (when (and (equal major-mode 'ztree-mode)
 606              (boundp 'ztree-start-node))
 607     (setq ztree-line-to-node-table (make-hash-table))
 608     ;; create a hash table of node properties for line
 609     ;; used in 2-side tree mode
 610     (when ztree-node-side-fun
 611       (setq ztree-line-tree-properties (make-hash-table)))
 612     (let ((inhibit-read-only t))
 613       (erase-buffer)
 614       (funcall ztree-tree-header-fun)
 615       (setq ztree-start-line (line-number-at-pos (point)))
 616       (ztree-insert-node-contents ztree-start-node))
 617     (scroll-to-line (if line line ztree-start-line))))
 618
 619
 620 (defun ztree-view (
 621                    buffer-name
 622                    start-node
 623                    filter-fun
 624                    header-fun
 625                    short-name-fun
 626                    expandable-p
 627                    equal-fun
 628                    children-fun
 629                    face-fun
 630                    action-fun
 631                    &optional
 632                    node-side-fun
 633                    )
 634   "Create a ztree view buffer configured with parameters given.
 635 Argument BUFFER-NAME Name of the buffer created.
 636 Argument START-NODE Starting node - the root of the tree.
 637 Argument FILTER-FUN Function which will define if the node should not be
 638 visible.
 639 Argument HEADER-FUN Function which inserts the header into the buffer
 640 before drawing the tree.
 641 Argument SHORT-NAME-FUN Function which return the short name for a node given.
 642 Argument EXPANDABLE-P Function to determine if the node is expandable.
 643 Argument EQUAL-FUN An equality function for nodes.
 644 Argument CHILDREN-FUN Function to get children from the node.
 645 Argument FACE-FUN Function to determine face of the node.
 646 Argument ACTION-FUN an action to perform when the Return is pressed.
 647 Optional argument NODE-SIDE-FUN Determines the side of the node."
 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