1 ;;; tree-widget.el --- Tree widget
3 ;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
5 ;; Author: David Ponce <david@dponce.com>
6 ;; Maintainer: David Ponce <david@dponce.com>
7 ;; Created: 16 Feb 2001
8 ;; Keywords: extensions
10 ;; This file is part of GNU Emacs
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.
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.
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.
29 ;; This library provide a tree widget useful to display data
30 ;; structures organized in a hierarchical order.
32 ;; The following properties are specific to the tree widget:
35 ;; Set to non-nil to expand the tree. By default the tree is
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.
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.
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. Child widgets returned by the :expander function are
54 ;; stored in the :args property of the tree widget.
57 ;; Specify a predicate which must return non-nil to indicate that
58 ;; the :expander function above has to be called. By default, to
59 ;; speed up successive expand requests, the :expander-p predicate
60 ;; return non-nil when the :args value is nil. So, by default, to
61 ;; refresh child values, it is necessary to set the :args property
62 ;; to nil, then redraw the tree.
64 ;; :open-icon (default `tree-widget-open-icon')
65 ;; :close-icon (default `tree-widget-close-icon')
66 ;; :empty-icon (default `tree-widget-empty-icon')
67 ;; :leaf-icon (default `tree-widget-leaf-icon')
68 ;; Those properties define the icon widgets associated to tree
69 ;; nodes. Icon widgets must derive from the `tree-widget-icon'
70 ;; widget. The :tag and :glyph-name property values are
71 ;; respectively used when drawing the text and graphic
72 ;; representation of the tree. The :tag value must be a string
73 ;; that represent a node icon, like "[+]" for example. The
74 ;; :glyph-name value must the name of an image found in the current
75 ;; theme, like "close" for example (see also the variable
76 ;; `tree-widget-theme').
78 ;; :guide (default `tree-widget-guide')
79 ;; :end-guide (default `tree-widget-end-guide')
80 ;; :no-guide (default `tree-widget-no-guide')
81 ;; :handle (default `tree-widget-handle')
82 ;; :no-handle (default `tree-widget-no-handle')
83 ;; Those properties define `item'-like widgets used to draw the
84 ;; tree guide lines. The :tag property value is used when drawing
85 ;; the text representation of the tree. The graphic look and feel
86 ;; is given by the images named "guide", "no-guide", "end-guide",
87 ;; "handle", and "no-handle" found in the current theme (see also
88 ;; the variable `tree-widget-theme').
90 ;; These are the default :tag values for icons, and guide lines:
102 ;; The text representation of a tree looks like this:
104 ;; [-] 1 (open-icon :node)
105 ;; |-[+] 1.0 (guide+handle+close-icon :node)
106 ;; |-[X] 1.1 (guide+handle+empty-icon :node)
107 ;; `-[-] 1.2 (end-guide+handle+open-icon :node)
108 ;; |- 1.2.1 (no-guide+no-handle+guide+handle+leaf-icon leaf)
109 ;; `- 1.2.2 (no-guide+no-handle+end-guide+handle+leaf-icon leaf)
111 ;; By default, images will be used instead of strings to draw a
112 ;; nice-looking tree. See the `tree-widget-image-enable',
113 ;; `tree-widget-themes-directory', and `tree-widget-theme' options for
120 (eval-when-compile (require 'cl))
125 (defgroup tree-widget nil
126 "Customization support for the Tree Widget library."
130 (defcustom tree-widget-image-enable
131 (not (or (featurep 'xemacs) (< emacs-major-version 21)))
132 "*Non-nil means that tree-widget will try to use images."
136 (defvar tree-widget-themes-load-path
138 (let ((dir (if (fboundp 'locate-data-directory)
139 (locate-data-directory "tree-widget") ;; XEmacs
141 (and dir (list dir (expand-file-name "images" dir))))
143 "List of locations where to search for the themes sub-directory.
144 Each element is an expression that will be evaluated to return a
145 single directory or a list of directories to search.
147 The default is to search in the `load-path' first, then in the
148 \"images\" sub directory in the data directory, then in the data
150 The data directory is the value of the variable `data-directory' on
151 Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
154 (defcustom tree-widget-themes-directory "tree-widget"
155 "*Name of the directory where to look up for image themes.
156 When nil use the directory where the tree-widget library is located.
157 When a relative name is specified, search in all occurrences of that
158 sub directory found in the locations specified in
159 `tree-widget-themes-load-path'.
160 The default is to use the \"tree-widget\" relative name."
161 :type '(choice (const :tag "Default" "tree-widget")
162 (const :tag "With the library" nil)
163 (directory :format "%{%t%}:\n%v"))
166 (defcustom tree-widget-theme nil
167 "*Name of the theme where to look up for images.
168 It must be a sub directory in the directories specified in variable
169 `tree-widget-themes-directory'. The default theme is \"default\".
170 When an image is not found in a theme, it is searched in the parent
173 A complete theme must at least contain images with these file names
174 with a supported extension (see also `tree-widget-image-formats'):
177 A vertical guide line.
179 An invisible vertical guide line.
181 End of a vertical guide line.
183 Horizontal guide line that joins the vertical guide line to an icon.
187 Plus images whose name is given by the :glyph-name property of the
188 icon widgets used to draw the tree. By default these images are used:
191 Icon associated to an expanded tree.
193 Icon associated to a collapsed tree.
195 Icon associated to an expanded tree with no child.
197 Icon associated to a leaf node."
198 :type '(choice (const :tag "Default" nil)
199 (string :tag "Name"))
202 (defcustom tree-widget-image-properties-emacs
203 '(:ascent center :mask (heuristic t))
204 "*Default properties of Emacs images."
208 (defcustom tree-widget-image-properties-xemacs
210 "*Default properties of XEmacs images."
214 (defcustom tree-widget-space-width 0.5
215 "Amount of space between an icon image and a node widget.
216 Must be a valid space :width display property."
222 (eval-and-compile ;; Emacs/XEmacs compatibility stuff
226 (defsubst tree-widget-use-image-p ()
227 "Return non-nil if image support is currently enabled."
228 (and tree-widget-image-enable
230 (console-on-window-system-p)))
231 (defsubst tree-widget-create-image (type file &optional props)
232 "Create an image of type TYPE from FILE, and return it.
233 Give the image the specified properties PROPS."
234 (apply 'make-glyph `([,type :file ,file ,@props])))
235 (defsubst tree-widget-image-formats ()
236 "Return the alist of image formats/file name extensions.
237 See also the option `widget-image-file-name-suffixes'."
241 (and (valid-image-instantiator-format-p (car fmt)) fmt))
242 widget-image-file-name-suffixes)))
246 (defsubst tree-widget-use-image-p ()
247 "Return non-nil if image support is currently enabled."
248 (and tree-widget-image-enable
251 (defsubst tree-widget-create-image (type file &optional props)
252 "Create an image of type TYPE from FILE, and return it.
253 Give the image the specified properties PROPS."
254 (apply 'create-image `(,file ,type nil ,@props)))
255 (defsubst tree-widget-image-formats ()
256 "Return the alist of image formats/file name extensions.
257 See also the option `widget-image-conversion'."
261 (and (image-type-available-p (car fmt)) fmt))
262 widget-image-conversion)))
266 ;; Buffer local cache of theme data.
267 (defvar tree-widget--theme nil)
269 (defsubst tree-widget-theme-name ()
270 "Return the current theme name, or nil if no theme is active."
271 (and tree-widget--theme (car (aref tree-widget--theme 0))))
273 (defsubst tree-widget-set-parent-theme (name)
274 "Set to NAME the parent theme of the current theme.
275 The default parent theme is the \"default\" theme."
276 (unless (member name (aref tree-widget--theme 0))
277 (aset tree-widget--theme 0
278 (append (aref tree-widget--theme 0) (list name)))
279 ;; Load the theme setup from the first directory where the theme
282 (dolist (dir (tree-widget-themes-path))
283 (setq dir (expand-file-name name dir))
284 (when (file-accessible-directory-p dir)
286 (load (expand-file-name
287 "tree-widget-theme-setup" dir) t)))))))
289 (defun tree-widget-set-theme (&optional name)
290 "In the current buffer, set the theme to use for images.
291 The current buffer must be where the tree widget is drawn.
292 Optional argument NAME is the name of the theme to use. It defaults
293 to the value of the variable `tree-widget-theme'.
294 Does nothing if NAME is already the current theme.
296 If there is a \"tree-widget-theme-setup\" library in the theme
297 directory, load it to setup a parent theme or the images properties.
298 Typically it should contain something like this:
300 (tree-widget-set-parent-theme \"my-parent-theme\")
301 (tree-widget-set-image-properties
302 (if (featurep 'xemacs)
304 '(:ascent center :mask (heuristic t))
306 (or name (setq name (or tree-widget-theme "default")))
307 (unless (string-equal name (tree-widget-theme-name))
308 (set (make-local-variable 'tree-widget--theme)
310 (tree-widget-set-parent-theme name)
311 (tree-widget-set-parent-theme "default")))
313 (defun tree-widget--locate-sub-directory (name path &optional found)
314 "Locate all occurrences of the sub-directory NAME in PATH.
315 Return a list of absolute directory names in reverse order, or nil if
319 (setq elt (eval elt))
322 (and (file-accessible-directory-p
323 (setq elt (expand-file-name name elt)))
326 (setq found (tree-widget--locate-sub-directory
327 name (if (atom elt) (list elt) elt) found)))))
329 (message "In tree-widget--locate-sub-directory: %s"
330 (error-message-string err))))
333 (defun tree-widget-themes-path ()
334 "Return the path where to search for a theme.
335 It is specified in variable `tree-widget-themes-directory'.
336 Return a list of absolute directory names, or nil when no directory
337 has been found accessible."
338 (let ((path (aref tree-widget--theme 1)))
340 ;; No directory was found.
341 ((eq path 'void) nil)
342 ;; The list of directories is available in the cache.
344 ;; Use the directory where this library is located.
345 ((null tree-widget-themes-directory)
346 (when (setq path (locate-library "tree-widget"))
347 (setq path (file-name-directory path))
348 (setq path (and (file-accessible-directory-p path)
350 ;; Store the result in the cache for later use.
351 (aset tree-widget--theme 1 (or path 'void))
353 ;; Check accessibility of absolute directory name.
354 ((file-name-absolute-p tree-widget-themes-directory)
355 (setq path (expand-file-name tree-widget-themes-directory))
356 (setq path (and (file-accessible-directory-p path)
358 ;; Store the result in the cache for later use.
359 (aset tree-widget--theme 1 (or path 'void))
361 ;; Locate a sub-directory in `tree-widget-themes-load-path'.
363 (setq path (nreverse (tree-widget--locate-sub-directory
364 tree-widget-themes-directory
365 tree-widget-themes-load-path)))
366 ;; Store the result in the cache for later use.
367 (aset tree-widget--theme 1 (or path 'void))
370 (defconst tree-widget--cursors
371 ;; Pointer shapes when the mouse pointer is over inactive
372 ;; tree-widget images. This feature works since Emacs 22, and
373 ;; ignored on older versions, and XEmacs.
377 ("end-guide" . arrow)
379 ("no-handle" . arrow)
382 (defsubst tree-widget-set-image-properties (props)
383 "In current theme, set images properties to PROPS.
384 Does nothing if images properties have already been set for that
386 (or (aref tree-widget--theme 2)
387 (aset tree-widget--theme 2 props)))
389 (defsubst tree-widget-image-properties (name)
390 "Return the properties of image NAME in current theme.
391 Default global properties are provided for respectively Emacs and
392 XEmacs in the variables `tree-widget-image-properties-emacs', and
393 `tree-widget-image-properties-xemacs'."
394 ;; Add the pointer shape
396 (cons (or (cdr (assoc name tree-widget--cursors)) 'hand)
397 (tree-widget-set-image-properties
398 (if (featurep 'xemacs)
399 tree-widget-image-properties-xemacs
400 tree-widget-image-properties-emacs)))))
402 (defun tree-widget-lookup-image (name)
403 "Look up in current theme for an image with NAME.
404 Search first in current theme, then in parent themes (see also the
405 function `tree-widget-set-parent-theme').
406 Return the first image found having a supported format, or nil if not
409 (dolist (default-directory (tree-widget-themes-path))
410 (dolist (dir (aref tree-widget--theme 0))
411 (dolist (fmt (tree-widget-image-formats))
412 (dolist (ext (cdr fmt))
413 (setq file (expand-file-name (concat name ext) dir))
414 (and (file-readable-p file)
415 (file-regular-p file)
417 (tree-widget-create-image
419 (tree-widget-image-properties name))))))))
422 (defun tree-widget-find-image (name)
423 "Find the image with NAME in current theme.
424 NAME is an image file name sans extension.
425 Return the image found, or nil if not found."
426 (when (tree-widget-use-image-p)
427 ;; Ensure there is an active theme.
428 (tree-widget-set-theme (tree-widget-theme-name))
429 (let ((image (assoc name (aref tree-widget--theme 3))))
430 ;; The image NAME is found in the cache.
433 ;; Search the image in current, and default themes.
435 (setq image (tree-widget-lookup-image name))
436 ;; Store image reference in the cache for later use.
437 (push (cons name image) (aref tree-widget--theme 3))))
442 (defun tree-widget-button-click (event)
443 "Move to the position clicked on, and if it is a button, invoke it.
444 EVENT is the mouse event received."
446 (mouse-set-point event)
447 (let ((pos (widget-event-point event)))
448 (if (get-char-property pos 'button)
449 (widget-button-click event))))
451 (defvar tree-widget-button-keymap
452 (let ((km (make-sparse-keymap)))
453 (if (boundp 'widget-button-keymap)
456 (set-keymap-parent km widget-button-keymap)
457 (define-key km [button1] 'tree-widget-button-click))
459 (set-keymap-parent km widget-keymap)
460 (define-key km [down-mouse-1] 'tree-widget-button-click))
462 "Keymap used inside node buttons.
463 Handle mouse button 1 click on buttons.")
465 (define-widget 'tree-widget-icon 'push-button
466 "Basic widget other tree-widget icons are derived from."
468 :button-keymap tree-widget-button-keymap ; XEmacs
469 :keymap tree-widget-button-keymap ; Emacs
470 :create 'tree-widget-icon-create
471 :action 'tree-widget-icon-action
472 :help-echo 'tree-widget-icon-help-echo
475 (define-widget 'tree-widget-open-icon 'tree-widget-icon
476 "Icon for an expanded tree-widget node."
481 (define-widget 'tree-widget-empty-icon 'tree-widget-icon
482 "Icon for an expanded tree-widget node with no child."
487 (define-widget 'tree-widget-close-icon 'tree-widget-icon
488 "Icon for a collapsed tree-widget node."
493 (define-widget 'tree-widget-leaf-icon 'tree-widget-icon
494 "Icon for a tree-widget leaf node."
497 :button-face 'default
500 (define-widget 'tree-widget-guide 'item
501 "Vertical guide line."
503 ;;:tag-glyph (tree-widget-find-image "guide")
507 (define-widget 'tree-widget-end-guide 'item
508 "End of a vertical guide line."
510 ;;:tag-glyph (tree-widget-find-image "end-guide")
514 (define-widget 'tree-widget-no-guide 'item
515 "Invisible vertical guide line."
517 ;;:tag-glyph (tree-widget-find-image "no-guide")
521 (define-widget 'tree-widget-handle 'item
522 "Horizontal guide line that joins a vertical guide line to a node."
524 ;;:tag-glyph (tree-widget-find-image "handle")
528 (define-widget 'tree-widget-no-handle 'item
531 ;;:tag-glyph (tree-widget-find-image "no-handle")
535 (define-widget 'tree-widget 'default
538 :convert-widget 'tree-widget-convert-widget
539 :value-get 'widget-value-value-get
540 :value-delete 'widget-children-value-delete
541 :value-create 'tree-widget-value-create
542 :action 'tree-widget-action
543 :help-echo 'tree-widget-help-echo
544 :expander-p 'tree-widget-expander-p
545 :open-icon 'tree-widget-open-icon
546 :close-icon 'tree-widget-close-icon
547 :empty-icon 'tree-widget-empty-icon
548 :leaf-icon 'tree-widget-leaf-icon
549 :guide 'tree-widget-guide
550 :end-guide 'tree-widget-end-guide
551 :no-guide 'tree-widget-no-guide
552 :handle 'tree-widget-handle
553 :no-handle 'tree-widget-no-handle
556 ;;; Widget support functions
558 (defun tree-widget-p (widget)
559 "Return non-nil if WIDGET is a tree-widget."
560 (let ((type (widget-type widget)))
561 (while (and type (not (eq type 'tree-widget)))
562 (setq type (widget-type (get type 'widget-type))))
563 (eq type 'tree-widget)))
565 (defun tree-widget-node (widget)
566 "Return WIDGET's :node child widget.
567 If not found, setup an `item' widget as default.
568 Signal an error if the :node widget is a tree-widget.
569 WIDGET is, or derives from, a tree-widget."
570 (let ((node (widget-get widget :node)))
572 ;; Check that the :node widget is not a tree-widget.
573 (and (tree-widget-p node)
574 (error "Invalid tree-widget :node %S" node))
575 ;; Setup an item widget as default :node.
576 (setq node `(item :tag ,(or (widget-get widget :tag)
577 (widget-princ-to-string
578 (widget-value widget)))))
579 (widget-put widget :node node))
582 (defun tree-widget-keep (arg widget)
583 "Save in ARG the WIDGET's properties specified by :keep."
584 (dolist (prop (widget-get widget :keep))
585 (widget-put arg prop (widget-get widget prop))))
587 (defun tree-widget-children-value-save (widget &optional args node)
588 "Save WIDGET children values.
589 WIDGET is, or derives from, a tree-widget.
590 Children properties and values are saved in ARGS if non-nil, else in
591 WIDGET's :args property value. Properties and values of the
592 WIDGET's :node sub-widget are saved in NODE if non-nil, else in
593 WIDGET's :node sub-widget."
594 (let ((args (cons (or node (widget-get widget :node))
595 (or args (widget-get widget :args))))
596 (children (widget-get widget :children))
598 (while (and args children)
602 children (cdr children))
603 (if (tree-widget-p child)
604 ;;;; The child is a tree node.
606 ;; Backtrack :args and :node properties.
607 (widget-put arg :args (widget-get child :args))
608 (widget-put arg :node (widget-get child :node))
609 ;; Save :open property.
610 (widget-put arg :open (widget-get child :open))
612 (when (widget-get child :open)
613 ;; Save the widget value.
614 (widget-put arg :value (widget-value child))
615 ;; Save properties specified in :keep.
616 (tree-widget-keep arg child)
618 (tree-widget-children-value-save
619 child (widget-get arg :args) (widget-get arg :node))))
620 ;;;; Another non tree node.
621 ;; Save the widget value.
622 (widget-put arg :value (widget-value child))
623 ;; Save properties specified in :keep.
624 (tree-widget-keep arg child)))))
628 (defvar tree-widget-before-create-icon-functions nil
629 "Hooks run before to create a tree-widget icon.
630 Each function is passed the icon widget not yet created.
631 The value of the icon widget :node property is a tree :node widget or
632 a leaf node widget, not yet created.
633 This hook can be used to dynamically change properties of the icon and
634 associated node widgets. For example, to dynamically change the look
635 and feel of the tree-widget by changing the values of the :tag
636 and :glyph-name properties of the icon widget.
637 This hook should be local in the buffer setup to display widgets.")
639 (defun tree-widget-icon-create (icon)
640 "Create the ICON widget."
641 (run-hook-with-args 'tree-widget-before-create-icon-functions icon)
642 (widget-put icon :tag-glyph
643 (tree-widget-find-image (widget-get icon :glyph-name)))
644 ;; Ensure there is at least one char to display the image.
645 (and (widget-get icon :tag-glyph)
646 (equal "" (or (widget-get icon :tag) ""))
647 (widget-put icon :tag " "))
648 (widget-default-create icon)
649 ;; Insert space between the icon and the node widget.
653 'display (list 'space :width tree-widget-space-width)))
655 (defun tree-widget-convert-widget (widget)
656 "Convert :args as widget types in WIDGET."
657 (let ((tree (widget-types-convert-widget widget)))
659 (widget-put tree :expander (or (widget-get tree :expander)
660 (widget-get tree :dynargs)))
663 (defun tree-widget-value-create (tree)
664 "Create the TREE tree-widget."
665 (let* ((node (tree-widget-node tree))
666 (flags (widget-get tree :tree-widget--guide-flags))
667 (indent (widget-get tree :indent))
668 ;; Setup widget's image support. Looking up for images, and
669 ;; setting widgets' :tag-glyph is done here, to allow to
670 ;; dynamically change the image theme.
671 (widget-image-enable (tree-widget-use-image-p)) ; Emacs
672 (widget-glyph-enable widget-image-enable) ; XEmacs
674 (and indent (not (widget-get tree :parent))
675 (insert-char ?\ indent))
676 (if (widget-get tree :open)
678 (let ((args (widget-get tree :args))
679 (guide (widget-get tree :guide))
680 (noguide (widget-get tree :no-guide))
681 (endguide (widget-get tree :end-guide))
682 (handle (widget-get tree :handle))
683 (nohandle (widget-get tree :no-handle))
684 (guidi (tree-widget-find-image "guide"))
685 (noguidi (tree-widget-find-image "no-guide"))
686 (endguidi (tree-widget-find-image "end-guide"))
687 (handli (tree-widget-find-image "handle"))
688 (nohandli (tree-widget-find-image "no-handle")))
689 ;; Request children at run time, when requested.
690 (when (and (widget-get tree :expander)
691 (widget-apply tree :expander-p))
692 (setq args (mapcar 'widget-convert
693 (widget-apply tree :expander)))
694 (widget-put tree :args args))
695 ;; Defer the node widget creation after icon creation.
696 (widget-put tree :node (widget-convert node))
697 ;; Create the icon widget for the expanded tree.
698 (push (widget-create-child-and-convert
699 tree (widget-get tree (if args :open-icon :empty-icon))
700 ;; Pass the node widget to child.
701 :node (widget-get tree :node))
703 ;; Create the tree node widget.
704 (push (widget-create-child tree (widget-get tree :node))
706 ;; Update the icon :node with the created node widget.
707 (widget-put (car buttons) :node (car children))
708 ;; Create the tree children.
710 (setq node (car args)
712 (and indent (insert-char ?\ indent))
713 ;; Insert guide lines elements from previous levels.
714 (dolist (f (reverse flags))
715 (widget-create-child-and-convert
716 tree (if f guide noguide)
717 :tag-glyph (if f guidi noguidi))
718 (widget-create-child-and-convert
719 tree nohandle :tag-glyph nohandli))
720 ;; Insert guide line element for this level.
721 (widget-create-child-and-convert
722 tree (if args guide endguide)
723 :tag-glyph (if args guidi endguidi))
724 ;; Insert the node handle line
725 (widget-create-child-and-convert
726 tree handle :tag-glyph handli)
727 (if (tree-widget-p node)
728 ;; Create a sub-tree node.
729 (push (widget-create-child-and-convert
730 tree node :tree-widget--guide-flags
731 (cons (if args t) flags))
733 ;; Create the icon widget for a leaf node.
734 (push (widget-create-child-and-convert
735 tree (widget-get tree :leaf-icon)
736 ;; At this point the node widget isn't yet created.
737 :node (setq node (widget-convert
738 node :tree-widget--guide-flags
739 (cons (if args t) flags)))
740 :tree-widget--leaf-flag t)
742 ;; Create the leaf node widget.
743 (push (widget-create-child tree node) children)
744 ;; Update the icon :node with the created node widget.
745 (widget-put (car buttons) :node (car children)))))
747 ;; Defer the node widget creation after icon creation.
748 (widget-put tree :node (widget-convert node))
749 ;; Create the icon widget for the collapsed tree.
750 (push (widget-create-child-and-convert
751 tree (widget-get tree :close-icon)
752 ;; Pass the node widget to child.
753 :node (widget-get tree :node))
755 ;; Create the tree node widget.
756 (push (widget-create-child tree (widget-get tree :node))
758 ;; Update the icon :node with the created node widget.
759 (widget-put (car buttons) :node (car children)))
760 ;; Save widget children and buttons. The tree-widget :node child
761 ;; is the first element in :children.
762 (widget-put tree :children (nreverse children))
763 (widget-put tree :buttons buttons)))
767 (defsubst tree-widget-leaf-node-icon-p (icon)
768 "Return non-nil if ICON is a leaf node icon.
769 That is, if its :node property value is a leaf node widget."
770 (widget-get icon :tree-widget--leaf-flag))
772 (defun tree-widget-icon-action (icon &optional event)
773 "Handle the ICON widget :action.
774 If ICON :node is a leaf node it handles the :action. The tree-widget
775 parent of ICON handles the :action otherwise.
776 Pass the received EVENT to :action."
777 (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
779 (widget-apply node :action event)))
781 (defun tree-widget-icon-help-echo (icon)
782 "Return the help-echo string of ICON.
783 If ICON :node is a leaf node it handles the :help-echo. The tree-widget
784 parent of ICON handles the :help-echo otherwise."
785 (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
787 (help-echo (widget-get node :help-echo)))
788 (if (functionp help-echo)
789 (funcall help-echo node)
792 (defvar tree-widget-after-toggle-functions nil
793 "Hooks run after toggling a tree-widget expansion.
794 Each function is passed a tree-widget. If the value of the :open
795 property is non-nil the tree has been expanded, else collapsed.
796 This hook should be local in the buffer setup to display widgets.")
798 (defun tree-widget-action (tree &optional event)
799 "Handle the :action of the TREE tree-widget.
800 That is, toggle expansion of the TREE tree-widget.
801 Ignore the EVENT argument."
802 (let ((open (not (widget-get tree :open))))
804 ;; Before to collapse the node, save children values so next
805 ;; open can recover them.
806 (tree-widget-children-value-save tree))
807 (widget-put tree :open open)
808 (widget-value-set tree open)
809 (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
811 (defun tree-widget-help-echo (tree)
812 "Return the help-echo string of the TREE tree-widget."
813 (if (widget-get tree :open)
817 (defun tree-widget-expander-p (tree)
818 "Return non-nil if the TREE tree-widget :expander has to be called.
819 That is, if TREE :args is nil."
820 (null (widget-get tree :args)))
822 (provide 'tree-widget)
824 ;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8
825 ;;; tree-widget.el ends here