Mercurial > emacs

--- a/lisp/tree-widget.el	Mon Jul 04 12:31:54 2005 +0000
+++ b/lisp/tree-widget.el	Mon Jul 04 12:33:21 2005 +0000
@@ -31,75 +31,70 @@
 ;;
 ;; The following properties are specific to the tree widget:
 ;;
-;;   :open
-;;      Set to non-nil to unfold the tree.  By default the tree is
-;;      folded.
+;; :open
+;;    Set to non-nil to expand the tree.  By default the tree is
+;;    collapsed.
 ;;
-;;   :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.
+;; :node
+;;    Specify the widget used to represent the value of 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.
 ;;
-;;   :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.
+;; :keep
+;;    Specify a list of properties to keep when the tree is collapsed
+;;    so they can be recovered when the tree is expanded.  This
+;;    property can be used in child widgets too.
 ;;
-;;   :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.
+;; :expander (obsoletes :dynargs)
+;;    Specify a function to be called to dynamically provide the
+;;    tree's children in response to an expand request.  This function
+;;    will be passed the tree widget and must return a list of child
+;;    widgets.
+;;
+;;    *Please note:* Child widgets returned by the :expander function
+;;    are stored in the :args property of the tree widget.  To speed
+;;    up successive expand requests, the :expander function is not
+;;    called again when the :args value is non-nil.  To refresh child
+;;    values, it is necessary to set the :args property to nil, then
+;;    redraw the tree.
 ;;
-;;   :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  (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')
+;;    Those properties define the widgets used to draw the tree, and
+;;    permit to customize its look and feel.  For example, using
+;;    `item' widgets with these :tag values:
 ;;
-;;   open-control     "[-] "
-;;   close-control    "[+] "
-;;   empty-control    "[X] "
-;;   leaf-control     "[>] "
-;;   guide            " |"
-;;   noguide          "  "
-;;   end-guide        " `"
-;;   handle           "-"
-;;   no-handle        " "
+;;    open-control     "[-] "      (OC)
+;;    close-control    "[+] "      (CC)
+;;    empty-control    "[X] "      (EC)
+;;    leaf-control     "[>] "      (LC)
+;;    guide            " |"        (GU)
+;;    noguide          "  "        (NG)
+;;    end-guide        " `"        (EG)
+;;    handle           "-"         (HA)
+;;    no-handle        " "         (NH)
 ;;
-;; A tree will look like this:
+;;    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
+;;    [-] 1                        (OC :node)
+;;     |-[+] 1.0                   (GU+HA+CC :node)
+;;     |-[X] 1.1                   (GU+HA+EC :node)
+;;     `-[-] 1.2                   (EG+HA+OC :node)
+;;        |-[>] 1.2.1              (NG+NH+GU+HA+LC child)
+;;        `-[>] 1.2.2              (NG+NH+EG+HA+LC child)
 ;;
-;; 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.
-;;
+;; By default, images will be used instead of strings to draw a
+;; nice-looking tree.  See the `tree-widget-image-enable',
+;; `tree-widget-themes-directory', and `tree-widget-theme' options for
+;; more details.

 ;;; History:
 ;;
@@ -111,70 +106,75 @@
 ;;; Customization
 ;;
 (defgroup tree-widget nil
-  "Customization support for the Tree Widget Library."
+  "Customization support for the Tree Widget library."
   :version "22.1"
   :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."
+  "*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.
+  "*Name of the directory where to look up 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
+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."
+The data directory is the value of the variable `data-directory' on
+Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
+XEmacs.
+The default is to use the \"tree-widget\" relative name."
   :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 of the theme where to look up for images.
+It must be a sub directory of the directory specified in variable
+`tree-widget-themes-directory'.  The default is \"default\".  When an
+image is not found in this theme, the default theme is searched too.
+A complete theme must contain images with these file names with a
+supported extension (see also `tree-widget-image-formats'):

-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
------------  ------------------------------------------------"
+\"open\"
+  Represent an expanded node.
+\"close\"
+  Represent a collapsed node.
+\"empty\"
+  Represent an expanded node with no child.
+\"leaf\"
+  Represent a leaf node.
+\"guide\"
+  A vertical guide line.
+\"no-guide\"
+  An invisible vertical guide line.
+\"end-guide\"
+  End of a vertical guide line.
+\"handle\"
+  Horizontal guide line that joins the vertical guide line to a node.
+\"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."
+  "*Default properties of Emacs images."
   :type 'plist
   :group 'tree-widget)

 (defcustom tree-widget-image-properties-xemacs
   nil
-  "*Properties of XEmacs images."
+  "*Default properties of XEmacs images."
   :type 'plist
   :group 'tree-widget)

 ;;; Image support
 ;;
-(eval-and-compile ;; GNU Emacs/XEmacs compatibility stuff
+(eval-and-compile ;; Emacs/XEmacs compatibility stuff
   (cond
    ;; XEmacs
    ((featurep 'xemacs)
@@ -184,12 +184,11 @@
            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."
+      "Create an image of type TYPE from FILE, and return it.
+Give the image the specified properties PROPS."
       (apply 'make-glyph `([,type :file ,file ,@props])))
     (defsubst tree-widget-image-formats ()
-      "Return the list of image formats, file name suffixes associations.
+      "Return the alist of image formats/file name extensions.
 See also the option `widget-image-file-name-suffixes'."
       (delq nil
             (mapcar
@@ -197,7 +196,7 @@
                  (and (valid-image-instantiator-format-p (car fmt)) fmt))
              widget-image-file-name-suffixes)))
     )
-   ;; GNU Emacs
+   ;; Emacs
    (t
     (defsubst tree-widget-use-image-p ()
       "Return non-nil if image support is currently enabled."
@@ -205,13 +204,12 @@
            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."
+      "Create an image of type TYPE from FILE, and return it.
+Give the image the specified properties PROPS."
       (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'."
+      "Return the alist of image formats/file name extensions.
+See also the option `widget-image-file-name-suffixes'."
       (delq nil
             (mapcar
              #'(lambda (fmt)
@@ -229,12 +227,12 @@

 (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
+The current buffer must be where the tree widget is drawn.
+Optional argument NAME is the name of the theme to use.  It defaults
 to the value of the variable `tree-widget-theme'.
-Does nothing if NAME is the name of the current theme."
+Does nothing if NAME is already the current theme."
   (or name (setq name (or tree-widget-theme "default")))
-  (unless (equal name (tree-widget-theme-name))
+  (unless (string-equal name (tree-widget-theme-name))
     (set (make-local-variable 'tree-widget--theme)
          (make-vector 4 nil))
     (aset tree-widget--theme 0 name)))
@@ -265,10 +263,10 @@
        (t
         (let ((path
                (append load-path
-                       ;; The data directory depends on which, GNU
-                       ;; Emacs or XEmacs, is running.
                        (list (if (fboundp 'locate-data-directory)
+                                 ;; XEmacs
                                  (locate-data-directory "tree-widget")
+                               ;; Emacs
                                data-directory)))))
           (while (and path (not found))
             (when (car path)
@@ -286,10 +284,12 @@
   (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:
+  "Return the properties of an image in current theme.
+FILE is the absolute file name of an image.
+
+If there is a \"tree-widget-theme-setup\" library in the theme
+directory, where is located FILE, load it to setup theme images
+properties.  Typically it should contain something like this:

   (tree-widget-set-image-properties
    (if (featurep 'xemacs)
@@ -297,148 +297,170 @@
      '(:ascent center :mask (heuristic t))
      ))

-By default, use the global properties provided in variables
-`tree-widget-image-properties-emacs' or
+Default global properties are provided for respectively Emacs and
+XEmacs in the variables `tree-widget-image-properties-emacs', and
 `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))))))
+  (let ((plist (aref tree-widget--theme 2)))
+    (unless plist
+      ;; 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.
+      (unless (setq plist (aref tree-widget--theme 2))
+        ;; By default, use supplied global properties.
+        (setq plist (if (featurep 'xemacs)
+                        tree-widget-image-properties-xemacs
+                      tree-widget-image-properties-emacs))
+        ;; Setup the cache.
+        (tree-widget-set-image-properties plist)))
+    plist))
+
+(defconst tree-widget--cursors
+  ;; Pointer shapes when the mouse pointer is over tree-widget images.
+  ;; This feature works since Emacs 22, and ignored on older versions,
+  ;; and XEmacs.
+  '(
+    ("open"      . hand )
+    ("close"     . hand )
+    ("empty"     . arrow)
+    ("leaf"      . arrow)
+    ("guide"     . arrow)
+    ("no-guide"  . arrow)
+    ("end-guide" . arrow)
+    ("handle"    . arrow)
+    ("no-handle" . arrow)
+    ))
+
+(defun tree-widget-lookup-image (name)
+  "Look up in current theme for an image with NAME.
+Search first in current theme, then in default theme (see also the
+variable `tree-widget-theme').
+Return the first image found having a supported format, or nil if not
+found."
+  (let ((default-directory (tree-widget-themes-directory)))
+    (when default-directory
+      (let (file (theme (tree-widget-theme-name)))
+        (catch 'found
+          (dolist (dir (if (string-equal theme "default")
+                           '("default") (list theme "default")))
+            (dolist (fmt (tree-widget-image-formats))
+              (dolist (ext (cdr fmt))
+                (setq file (expand-file-name (concat name ext) dir))
+                (and
+                 (file-readable-p file)
+                 (file-regular-p file)
+                 (throw
+                  'found
+                  (tree-widget-create-image
+                   (car fmt) file
+                   ;; Add the pointer shape
+                   (cons :pointer
+                         (cons
+                          (cdr (assoc name tree-widget--cursors))
+                          (tree-widget-image-properties file)))))))))
+          nil)))))

 (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."
+Return the image found, 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))))))))
+    (let ((image (assoc name (aref tree-widget--theme 3))))
+      ;; The image NAME is found in the cache.
+      (if image
+          (cdr image)
+        ;; Search the image in current, and default themes.
+        (prog1
+            (setq image (tree-widget-lookup-image name))
+          ;; Store image reference in the cache for later use.
+          (push (cons name image) (aref tree-widget--theme 3))))
+      )))

 ;;; 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.")
+  (let ((km (make-sparse-keymap)))
+    (if (boundp 'widget-button-keymap)
+        ;; XEmacs
+        (progn
+          (set-keymap-parent km widget-button-keymap)
+          (define-key km [button1] 'widget-button-click))
+      ;; Emacs
+      (set-keymap-parent km widget-keymap)
+      (define-key km [down-mouse-1] 'widget-button-click))
+    km)
+  "Keymap used inside node buttons.
+Handle mouse button 1 click on buttons.")

 (define-widget 'tree-widget-control 'push-button
-  "Base `tree-widget' control."
+  "Basic widget other tree-widget node buttons are derived from."
   :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."
+  "Button for an expanded tree-widget node."
   :tag       "[-] "
   ;;:tag-glyph (tree-widget-find-image "open")
   :notify    'tree-widget-close-node
-  :help-echo "Hide node"
+  :help-echo "Collapse node"
   )

 (define-widget 'tree-widget-empty-control 'tree-widget-open-control
-  "Control widget that represents an empty opened `tree-widget' node."
+  "Button for an expanded tree-widget node with no child."
   :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."
+  "Button for a collapsed tree-widget node."
   :tag       "[+] "
   ;;:tag-glyph (tree-widget-find-image "close")
   :notify    'tree-widget-open-node
-  :help-echo "Show node"
+  :help-echo "Expand 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 :-(
+  "Representation of a tree-widget leaf node."
+  :tag       " " ;; Need at least one 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."
+  "Vertical 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."
+  "End of a vertical 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."
+  "Invisible vertical 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."
+  "Horizontal guide line that joins a vertical guide line to a node."
   :tag       " "
   ;;:tag-glyph (tree-widget-find-image "handle")
   :format    "%t"
   )

 (define-widget 'tree-widget-no-handle 'item
-  "Widget that represent an invisible node handle."
+  "Invisible handle."
   :tag       " "
   ;;:tag-glyph (tree-widget-find-image "no-handle")
   :format    "%t"
@@ -449,96 +471,60 @@
   :format         "%v"
   :convert-widget 'widget-types-convert-widget
   :value-get      'widget-value-value-get
+  :value-delete   'widget-children-value-delete
   :value-create   'tree-widget-value-create
-  :value-delete   'tree-widget-value-delete
+  :open-control   'tree-widget-open-control
+  :close-control  'tree-widget-close-control
+  :empty-control  'tree-widget-empty-control
+  :leaf-control   'tree-widget-leaf-control
+  :guide          'tree-widget-guide
+  :end-guide      'tree-widget-end-guide
+  :no-guide       'tree-widget-no-guide
+  :handle         'tree-widget-handle
+  :no-handle      'tree-widget-no-handle
   )

 ;;; Widget support functions
 ;;
 (defun tree-widget-p (widget)
-  "Return non-nil if WIDGET is a `tree-widget' widget."
+  "Return non-nil if WIDGET is a tree-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-node (widget)
-  "Return the tree WIDGET :node value.
-If not found setup a default 'item' widget."
+(defun tree-widget-node (widget)
+  "Return WIDGET's :node child widget.
+If not found, setup an `item' widget as default.
+Signal an error if the :node widget is a tree-widget.
+WIDGET is, or derives from, a tree-widget."
   (let ((node (widget-get widget :node)))
-    (unless node
+    (if node
+        ;; Check that the :node widget is not a tree-widget.
+        (and (tree-widget-p node)
+             (error "Invalid tree-widget :node %S" node))
+      ;; Setup an item widget as default :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."
+  "Save in ARG the WIDGET's 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))
+WIDGET is, or derives from, a tree-widget.
+Children properties and values are saved in ARGS if non-nil, else in
+WIDGET's :args property value.  Properties and values of the
+WIDGET's :node sub-widget are saved in NODE if non-nil, else in
+WIDGET's :node sub-widget."
+  (let ((args (cons (or node (widget-get widget :node))
+                    (or args (widget-get widget :args))))
+        (children (widget-get widget :children))
         arg child)
     (while (and args children)
       (setq arg      (car args)
@@ -550,7 +536,7 @@
            (progn
              ;; Backtrack :args and :node properties.
              (widget-put arg :args (widget-get child :args))
-             (widget-put arg :node (tree-widget-node child))
+             (widget-put arg :node (widget-get child :node))
              ;; Save :open property.
              (widget-put arg :open (widget-get child :open))
              ;; The node is open.
@@ -563,30 +549,22 @@
                (tree-widget-children-value-save
                 child (widget-get arg :args) (widget-get arg :node))))
 ;;;; Another non tree node.
-         ;; Save the widget value
+         ;; 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))
-    ))
+         (tree-widget-keep arg 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.")
+  "Hooks run after toggling a tree-widget expansion.
+Each function will receive the tree-widget as its unique argument.
+This hook should be local in the 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'.
+  "Collapse the tree-widget, parent of WIDGET.
+WIDGET is, or derives from, a tree-widget-open-control widget.
 IGNORE other arguments."
   (let ((tree (widget-get widget :parent)))
-    ;; Before folding the node up, save children values so next open
+    ;; Before to collapse the node, save children values so next open
     ;; can recover them.
     (tree-widget-children-value-save tree)
     (widget-put tree :open nil)
@@ -594,131 +572,104 @@
     (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'.
+  "Expand the tree-widget, parent of WIDGET.
+WIDGET is, or derives from, a tree-widget-close-control 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
+  "Create the TREE tree-widget."
+  (let* ((node   (tree-widget-node tree))
+         (flags  (widget-get tree :tree-widget--guide-flags))
+         (indent (widget-get tree :indent))
+         ;; Setup widget's image support.  Looking up for images, and
+         ;; setting widgets' :tag-glyph is done here, to allow to
+         ;; dynamically change the image theme.
+         (widget-image-enable (tree-widget-use-image-p))     ; Emacs
          (widget-glyph-enable widget-image-enable)           ; XEmacs
-         (node (tree-widget-node tree))
-         (flags (widget-get tree :tree-widget--guide-flags))
-         (indent (widget-get tree :indent))
          children buttons)
     (and indent (not (widget-get tree :parent))
          (insert-char ?\  indent))
     (if (widget-get tree :open)
-;;;; Unfolded node.
+;;;; Expanded node.
         (let ((args     (widget-get tree :args))
-              (dynargs  (widget-get tree :dynargs))
-              (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.
+              (xpandr   (or (widget-get tree :expander)
+                            (widget-get tree :dynargs)))
+              (leaf     (widget-get tree :leaf-control))
+              (guide    (widget-get tree :guide))
+              (noguide  (widget-get tree :no-guide))
+              (endguide (widget-get tree :end-guide))
+              (handle   (widget-get tree :handle))
+              (nohandle (widget-get tree :no-handle))
+              (leafi    (tree-widget-find-image "leaf"))
               (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
+          ;; Request children at run time, when not already done.
+          (when (and (not args) xpandr)
+            (setq args (mapcar 'widget-convert (funcall xpandr tree)))
+            (widget-put tree :args args))
+          ;; Insert the node "open" button.
           (push (widget-create-child-and-convert
-                 tree (if args (tree-widget-open-control tree)
-                        (tree-widget-empty-control tree))
+                 tree (widget-get
+                       tree (if args :open-control :empty-control))
                  :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
+          ;; Insert the :node element.
+          (push (widget-create-child-and-convert tree node)
+                children)
+          ;; Insert children.
           (while args
             (setq child (car args)
                   args  (cdr args))
             (and indent (insert-char ?\  indent))
-            ;; Insert guide lines elements
+            ;; Insert guide lines elements from previous levels.
             (dolist (f (reverse flags))
               (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)
-              )
+               tree nohandle :tag-glyph nohandli))
+            ;; Insert guide line element for this level.
             (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
+            ;; If leaf node, insert a leaf node button.
             (unless (tree-widget-p child)
               (push (widget-create-child-and-convert
-                     tree (tree-widget-leaf-control tree)
-                     :tag-glyph (tree-widget-find-image "leaf"))
+                     tree leaf :tag-glyph leafi)
                     buttons))
-            ;; Insert the child element
+            ;; Finally, insert the child widget.
             (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
+;;;; Collapsed node.
+      ;; Insert the "closed" node button.
       (push (widget-create-child-and-convert
-             tree (tree-widget-close-control tree)
+             tree (widget-get tree :close-control)
              :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
+      ;; Insert the :node element.
+      (push (widget-create-child-and-convert tree node)
+            children))
+    ;; Save widget children and buttons.  The :node child is the first
+    ;; element in children.
     (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)

-;;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
+;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
 ;;; tree-widget.el ends here