code.delx.au - gnu-emacs/blob - lisp/tree-widget.el

   1 ;;; tree-widget.el --- Tree widget
   2
   3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: David Ponce <david@dponce.com>
   6 ;; Maintainer: David Ponce <david@dponce.com>
   7 ;; Created: 16 Feb 2001
   8 ;; Keywords: extensions
   9
  10 ;; This file is part of GNU Emacs
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with this program; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;; This library provide a tree widget useful to display data
  30 ;; structures organized in a hierarchical order.
  31 ;;
  32 ;; The following properties are specific to the tree widget:
  33 ;;
  34 ;; :open
  35 ;;    Set to non-nil to expand the tree.  By default the tree is
  36 ;;    collapsed.
  37 ;;
  38 ;; :node
  39 ;;    Specify the widget used to represent the value of a tree node.
  40 ;;    By default this is an `item' widget which displays the
  41 ;;    tree-widget :tag property value if defined, or a string
  42 ;;    representation of the tree-widget value.
  43 ;;
  44 ;; :keep
  45 ;;    Specify a list of properties to keep when the tree is collapsed
  46 ;;    so they can be recovered when the tree is expanded.  This
  47 ;;    property can be used in child widgets too.
  48 ;;
  49 ;; :expander (obsoletes :dynargs)
  50 ;;    Specify a function to be called to dynamically provide the
  51 ;;    tree's children in response to an expand request.  This function
  52 ;;    will be passed the tree widget and must return a list of child
  53 ;;    widgets.
  54 ;;
  55 ;;    *Please note:* Child widgets returned by the :expander function
  56 ;;    are stored in the :args property of the tree widget.  To speed
  57 ;;    up successive expand requests, the :expander function is not
  58 ;;    called again when the :args value is non-nil.  To refresh child
  59 ;;    values, it is necessary to set the :args property to nil, then
  60 ;;    redraw the tree.
  61 ;;
  62 ;; :open-control  (default `tree-widget-open-control')
  63 ;; :close-control (default `tree-widget-close-control')
  64 ;; :empty-control (default `tree-widget-empty-control')
  65 ;; :leaf-control  (default `tree-widget-leaf-control')
  66 ;; :guide         (default `tree-widget-guide')
  67 ;; :end-guide     (default `tree-widget-end-guide')
  68 ;; :no-guide      (default `tree-widget-no-guide')
  69 ;; :handle        (default `tree-widget-handle')
  70 ;; :no-handle     (default `tree-widget-no-handle')
  71 ;;    Those properties define the widgets used to draw the tree, and
  72 ;;    permit to customize its look and feel.  For example, using
  73 ;;    `item' widgets with these :tag values:
  74 ;;
  75 ;;    open-control     "[-] "      (OC)
  76 ;;    close-control    "[+] "      (CC)
  77 ;;    empty-control    "[X] "      (EC)
  78 ;;    leaf-control     "[>] "      (LC)
  79 ;;    guide            " |"        (GU)
  80 ;;    noguide          "  "        (NG)
  81 ;;    end-guide        " `"        (EG)
  82 ;;    handle           "-"         (HA)
  83 ;;    no-handle        " "         (NH)
  84 ;;
  85 ;;    A tree will look like this:
  86 ;;
  87 ;;    [-] 1                        (OC :node)
  88 ;;     |-[+] 1.0                   (GU+HA+CC :node)
  89 ;;     |-[X] 1.1                   (GU+HA+EC :node)
  90 ;;     `-[-] 1.2                   (EG+HA+OC :node)
  91 ;;        |-[>] 1.2.1              (NG+NH+GU+HA+LC child)
  92 ;;        `-[>] 1.2.2              (NG+NH+EG+HA+LC child)
  93 ;;
  94 ;; By default, images will be used instead of strings to draw a
  95 ;; nice-looking tree.  See the `tree-widget-image-enable',
  96 ;; `tree-widget-themes-directory', and `tree-widget-theme' options for
  97 ;; more details.
  98
  99 ;;; History:
 100 ;;
 101
 102 ;;; Code:
 103 (eval-when-compile (require 'cl))
 104 (require 'wid-edit)
 105 \f
 106 ;;; Customization
 107 ;;
 108 (defgroup tree-widget nil
 109   "Customization support for the Tree Widget library."
 110   :version "22.1"
 111   :group 'widgets)
 112
 113 (defcustom tree-widget-image-enable
 114   (not (or (featurep 'xemacs) (< emacs-major-version 21)))
 115   "*Non-nil means that tree-widget will try to use images."
 116   :type  'boolean
 117   :group 'tree-widget)
 118
 119 (defcustom tree-widget-themes-directory "tree-widget"
 120   "*Name of the directory where to look up for image themes.
 121 When nil use the directory where the tree-widget library is located.
 122 When a relative name is specified, try to locate that sub directory in
 123 `load-path', then in the data directory, and use the first one found.
 124 The data directory is the value of the variable `data-directory' on
 125 Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
 126 XEmacs.
 127 The default is to use the \"tree-widget\" relative name."
 128   :type '(choice (const :tag "Default" "tree-widget")
 129                  (const :tag "With the library" nil)
 130                  (directory :format "%{%t%}:\n%v"))
 131   :group 'tree-widget)
 132
 133 (defcustom tree-widget-theme nil
 134   "*Name of the theme where to look up for images.
 135 It must be a sub directory of the directory specified in variable
 136 `tree-widget-themes-directory'.  The default is \"default\".  When an
 137 image is not found in this theme, the default theme is searched too.
 138 A complete theme must contain images with these file names with a
 139 supported extension (see also `tree-widget-image-formats'):
 140
 141 \"open\"
 142   Represent an expanded node.
 143 \"close\"
 144   Represent a collapsed node.
 145 \"empty\"
 146   Represent an expanded node with no child.
 147 \"leaf\"
 148   Represent a leaf node.
 149 \"guide\"
 150   A vertical guide line.
 151 \"no-guide\"
 152   An invisible vertical guide line.
 153 \"end-guide\"
 154   End of a vertical guide line.
 155 \"handle\"
 156   Horizontal guide line that joins the vertical guide line to a node.
 157 \"no-handle\"
 158   An invisible handle."
 159   :type '(choice (const  :tag "Default" nil)
 160                  (string :tag "Name"))
 161   :group 'tree-widget)
 162
 163 (defcustom tree-widget-image-properties-emacs
 164   '(:ascent center :mask (heuristic t))
 165   "*Default properties of Emacs images."
 166   :type 'plist
 167   :group 'tree-widget)
 168
 169 (defcustom tree-widget-image-properties-xemacs
 170   nil
 171   "*Default properties of XEmacs images."
 172   :type 'plist
 173   :group 'tree-widget)
 174 \f
 175 ;;; Image support
 176 ;;
 177 (eval-and-compile ;; Emacs/XEmacs compatibility stuff
 178   (cond
 179    ;; XEmacs
 180    ((featurep 'xemacs)
 181     (defsubst tree-widget-use-image-p ()
 182       "Return non-nil if image support is currently enabled."
 183       (and tree-widget-image-enable
 184            widget-glyph-enable
 185            (console-on-window-system-p)))
 186     (defsubst tree-widget-create-image (type file &optional props)
 187       "Create an image of type TYPE from FILE, and return it.
 188 Give the image the specified properties PROPS."
 189       (apply 'make-glyph `([,type :file ,file ,@props])))
 190     (defsubst tree-widget-image-formats ()
 191       "Return the alist of image formats/file name extensions.
 192 See also the option `widget-image-file-name-suffixes'."
 193       (delq nil
 194             (mapcar
 195              #'(lambda (fmt)
 196                  (and (valid-image-instantiator-format-p (car fmt)) fmt))
 197              widget-image-file-name-suffixes)))
 198     )
 199    ;; Emacs
 200    (t
 201     (defsubst tree-widget-use-image-p ()
 202       "Return non-nil if image support is currently enabled."
 203       (and tree-widget-image-enable
 204            widget-image-enable
 205            (display-images-p)))
 206     (defsubst tree-widget-create-image (type file &optional props)
 207       "Create an image of type TYPE from FILE, and return it.
 208 Give the image the specified properties PROPS."
 209       (apply 'create-image `(,file ,type nil ,@props)))
 210     (defsubst tree-widget-image-formats ()
 211       "Return the alist of image formats/file name extensions.
 212 See also the option `widget-image-file-name-suffixes'."
 213       (delq nil
 214             (mapcar
 215              #'(lambda (fmt)
 216                  (and (image-type-available-p (car fmt)) fmt))
 217              widget-image-conversion)))
 218     ))
 219   )
 220
 221 ;; Buffer local cache of theme data.
 222 (defvar tree-widget--theme nil)
 223
 224 (defsubst tree-widget-theme-name ()
 225   "Return the current theme name, or nil if no theme is active."
 226   (and tree-widget--theme (aref tree-widget--theme 0)))
 227
 228 (defsubst tree-widget-set-theme (&optional name)
 229   "In the current buffer, set the theme to use for images.
 230 The current buffer must be where the tree widget is drawn.
 231 Optional argument NAME is the name of the theme to use.  It defaults
 232 to the value of the variable `tree-widget-theme'.
 233 Does nothing if NAME is already the current theme."
 234   (or name (setq name (or tree-widget-theme "default")))
 235   (unless (string-equal name (tree-widget-theme-name))
 236     (set (make-local-variable 'tree-widget--theme)
 237          (make-vector 4 nil))
 238     (aset tree-widget--theme 0 name)))
 239
 240 (defun tree-widget-themes-directory ()
 241   "Locate the directory where to search for a theme.
 242 It is defined in variable `tree-widget-themes-directory'.
 243 Return the absolute name of the directory found, or nil if the
 244 specified directory is not accessible."
 245   (let ((found (aref tree-widget--theme 1)))
 246     (if found
 247         ;; The directory is available in the cache.
 248         (unless (eq found 'void) found)
 249       (cond
 250        ;; Use the directory where tree-widget is located.
 251        ((null tree-widget-themes-directory)
 252         (setq found (locate-library "tree-widget"))
 253         (when found
 254           (setq found (file-name-directory found))
 255           (or (file-accessible-directory-p found)
 256               (setq found nil))))
 257        ;; Check accessibility of absolute directory name.
 258        ((file-name-absolute-p tree-widget-themes-directory)
 259         (setq found (expand-file-name tree-widget-themes-directory))
 260         (or (file-accessible-directory-p found)
 261             (setq found nil)))
 262        ;; Locate a sub-directory in `load-path' and data directory.
 263        (t
 264         (let ((path
 265                (append load-path
 266                        (list (if (fboundp 'locate-data-directory)
 267                                  ;; XEmacs
 268                                  (locate-data-directory "tree-widget")
 269                                ;; Emacs
 270                                data-directory)))))
 271           (while (and path (not found))
 272             (when (car path)
 273               (setq found (expand-file-name
 274                            tree-widget-themes-directory (car path)))
 275               (or (file-accessible-directory-p found)
 276                   (setq found nil)))
 277             (setq path (cdr path))))))
 278       ;; Store the result in the cache for later use.
 279       (aset tree-widget--theme 1 (or found 'void))
 280       found)))
 281
 282 (defsubst tree-widget-set-image-properties (props)
 283   "In current theme, set images properties to PROPS."
 284   (aset tree-widget--theme 2 props))
 285
 286 (defun tree-widget-image-properties (file)
 287   "Return the properties of an image in current theme.
 288 FILE is the absolute file name of an image.
 289
 290 If there is a \"tree-widget-theme-setup\" library in the theme
 291 directory, where is located FILE, load it to setup theme images
 292 properties.  Typically it should contain something like this:
 293
 294   (tree-widget-set-image-properties
 295    (if (featurep 'xemacs)
 296        '(:ascent center)
 297      '(:ascent center :mask (heuristic t))
 298      ))
 299
 300 Default global properties are provided for respectively Emacs and
 301 XEmacs in the variables `tree-widget-image-properties-emacs', and
 302 `tree-widget-image-properties-xemacs'."
 303   ;; If properties are in the cache, use them.
 304   (let ((plist (aref tree-widget--theme 2)))
 305     (unless plist
 306       ;; Load tree-widget-theme-setup if available.
 307       (load (expand-file-name "tree-widget-theme-setup"
 308                               (file-name-directory file)) t t)
 309       ;; If properties have been setup, use them.
 310       (unless (setq plist (aref tree-widget--theme 2))
 311         ;; By default, use supplied global properties.
 312         (setq plist (if (featurep 'xemacs)
 313                         tree-widget-image-properties-xemacs
 314                       tree-widget-image-properties-emacs))
 315         ;; Setup the cache.
 316         (tree-widget-set-image-properties plist)))
 317     plist))
 318
 319 (defconst tree-widget--cursors
 320   ;; Pointer shapes when the mouse pointer is over tree-widget images.
 321   ;; This feature works since Emacs 22, and ignored on older versions,
 322   ;; and XEmacs.
 323   '(
 324     ("open"      . hand )
 325     ("close"     . hand )
 326     ("empty"     . arrow)
 327     ("leaf"      . arrow)
 328     ("guide"     . arrow)
 329     ("no-guide"  . arrow)
 330     ("end-guide" . arrow)
 331     ("handle"    . arrow)
 332     ("no-handle" . arrow)
 333     ))
 334
 335 (defun tree-widget-lookup-image (name)
 336   "Look up in current theme for an image with NAME.
 337 Search first in current theme, then in default theme (see also the
 338 variable `tree-widget-theme').
 339 Return the first image found having a supported format, or nil if not
 340 found."
 341   (let ((default-directory (tree-widget-themes-directory)))
 342     (when default-directory
 343       (let (file (theme (tree-widget-theme-name)))
 344         (catch 'found
 345           (dolist (dir (if (string-equal theme "default")
 346                            '("default") (list theme "default")))
 347             (dolist (fmt (tree-widget-image-formats))
 348               (dolist (ext (cdr fmt))
 349                 (setq file (expand-file-name (concat name ext) dir))
 350                 (and
 351                  (file-readable-p file)
 352                  (file-regular-p file)
 353                  (throw
 354                   'found
 355                   (tree-widget-create-image
 356                    (car fmt) file
 357                    ;; Add the pointer shape
 358                    (cons :pointer
 359                          (cons
 360                           (cdr (assoc name tree-widget--cursors))
 361                           (tree-widget-image-properties file)))))))))
 362           nil)))))
 363
 364 (defun tree-widget-find-image (name)
 365   "Find the image with NAME in current theme.
 366 NAME is an image file name sans extension.
 367 Return the image found, or nil if not found."
 368   (when (tree-widget-use-image-p)
 369     ;; Ensure there is an active theme.
 370     (tree-widget-set-theme (tree-widget-theme-name))
 371     (let ((image (assoc name (aref tree-widget--theme 3))))
 372       ;; The image NAME is found in the cache.
 373       (if image
 374           (cdr image)
 375         ;; Search the image in current, and default themes.
 376         (prog1
 377             (setq image (tree-widget-lookup-image name))
 378           ;; Store image reference in the cache for later use.
 379           (push (cons name image) (aref tree-widget--theme 3))))
 380       )))
 381 \f
 382 ;;; Widgets
 383 ;;
 384 (defvar tree-widget-button-keymap
 385   (let ((km (make-sparse-keymap)))
 386     (if (boundp 'widget-button-keymap)
 387         ;; XEmacs
 388         (progn
 389           (set-keymap-parent km widget-button-keymap)
 390           (define-key km [button1] 'widget-button-click))
 391       ;; Emacs
 392       (set-keymap-parent km widget-keymap)
 393       (define-key km [down-mouse-1] 'widget-button-click))
 394     km)
 395   "Keymap used inside node buttons.
 396 Handle mouse button 1 click on buttons.")
 397
 398 (define-widget 'tree-widget-control 'push-button
 399   "Basic widget other tree-widget node buttons are derived from."
 400   :format        "%[%t%]"
 401   :button-keymap tree-widget-button-keymap ; XEmacs
 402   :keymap        tree-widget-button-keymap ; Emacs
 403   )
 404
 405 (define-widget 'tree-widget-open-control 'tree-widget-control
 406   "Button for an expanded tree-widget node."
 407   :tag       "[-] "
 408   ;;:tag-glyph (tree-widget-find-image "open")
 409   :notify    'tree-widget-close-node
 410   :help-echo "Collapse node"
 411   )
 412
 413 (define-widget 'tree-widget-empty-control 'tree-widget-open-control
 414   "Button for an expanded tree-widget node with no child."
 415   :tag       "[X] "
 416   ;;:tag-glyph (tree-widget-find-image "empty")
 417   )
 418
 419 (define-widget 'tree-widget-close-control 'tree-widget-control
 420   "Button for a collapsed tree-widget node."
 421   :tag       "[+] "
 422   ;;:tag-glyph (tree-widget-find-image "close")
 423   :notify    'tree-widget-open-node
 424   :help-echo "Expand node"
 425   )
 426
 427 (define-widget 'tree-widget-leaf-control 'item
 428   "Representation of a tree-widget leaf node."
 429   :tag       " " ;; Need at least one char to display the image :-(
 430   ;;:tag-glyph (tree-widget-find-image "leaf")
 431   :format    "%t"
 432   )
 433
 434 (define-widget 'tree-widget-guide 'item
 435   "Vertical guide line."
 436   :tag       " |"
 437   ;;:tag-glyph (tree-widget-find-image "guide")
 438   :format    "%t"
 439   )
 440
 441 (define-widget 'tree-widget-end-guide 'item
 442   "End of a vertical guide line."
 443   :tag       " `"
 444   ;;:tag-glyph (tree-widget-find-image "end-guide")
 445   :format    "%t"
 446   )
 447
 448 (define-widget 'tree-widget-no-guide 'item
 449   "Invisible vertical guide line."
 450   :tag       "  "
 451   ;;:tag-glyph (tree-widget-find-image "no-guide")
 452   :format    "%t"
 453   )
 454
 455 (define-widget 'tree-widget-handle 'item
 456   "Horizontal guide line that joins a vertical guide line to a node."
 457   :tag       " "
 458   ;;:tag-glyph (tree-widget-find-image "handle")
 459   :format    "%t"
 460   )
 461
 462 (define-widget 'tree-widget-no-handle 'item
 463   "Invisible handle."
 464   :tag       " "
 465   ;;:tag-glyph (tree-widget-find-image "no-handle")
 466   :format    "%t"
 467   )
 468
 469 (define-widget 'tree-widget 'default
 470   "Tree widget."
 471   :format         "%v"
 472   :convert-widget 'widget-types-convert-widget
 473   :value-get      'widget-value-value-get
 474   :value-delete   'widget-children-value-delete
 475   :value-create   'tree-widget-value-create
 476   :open-control   'tree-widget-open-control
 477   :close-control  'tree-widget-close-control
 478   :empty-control  'tree-widget-empty-control
 479   :leaf-control   'tree-widget-leaf-control
 480   :guide          'tree-widget-guide
 481   :end-guide      'tree-widget-end-guide
 482   :no-guide       'tree-widget-no-guide
 483   :handle         'tree-widget-handle
 484   :no-handle      'tree-widget-no-handle
 485   )
 486 \f
 487 ;;; Widget support functions
 488 ;;
 489 (defun tree-widget-p (widget)
 490   "Return non-nil if WIDGET is a tree-widget."
 491   (let ((type (widget-type widget)))
 492     (while (and type (not (eq type 'tree-widget)))
 493       (setq type (widget-type (get type 'widget-type))))
 494     (eq type 'tree-widget)))
 495
 496 (defun tree-widget-node (widget)
 497   "Return WIDGET's :node child widget.
 498 If not found, setup an `item' widget as default.
 499 Signal an error if the :node widget is a tree-widget.
 500 WIDGET is, or derives from, a tree-widget."
 501   (let ((node (widget-get widget :node)))
 502     (if node
 503         ;; Check that the :node widget is not a tree-widget.
 504         (and (tree-widget-p node)
 505              (error "Invalid tree-widget :node %S" node))
 506       ;; Setup an item widget as default :node.
 507       (setq node `(item :tag ,(or (widget-get widget :tag)
 508                                   (widget-princ-to-string
 509                                    (widget-value widget)))))
 510       (widget-put widget :node node))
 511     node))
 512
 513 (defun tree-widget-keep (arg widget)
 514   "Save in ARG the WIDGET's properties specified by :keep."
 515   (dolist (prop (widget-get widget :keep))
 516     (widget-put arg prop (widget-get widget prop))))
 517
 518 (defun tree-widget-children-value-save (widget &optional args node)
 519   "Save WIDGET children values.
 520 WIDGET is, or derives from, a tree-widget.
 521 Children properties and values are saved in ARGS if non-nil, else in
 522 WIDGET's :args property value.  Properties and values of the
 523 WIDGET's :node sub-widget are saved in NODE if non-nil, else in
 524 WIDGET's :node sub-widget."
 525   (let ((args (cons (or node (widget-get widget :node))
 526                     (or args (widget-get widget :args))))
 527         (children (widget-get widget :children))
 528         arg child)
 529     (while (and args children)
 530       (setq arg      (car args)
 531             args     (cdr args)
 532             child    (car children)
 533             children (cdr children))
 534        (if (tree-widget-p child)
 535 ;;;; The child is a tree node.
 536            (progn
 537              ;; Backtrack :args and :node properties.
 538              (widget-put arg :args (widget-get child :args))
 539              (widget-put arg :node (widget-get child :node))
 540              ;; Save :open property.
 541              (widget-put arg :open (widget-get child :open))
 542              ;; The node is open.
 543              (when (widget-get child :open)
 544                ;; Save the widget value.
 545                (widget-put arg :value (widget-value child))
 546                ;; Save properties specified in :keep.
 547                (tree-widget-keep arg child)
 548                ;; Save children.
 549                (tree-widget-children-value-save
 550                 child (widget-get arg :args) (widget-get arg :node))))
 551 ;;;; Another non tree node.
 552          ;; Save the widget value.
 553          (widget-put arg :value (widget-value child))
 554          ;; Save properties specified in :keep.
 555          (tree-widget-keep arg child)))))
 556
 557 (defvar tree-widget-after-toggle-functions nil
 558   "Hooks run after toggling a tree-widget expansion.
 559 Each function will receive the tree-widget as its unique argument.
 560 This hook should be local in the buffer used to display widgets.")
 561
 562 (defun tree-widget-close-node (widget &rest ignore)
 563   "Collapse the tree-widget, parent of WIDGET.
 564 WIDGET is, or derives from, a tree-widget-open-control widget.
 565 IGNORE other arguments."
 566   (let ((tree (widget-get widget :parent)))
 567     ;; Before to collapse the node, save children values so next open
 568     ;; can recover them.
 569     (tree-widget-children-value-save tree)
 570     (widget-put tree :open nil)
 571     (widget-value-set tree nil)
 572     (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
 573
 574 (defun tree-widget-open-node (widget &rest ignore)
 575   "Expand the tree-widget, parent of WIDGET.
 576 WIDGET is, or derives from, a tree-widget-close-control widget.
 577 IGNORE other arguments."
 578   (let ((tree (widget-get widget :parent)))
 579     (widget-put tree :open t)
 580     (widget-value-set tree t)
 581     (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
 582
 583 (defun tree-widget-value-create (tree)
 584   "Create the TREE tree-widget."
 585   (let* ((node   (tree-widget-node tree))
 586          (flags  (widget-get tree :tree-widget--guide-flags))
 587          (indent (widget-get tree :indent))
 588          ;; Setup widget's image support.  Looking up for images, and
 589          ;; setting widgets' :tag-glyph is done here, to allow to
 590          ;; dynamically change the image theme.
 591          (widget-image-enable (tree-widget-use-image-p))     ; Emacs
 592          (widget-glyph-enable widget-image-enable)           ; XEmacs
 593          children buttons)
 594     (and indent (not (widget-get tree :parent))
 595          (insert-char ?\  indent))
 596     (if (widget-get tree :open)
 597 ;;;; Expanded node.
 598         (let ((args     (widget-get tree :args))
 599               (xpandr   (or (widget-get tree :expander)
 600                             (widget-get tree :dynargs)))
 601               (leaf     (widget-get tree :leaf-control))
 602               (guide    (widget-get tree :guide))
 603               (noguide  (widget-get tree :no-guide))
 604               (endguide (widget-get tree :end-guide))
 605               (handle   (widget-get tree :handle))
 606               (nohandle (widget-get tree :no-handle))
 607               (leafi    (tree-widget-find-image "leaf"))
 608               (guidi    (tree-widget-find-image "guide"))
 609               (noguidi  (tree-widget-find-image "no-guide"))
 610               (endguidi (tree-widget-find-image "end-guide"))
 611               (handli   (tree-widget-find-image "handle"))
 612               (nohandli (tree-widget-find-image "no-handle"))
 613               child)
 614           ;; Request children at run time, when not already done.
 615           (when (and (not args) xpandr)
 616             (setq args (mapcar 'widget-convert (funcall xpandr tree)))
 617             (widget-put tree :args args))
 618           ;; Insert the node "open" button.
 619           (push (widget-create-child-and-convert
 620                  tree (widget-get
 621                        tree (if args :open-control :empty-control))
 622                  :tag-glyph (tree-widget-find-image
 623                              (if args "open" "empty")))
 624                 buttons)
 625           ;; Insert the :node element.
 626           (push (widget-create-child-and-convert tree node)
 627                 children)
 628           ;; Insert children.
 629           (while args
 630             (setq child (car args)
 631                   args  (cdr args))
 632             (and indent (insert-char ?\  indent))
 633             ;; Insert guide lines elements from previous levels.
 634             (dolist (f (reverse flags))
 635               (widget-create-child-and-convert
 636                tree (if f guide noguide)
 637                :tag-glyph (if f guidi noguidi))
 638               (widget-create-child-and-convert
 639                tree nohandle :tag-glyph nohandli))
 640             ;; Insert guide line element for this level.
 641             (widget-create-child-and-convert
 642              tree (if args guide endguide)
 643              :tag-glyph (if args guidi endguidi))
 644             ;; Insert the node handle line
 645             (widget-create-child-and-convert
 646              tree handle :tag-glyph handli)
 647             ;; If leaf node, insert a leaf node button.
 648             (unless (tree-widget-p child)
 649               (push (widget-create-child-and-convert
 650                      tree leaf :tag-glyph leafi)
 651                     buttons))
 652             ;; Finally, insert the child widget.
 653             (push (widget-create-child-and-convert
 654                    tree child
 655                    :tree-widget--guide-flags (cons (if args t) flags))
 656                   children)))
 657 ;;;; Collapsed node.
 658       ;; Insert the "closed" node button.
 659       (push (widget-create-child-and-convert
 660              tree (widget-get tree :close-control)
 661              :tag-glyph (tree-widget-find-image "close"))
 662             buttons)
 663       ;; Insert the :node element.
 664       (push (widget-create-child-and-convert tree node)
 665             children))
 666     ;; Save widget children and buttons.  The :node child is the first
 667     ;; element in children.
 668     (widget-put tree :children (nreverse children))
 669     (widget-put tree :buttons  buttons)
 670     ))
 671
 672 (provide 'tree-widget)
 673
 674 ;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
 675 ;;; tree-widget.el ends here