diff lisp/tree-widget.el @ 55588:55e4f0e50320

New file.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/tree-widget.el	Fri May 14 10:03:23 2004 +0000
@@ -0,0 +1,735 @@
+;;; tree-widget.el --- Tree widget
+
+;; Copyright (C) 2004 Free Software Foundation, Inc.
+
+;; Author: David Ponce <[e-mail]>
+;; Maintainer: David Ponce <[e-mail]>
+;; Created: 16 Feb 2001
+;; Keywords: extensions
+
+;; This file is part of GNU Emacs
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This library provide a tree widget useful to display data
+;; structures organized in a hierarchical order.
+;;
+;; The following properties are specific to the tree widget:
+;;
+;;   :open
+;;      Set to non-nil to unfold the tree.  By default the tree is
+;;      folded.
+;;
+;;   :node
+;;      Specify the widget used to represent a tree node.  By default
+;;      this is an `item' widget which displays the tree-widget :tag
+;;      property value if defined or a string representation of the
+;;      tree-widget value.
+;;
+;;   :keep
+;;      Specify a list of properties to keep when the tree is
+;;      folded so they can be recovered when the tree is unfolded.
+;;      This property can be used in child widgets too.
+;;
+;;   :dynargs
+;;      Specify a function to be called when the tree is unfolded, to
+;;      dynamically provide the tree children in response to an unfold
+;;      request.  This function will be passed the tree widget and
+;;      must return a list of child widgets.  That list will be stored
+;;      as the :args property of the parent tree.
+
+;;      To speed up successive unfold requests, the :dynargs function
+;;      can directly return the :args value if non-nil.  Refreshing
+;;      child values can be achieved by giving the :args property the
+;;      value nil, then redrawing the tree.
+;;
+;;   :has-children
+;;      Specify if this tree has children.  This property has meaning
+;;      only when used with the above :dynargs one.  It indicates that
+;;      child widgets exist but will be dynamically provided when
+;;      unfolding the node.
+;;
+;;   :open-control  (default `tree-widget-open-control')
+;;   :close-control (default `tree-widget-close-control')
+;;   :empty-control (default `tree-widget-empty-control')
+;;   :leaf-control  (default `tree-widget-leaf-control')
+;;   :guide         (default `tree-widget-guide')
+;;   :end-guide     (default `tree-widget-end-guide')
+;;   :no-guide      (default `tree-widget-no-guide')
+;;   :handle        (default `tree-widget-handle')
+;;   :no-handle     (default `tree-widget-no-handle')
+;;
+;; The above nine properties define the widgets used to draw the tree.
+;; For example, using widgets that display this values:
+;;
+;;   open-control     "[-] "
+;;   close-control    "[+] "
+;;   empty-control    "[X] "
+;;   leaf-control     "[>] "
+;;   guide            " |"
+;;   noguide          "  "
+;;   end-guide        " `"
+;;   handle           "-"
+;;   no-handle        " "
+;;
+;; A tree will look like this:
+;;
+;;   [-] 1            open-control
+;;    |-[+] 1.0       guide+handle+close-control
+;;    |-[X] 1.1       guide+handle+empty-control
+;;    `-[-] 1.2       end-guide+handle+open-control
+;;       |-[>] 1.2.1  no-guide+no-handle+guide+handle+leaf-control
+;;       `-[>] 1.2.2  no-guide+no-handle+end-guide+handle+leaf-control
+;;
+;; By default, the tree widget try to use images instead of strings to
+;; draw a nice-looking tree.  See the `tree-widget-themes-directory'
+;; and `tree-widget-theme' options for more details.
+;;
+
+;;; History:
+;;
+
+;;; Code:
+(eval-when-compile (require 'cl))
+(require 'wid-edit)
+
+;;; Customization
+;;
+(defgroup tree-widget nil
+  "Customization support for the Tree Widget Library."
+  :version "21.4"
+  :group 'widgets)
+
+(defcustom tree-widget-image-enable
+  (not (or (featurep 'xemacs) (< emacs-major-version 21)))
+  "*non-nil means that tree-widget will try to use images."
+  :type  'boolean
+  :group 'tree-widget)
+
+(defcustom tree-widget-themes-directory "tree-widget"
+  "*Name of the directory where to lookup for image themes.
+When nil use the directory where the tree-widget library is located.
+When a relative name is specified, try to locate that sub-directory in
+`load-path', then in the data directory, and use the first one found.
+Default is to search for a  \"tree-widget\" sub-directory.
+
+The data directory is the value of:
+  - the variable `data-directory' on GNU Emacs;
+  - `(locate-data-directory \"tree-widget\")' on XEmacs."
+  :type '(choice (const :tag "Default" "tree-widget")
+                 (const :tag "With the library" nil)
+                 (directory :format "%{%t%}:\n%v"))
+  :group 'tree-widget)
+
+(defcustom tree-widget-theme nil
+  "*Name of the theme to use to lookup for images.
+The theme name must be a subdirectory in `tree-widget-themes-directory'.
+If nil use the \"default\" theme.
+When a image is not found in the current theme, the \"default\" theme
+is searched too.
+A complete theme should contain images with these file names:
+
+Name         Represents
+-----------  ------------------------------------------------
+open         opened node (for example an open folder)
+close        closed node (for example a close folder)
+empty        empty node (a node without children)
+leaf         leaf node (for example a document)
+guide        a vertical guide line
+no-guide     an invisible guide line
+end-guide    the end of a vertical guide line
+handle       an horizontal line drawn before a node control
+no-handle    an invisible handle
+-----------  ------------------------------------------------"
+  :type '(choice (const  :tag "Default" nil)
+                 (string :tag "Name"))
+  :group 'tree-widget)
+
+(defcustom tree-widget-image-properties-emacs
+  '(:ascent center :mask (heuristic t))
+  "*Properties of GNU Emacs images."
+  :type 'plist
+  :group 'tree-widget)
+
+(defcustom tree-widget-image-properties-xemacs
+  nil
+  "*Properties of XEmacs images."
+  :type 'plist
+  :group 'tree-widget)
+
+;;; Image support
+;;
+(eval-when-compile ;; GNU Emacs/XEmacs compatibility stuff
+  (cond
+   ;; XEmacs
+   ((featurep 'xemacs)
+    (defsubst tree-widget-use-image-p ()
+      "Return non-nil if image support is currently enabled."
+      (and tree-widget-image-enable
+           widget-glyph-enable
+           (console-on-window-system-p)))
+    (defsubst tree-widget-create-image (type file &optional props)
+      "Create an image of type TYPE from FILE.
+Give the image the specified properties PROPS.
+Return the new image."
+      (apply 'make-glyph `([,type :file ,file ,@props])))
+    (defsubst tree-widget-image-formats ()
+      "Return the list of image formats, file name suffixes associations.
+See also the option `widget-image-file-name-suffixes'."
+      (delq nil
+            (mapcar
+             #'(lambda (fmt)
+                 (and (valid-image-instantiator-format-p (car fmt)) fmt))
+             widget-image-file-name-suffixes)))
+    )
+   ;; GNU Emacs
+   (t
+    (defsubst tree-widget-use-image-p ()
+      "Return non-nil if image support is currently enabled."
+      (and tree-widget-image-enable
+           widget-image-enable
+           (display-images-p)))
+    (defsubst tree-widget-create-image (type file &optional props)
+      "Create an image of type TYPE from FILE.
+Give the image the specified properties PROPS.
+Return the new image."
+      (apply 'create-image `(,file ,type nil ,@props)))
+    (defsubst tree-widget-image-formats ()
+      "Return the list of image formats, file name suffixes associations.
+See also the option `widget-image-conversion'."
+      (delq nil
+            (mapcar
+             #'(lambda (fmt)
+                 (and (image-type-available-p (car fmt)) fmt))
+             widget-image-conversion)))
+    ))
+  )
+
+;; Buffer local cache of theme data.
+(defvar tree-widget--theme nil)
+
+(defsubst tree-widget-theme-name ()
+  "Return the current theme name, or nil if no theme is active."
+  (and tree-widget--theme (aref tree-widget--theme 0)))
+
+(defsubst tree-widget-set-theme (&optional name)
+  "In the current buffer, set the theme to use for images.
+The current buffer should be where the tree widget is drawn.
+Optional argument NAME is the name of the theme to use, which defaults
+to the value of the variable `tree-widget-theme'.
+Does nothing if NAME is the name of the current theme."
+  (or name (setq name (or tree-widget-theme "default")))
+  (unless (equal name (tree-widget-theme-name))
+    (set (make-local-variable 'tree-widget--theme)
+         (make-vector 4 nil))
+    (aset tree-widget--theme 0 name)))
+
+(defun tree-widget-themes-directory ()
+  "Locate the directory where to search for a theme.
+It is defined in variable `tree-widget-themes-directory'.
+Return the absolute name of the directory found, or nil if the
+specified directory is not accessible."
+  (let ((found (aref tree-widget--theme 1)))
+    (if found
+        ;; The directory is available in the cache.
+        (unless (eq found 'void) found)
+      (cond
+       ;; Use the directory where tree-widget is located.
+       ((null tree-widget-themes-directory)
+        (setq found (locate-library "tree-widget"))
+        (when found
+          (setq found (file-name-directory found))
+          (or (file-accessible-directory-p found)
+              (setq found nil))))
+       ;; Check accessibility of absolute directory name.
+       ((file-name-absolute-p tree-widget-themes-directory)
+        (setq found (expand-file-name tree-widget-themes-directory))
+        (or (file-accessible-directory-p found)
+            (setq found nil)))
+       ;; Locate a sub-directory in `load-path' and data directory.
+       (t
+        (let ((path
+               (append load-path
+                       ;; The data directory depends on which, GNU
+                       ;; Emacs or XEmacs, is running.
+                       (list (if (fboundp 'locate-data-directory)
+                                 (locate-data-directory "tree-widget")
+                               data-directory)))))
+          (while (and path (not found))
+            (when (car path)
+              (setq found (expand-file-name
+                           tree-widget-themes-directory (car path)))
+              (or (file-accessible-directory-p found)
+                  (setq found nil)))
+            (setq path (cdr path))))))
+      ;; Store the result in the cache for later use.
+      (aset tree-widget--theme 1 (or found 'void))
+      found)))
+
+(defsubst tree-widget-set-image-properties (props)
+  "In current theme, set images properties to PROPS."
+  (aset tree-widget--theme 2 props))
+
+(defun tree-widget-image-properties (file)
+  "Return properties of images in current theme.
+If the \"tree-widget-theme-setup.el\" file exists in the directory
+where is located the image FILE, load it to setup theme images
+properties.  Typically that file should contain something like this:
+
+  (tree-widget-set-image-properties
+   (if (featurep 'xemacs)
+       '(:ascent center)
+     '(:ascent center :mask (heuristic t))
+     ))
+
+By default, use the global properties provided in variables
+`tree-widget-image-properties-emacs' or
+`tree-widget-image-properties-xemacs'."
+  ;; If properties are in the cache, use them.
+  (or (aref tree-widget--theme 2)
+      (progn
+        ;; Load tree-widget-theme-setup if available.
+        (load (expand-file-name
+               "tree-widget-theme-setup"
+               (file-name-directory file)) t t)
+        ;; If properties have been setup, use them.
+        (or (aref tree-widget--theme 2)
+            ;; By default, use supplied global properties.
+            (tree-widget-set-image-properties
+             (if (featurep 'xemacs)
+                 tree-widget-image-properties-xemacs
+               tree-widget-image-properties-emacs))))))
+
+(defun tree-widget-find-image (name)
+  "Find the image with NAME in current theme.
+NAME is an image file name sans extension.
+Search first in current theme, then in default theme.
+A theme is a sub-directory of the root theme directory specified in
+variable `tree-widget-themes-directory'.
+Return the first image found having a supported format in those
+returned by the function `tree-widget-image-formats', or nil if not
+found."
+  (when (tree-widget-use-image-p)
+    ;; Ensure there is an active theme.
+    (tree-widget-set-theme (tree-widget-theme-name))
+    ;; If the image is in the cache, return it.
+    (or (cdr (assoc name (aref tree-widget--theme 3)))
+        ;; Search the image in the current, then default themes.
+        (let ((default-directory (tree-widget-themes-directory)))
+          (when default-directory
+            (let* ((theme (tree-widget-theme-name))
+                   (path (mapcar 'expand-file-name
+                                 (if (equal theme "default")
+                                     '("default")
+                                   (list theme "default"))))
+                   (formats (tree-widget-image-formats))
+                   (found
+                    (catch 'found
+                      (dolist (dir path)
+                        (dolist (fmt formats)
+                          (dolist (ext (cdr fmt))
+                            (let ((file (expand-file-name
+                                         (concat name ext) dir)))
+                              (and (file-readable-p file)
+                                   (file-regular-p file)
+                                   (throw 'found
+                                          (cons (car fmt) file)))))))
+                      nil)))
+              (when found
+                (let ((image
+                       (tree-widget-create-image
+                        (car found) (cdr found)
+                        (tree-widget-image-properties (cdr found)))))
+                  ;; Store image in the cache for later use.
+                  (push (cons name image) (aref tree-widget--theme 3))
+                  image))))))))
+
+;;; Widgets
+;;
+(defvar tree-widget-button-keymap
+  (let (parent-keymap mouse-button1 keymap)
+    (if (featurep 'xemacs)
+        (setq parent-keymap widget-button-keymap
+              mouse-button1 [button1])
+      (setq parent-keymap widget-keymap
+            mouse-button1 [down-mouse-1]))
+    (setq keymap (copy-keymap parent-keymap))
+    (define-key keymap mouse-button1 'widget-button-click)
+    keymap)
+  "Keymap used inside node handle buttons.")
+
+(define-widget 'tree-widget-control 'push-button
+  "Base `tree-widget' control."
+  :format        "%[%t%]"
+  :button-keymap tree-widget-button-keymap ; XEmacs
+  :keymap        tree-widget-button-keymap ; Emacs
+  )
+
+(define-widget 'tree-widget-open-control 'tree-widget-control
+  "Control widget that represents a opened `tree-widget' node."
+  :tag       "[-] "
+  ;;:tag-glyph (tree-widget-find-image "open")
+  :notify    'tree-widget-close-node
+  :help-echo "Hide node"
+  )
+
+(define-widget 'tree-widget-empty-control 'tree-widget-open-control
+  "Control widget that represents an empty opened `tree-widget' node."
+  :tag       "[X] "
+  ;;:tag-glyph (tree-widget-find-image "empty")
+  )
+
+(define-widget 'tree-widget-close-control 'tree-widget-control
+  "Control widget that represents a closed `tree-widget' node."
+  :tag       "[+] "
+  ;;:tag-glyph (tree-widget-find-image "close")
+  :notify    'tree-widget-open-node
+  :help-echo "Show node"
+  )
+
+(define-widget 'tree-widget-leaf-control 'item
+  "Control widget that represents a leaf node."
+  :tag       " " ;; Need at least a char to display the image :-(
+  ;;:tag-glyph (tree-widget-find-image "leaf")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-guide 'item
+  "Widget that represents a guide line."
+  :tag       " |"
+  ;;:tag-glyph (tree-widget-find-image "guide")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-end-guide 'item
+  "Widget that represents the end of a guide line."
+  :tag       " `"
+  ;;:tag-glyph (tree-widget-find-image "end-guide")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-no-guide 'item
+  "Widget that represents an invisible guide line."
+  :tag       "  "
+  ;;:tag-glyph (tree-widget-find-image "no-guide")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-handle 'item
+  "Widget that represent a node handle."
+  :tag       " "
+  ;;:tag-glyph (tree-widget-find-image "handle")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget-no-handle 'item
+  "Widget that represent an invisible node handle."
+  :tag       " "
+  ;;:tag-glyph (tree-widget-find-image "no-handle")
+  :format    "%t"
+  )
+
+(define-widget 'tree-widget 'default
+  "Tree widget."
+  :format         "%v"
+  :convert-widget 'widget-types-convert-widget
+  :value-get      'widget-value-value-get
+  :value-create   'tree-widget-value-create
+  :value-delete   'tree-widget-value-delete
+  )
+
+;;; Widget support functions
+;;
+(defun tree-widget-p (widget)
+  "Return non-nil if WIDGET is a `tree-widget' widget."
+  (let ((type (widget-type widget)))
+    (while (and type (not (eq type 'tree-widget)))
+      (setq type (widget-type (get type 'widget-type))))
+    (eq type 'tree-widget)))
+
+(defsubst tree-widget-get-super (widget property)
+  "Return WIDGET's inherited PROPERTY value."
+  (widget-get (get (widget-type (get (widget-type widget)
+                                     'widget-type))
+                   'widget-type)
+              property))
+
+(defsubst tree-widget-super-format-handler (widget escape)
+  "Call WIDGET's inherited format handler to process ESCAPE character."
+  (let ((handler (tree-widget-get-super widget :format-handler)))
+    (and handler (funcall handler widget escape))))
+
+(defun tree-widget-format-handler (widget escape)
+  "For WIDGET, signal that the %p format template is obsolete.
+Call WIDGET's inherited format handler to process other ESCAPE
+characters."
+  (if (eq escape ?p)
+      (message "The %%p format template is obsolete and ignored")
+    (tree-widget-super-format-handler widget escape)))
+(make-obsolete 'tree-widget-format-handler
+               'tree-widget-super-format-handler)
+
+(defsubst tree-widget-node (widget)
+  "Return the tree WIDGET :node value.
+If not found setup a default 'item' widget."
+  (let ((node (widget-get widget :node)))
+    (unless node
+      (setq node `(item :tag ,(or (widget-get widget :tag)
+                                  (widget-princ-to-string
+                                   (widget-value widget)))))
+      (widget-put widget :node node))
+    node))
+
+(defsubst tree-widget-open-control (widget)
+  "Return the opened node control specified in WIDGET."
+  (or (widget-get widget :open-control)
+      'tree-widget-open-control))
+
+(defsubst tree-widget-close-control (widget)
+  "Return the closed node control specified in WIDGET."
+  (or (widget-get widget :close-control)
+      'tree-widget-close-control))
+
+(defsubst tree-widget-empty-control (widget)
+  "Return the empty node control specified in WIDGET."
+  (or (widget-get widget :empty-control)
+      'tree-widget-empty-control))
+
+(defsubst tree-widget-leaf-control (widget)
+  "Return the leaf node control specified in WIDGET."
+  (or (widget-get widget :leaf-control)
+      'tree-widget-leaf-control))
+
+(defsubst tree-widget-guide (widget)
+  "Return the guide line widget specified in WIDGET."
+  (or (widget-get widget :guide)
+      'tree-widget-guide))
+
+(defsubst tree-widget-end-guide (widget)
+  "Return the end of guide line widget specified in WIDGET."
+  (or (widget-get widget :end-guide)
+      'tree-widget-end-guide))
+
+(defsubst tree-widget-no-guide (widget)
+  "Return the invisible guide line widget specified in WIDGET."
+  (or (widget-get widget :no-guide)
+      'tree-widget-no-guide))
+
+(defsubst tree-widget-handle (widget)
+  "Return the node handle line widget specified in WIDGET."
+  (or (widget-get widget :handle)
+      'tree-widget-handle))
+
+(defsubst tree-widget-no-handle (widget)
+  "Return the node invisible handle line widget specified in WIDGET."
+  (or (widget-get widget :no-handle)
+      'tree-widget-no-handle))
+
+(defun tree-widget-keep (arg widget)
+  "Save in ARG the WIDGET properties specified by :keep."
+  (dolist (prop (widget-get widget :keep))
+    (widget-put arg prop (widget-get widget prop))))
+
+(defun tree-widget-children-value-save (widget &optional args node)
+  "Save WIDGET children values.
+Children properties and values are saved in ARGS if non-nil else in
+WIDGET :args property value.  Data node properties and value are saved
+in NODE if non-nil else in WIDGET :node property value."
+  (let ((args       (or args (widget-get widget :args)))
+        (node       (or node (tree-widget-node widget)))
+        (children   (widget-get widget :children))
+        (node-child (widget-get widget :tree-widget--node))
+        arg child)
+    (while (and args children)
+      (setq arg      (car args)
+            args     (cdr args)
+            child    (car children)
+            children (cdr children))
+       (if (tree-widget-p child)
+;;;; The child is a tree node.
+           (progn
+             ;; Backtrack :args and :node properties.
+             (widget-put arg :args (widget-get child :args))
+             (widget-put arg :node (tree-widget-node child))
+             ;; Save :open property.
+             (widget-put arg :open (widget-get child :open))
+             ;; The node is open.
+             (when (widget-get child :open)
+               ;; Save the widget value.
+               (widget-put arg :value (widget-value child))
+               ;; Save properties specified in :keep.
+               (tree-widget-keep arg child)
+               ;; Save children.
+               (tree-widget-children-value-save
+                child (widget-get arg :args) (widget-get arg :node))))
+;;;; Another non tree node.
+         ;; Save the widget value
+         (widget-put arg :value (widget-value child))
+         ;; Save properties specified in :keep.
+         (tree-widget-keep arg child)))
+    (when (and node node-child)
+      ;; Assume that the node child widget is not a tree!
+      ;; Save the node child widget value.
+      (widget-put node :value (widget-value node-child))
+      ;; Save the node child properties specified in :keep.
+      (tree-widget-keep node node-child))
+    ))
+
+(defvar tree-widget-after-toggle-functions nil
+  "Hooks run after toggling a `tree-widget' folding.
+Each function will receive the `tree-widget' as its unique argument.
+This variable should be local to each buffer used to display
+widgets.")
+
+(defun tree-widget-close-node (widget &rest ignore)
+  "Close the `tree-widget' node associated to this control WIDGET.
+WIDGET's parent should be a `tree-widget'.
+IGNORE other arguments."
+  (let ((tree (widget-get widget :parent)))
+    ;; Before folding the node up, save children values so next open
+    ;; can recover them.
+    (tree-widget-children-value-save tree)
+    (widget-put tree :open nil)
+    (widget-value-set tree nil)
+    (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
+
+(defun tree-widget-open-node (widget &rest ignore)
+  "Open the `tree-widget' node associated to this control WIDGET.
+WIDGET's parent should be a `tree-widget'.
+IGNORE other arguments."
+  (let ((tree (widget-get widget :parent)))
+    (widget-put tree :open t)
+    (widget-value-set tree t)
+    (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
+
+(defun tree-widget-value-delete (widget)
+  "Delete tree WIDGET children."
+  ;; Delete children
+  (widget-children-value-delete widget)
+  ;; Delete node child
+  (widget-delete (widget-get widget :tree-widget--node))
+  (widget-put widget :tree-widget--node nil))
+
+(defun tree-widget-value-create (tree)
+  "Create the TREE widget."
+  (let* ((widget-image-enable (tree-widget-use-image-p))     ; Emacs
+         (widget-glyph-enable widget-image-enable)           ; XEmacs
+         (node (tree-widget-node tree))
+         children buttons)
+    (if (widget-get tree :open)
+;;;; Unfolded node.
+        (let* ((args     (widget-get tree :args))
+               (dynargs  (widget-get tree :dynargs))
+               (flags    (widget-get tree :tree-widget--guide-flags))
+               (rflags   (reverse flags))
+               (guide    (tree-widget-guide     tree))
+               (noguide  (tree-widget-no-guide  tree))
+               (endguide (tree-widget-end-guide tree))
+               (handle   (tree-widget-handle    tree))
+               (nohandle (tree-widget-no-handle tree))
+               ;; Lookup for images and set widgets' tag-glyphs here,
+               ;; to allow to dynamically change the image theme.
+               (guidi    (tree-widget-find-image "guide"))
+               (noguidi  (tree-widget-find-image "no-guide"))
+               (endguidi (tree-widget-find-image "end-guide"))
+               (handli   (tree-widget-find-image "handle"))
+               (nohandli (tree-widget-find-image "no-handle"))
+               child)
+          (when dynargs
+            ;; Request the definition of dynamic children
+            (setq dynargs (funcall dynargs tree))
+            ;; Unless children have changed, reuse the widgets
+            (unless (eq args dynargs)
+              (setq args (mapcar 'widget-convert dynargs))
+              (widget-put tree :args args)))
+          ;; Insert the node control
+          (push (widget-create-child-and-convert
+                 tree (if args (tree-widget-open-control tree)
+                        (tree-widget-empty-control tree))
+                 :tag-glyph (tree-widget-find-image
+                             (if args "open" "empty")))
+                buttons)
+          ;; Insert the node element
+          (widget-put tree :tree-widget--node
+                      (widget-create-child-and-convert tree node))
+          ;; Insert children
+          (while args
+            (setq child (car args)
+                  args  (cdr args))
+            ;; Insert guide lines elements
+            (dolist (f rflags)
+              (widget-create-child-and-convert
+               tree (if f guide noguide)
+               :tag-glyph (if f guidi noguidi))
+              (widget-create-child-and-convert
+               tree nohandle :tag-glyph nohandli)
+              )
+            (widget-create-child-and-convert
+             tree (if args guide endguide)
+             :tag-glyph (if args guidi endguidi))
+            ;; Insert the node handle line
+            (widget-create-child-and-convert
+             tree handle :tag-glyph handli)
+            ;; If leaf node, insert a leaf node control
+            (unless (tree-widget-p child)
+              (push (widget-create-child-and-convert
+                     tree (tree-widget-leaf-control tree)
+                     :tag-glyph (tree-widget-find-image "leaf"))
+                    buttons))
+            ;; Insert the child element
+            (push (widget-create-child-and-convert
+                   tree child
+                   :tree-widget--guide-flags (cons (if args t) flags))
+                  children)))
+;;;; Folded node.
+      ;; Insert the closed node control
+      (push (widget-create-child-and-convert
+             tree (tree-widget-close-control tree)
+             :tag-glyph (tree-widget-find-image "close"))
+            buttons)
+      ;; Insert the node element
+      (widget-put tree :tree-widget--node
+                  (widget-create-child-and-convert tree node)))
+    ;; Save widget children and buttons
+    (widget-put tree :children (nreverse children))
+    (widget-put tree :buttons  buttons)
+    ))
+
+;;; Utilities
+;;
+(defun tree-widget-map (widget fun)
+  "For each WIDGET displayed child call function FUN.
+FUN is called with three arguments like this:
+
+ (FUN CHILD IS-NODE WIDGET)
+
+where:
+- - CHILD is the child widget.
+- - IS-NODE is non-nil if CHILD is WIDGET node widget."
+  (when (widget-get widget :tree-widget--node)
+    (funcall fun (widget-get widget :tree-widget--node) t widget)
+    (dolist (child (widget-get widget :children))
+      (if (tree-widget-p child)
+          ;; The child is a tree node.
+          (tree-widget-map child fun)
+        ;; Another non tree node.
+        (funcall fun child nil widget)))))
+
+(provide 'tree-widget)
+
+;;; tree-widget.el ends here