code.delx.au - gnu-emacs-elpa/blob - packages/ztree/ztree-view.el

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