Lines Matching defs:tree
0 ;;; tree-widget.el --- Tree widget
29 ;; This library provide a tree widget useful to display data
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.
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
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
54 ;; stored in the :args property of the tree widget.
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'
72 ;; representation of the tree. The :tag value must be a string
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')
84 ;; tree guide lines. The :tag property value is used when drawing
85 ;; the text representation of the tree. The graphic look and feel
88 ;; the variable `tree-widget-theme').
102 ;; The text representation of a tree looks like this:
112 ;; nice-looking tree. See the `tree-widget-image-enable',
113 ;; `tree-widget-themes-directory', and `tree-widget-theme' options for
126 (defgroup tree-widget nil
131 (defcustom tree-widget-image-enable
133 "*Non-nil means that tree-widget will try to use images."
135 :group 'tree-widget)
137 (defvar tree-widget-themes-load-path
140 (locate-data-directory "tree-widget") ;; XEmacs
151 Emacs, and what `(locate-data-directory \"tree-widget\")' returns on
154 (defcustom tree-widget-themes-directory "tree-widget"
156 When nil use the directory where the tree-widget library is located.
158 directory in the path specified by `tree-widget-themes-load-path'.
159 The default is to use the \"tree-widget\" relative name."
160 :type '(choice (const :tag "Default" "tree-widget")
163 :group 'tree-widget)
165 (defcustom tree-widget-theme nil
168 `tree-widget-themes-directory' option.
173 with a supported extension (see also `tree-widget-image-formats'):
187 icon widgets used to draw the tree. By default these images are used:
190 Icon associated to an expanded tree.
192 Icon associated to a collapsed tree.
194 Icon associated to an expanded tree with no child.
199 :group 'tree-widget)
201 (defcustom tree-widget-image-properties-emacs
205 :group 'tree-widget)
207 (defcustom tree-widget-image-properties-xemacs
211 :group 'tree-widget)
213 (defcustom tree-widget-space-width 0.5
216 :group 'tree-widget
226 (defsubst tree-widget-use-image-p ()
228 (and tree-widget-image-enable
231 (defsubst tree-widget-create-image (type file &optional props)
235 (defsubst tree-widget-image-formats ()
246 (defsubst tree-widget-use-image-p ()
248 (and tree-widget-image-enable
251 (defsubst tree-widget-create-image (type file &optional props)
255 (defsubst tree-widget-image-formats ()
267 (defvar tree-widget--theme nil)
269 (defsubst tree-widget-theme-name ()
271 (and tree-widget--theme (car (aref tree-widget--theme 0))))
273 (defsubst tree-widget-set-parent-theme (name)
276 (unless (member name (aref tree-widget--theme 0))
277 (aset tree-widget--theme 0
278 (append (aref tree-widget--theme 0) (list name)))
282 (dolist (dir (tree-widget-themes-path))
287 "tree-widget-theme-setup" dir) t)))))))
289 (defun tree-widget-set-theme (&optional name)
291 The current buffer must be where the tree widget is drawn.
293 to the value of the variable `tree-widget-theme'.
296 If there is a \"tree-widget-theme-setup\" library in the theme
300 (tree-widget-set-parent-theme \"my-parent-theme\")
301 (tree-widget-set-image-properties
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)
326 (setq found (tree-widget--locate-sub-directory
329 (message "In tree-widget--locate-sub-directory: %s"
333 (defun tree-widget-themes-path ()
335 It is specified in variable `tree-widget-themes-directory'.
338 (let ((path (aref tree-widget--theme 1)))
345 ((null tree-widget-themes-directory)
346 (when (setq path (locate-library "tree-widget"))
351 (aset tree-widget--theme 1 (or path 'void))
354 ((file-name-absolute-p tree-widget-themes-directory)
355 (setq path (expand-file-name tree-widget-themes-directory))
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)))
367 (aset tree-widget--theme 1 (or path 'void))
370 (defconst tree-widget--cursors
372 ;; tree-widget images. This feature works since Emacs 22, and
382 (defsubst tree-widget-set-image-properties (props)
386 (or (aref tree-widget--theme 2)
387 (aset tree-widget--theme 2 props)))
389 (defsubst tree-widget-image-properties (name)
392 XEmacs in the variables `tree-widget-image-properties-emacs', and
393 `tree-widget-image-properties-xemacs'."
396 (cons (or (cdr (assoc name tree-widget--cursors)) 'hand)
397 (tree-widget-set-image-properties
399 tree-widget-image-properties-xemacs
400 tree-widget-image-properties-emacs)))))
402 (defun tree-widget-lookup-image (name)
405 function `tree-widget-set-parent-theme').
409 (dolist (default-directory (tree-widget-themes-path))
410 (dolist (dir (aref tree-widget--theme 0))
411 (dolist (fmt (tree-widget-image-formats))
417 (tree-widget-create-image
419 (tree-widget-image-properties name))))))))
422 (defun tree-widget-find-image (name)
426 (when (tree-widget-use-image-p)
428 (tree-widget-set-theme (tree-widget-theme-name))
429 (let ((image (assoc name (aref tree-widget--theme 3))))
435 (setq image (tree-widget-lookup-image name))
437 (push (cons name image) (aref tree-widget--theme 3))))
443 (defun tree-widget-button-click (event)
452 (defvar tree-widget-button-keymap
458 (define-key km [button1] 'tree-widget-button-click))
461 (define-key km [down-mouse-1] 'tree-widget-button-click))
466 (define-widget 'tree-widget-icon 'push-button
467 "Basic widget other tree-widget icons are derived from."
469 :button-keymap tree-widget-button-keymap ; XEmacs
470 :keymap tree-widget-button-keymap ; Emacs
471 :create 'tree-widget-icon-create
472 :action 'tree-widget-icon-action
473 :help-echo 'tree-widget-icon-help-echo
476 (define-widget 'tree-widget-open-icon 'tree-widget-icon
477 "Icon for an expanded tree-widget node."
482 (define-widget 'tree-widget-empty-icon 'tree-widget-icon
483 "Icon for an expanded tree-widget node with no child."
488 (define-widget 'tree-widget-close-icon 'tree-widget-icon
489 "Icon for a collapsed tree-widget node."
494 (define-widget 'tree-widget-leaf-icon 'tree-widget-icon
495 "Icon for a tree-widget leaf node."
501 (define-widget 'tree-widget-guide 'item
504 ;;:tag-glyph (tree-widget-find-image "guide")
508 (define-widget 'tree-widget-end-guide 'item
511 ;;:tag-glyph (tree-widget-find-image "end-guide")
515 (define-widget 'tree-widget-no-guide 'item
518 ;;:tag-glyph (tree-widget-find-image "no-guide")
522 (define-widget 'tree-widget-handle 'item
525 ;;:tag-glyph (tree-widget-find-image "handle")
529 (define-widget 'tree-widget-no-handle 'item
532 ;;:tag-glyph (tree-widget-find-image "no-handle")
536 (define-widget 'tree-widget 'default
539 :convert-widget 'tree-widget-convert-widget
542 :value-create 'tree-widget-value-create
543 :action 'tree-widget-action
544 :help-echo 'tree-widget-help-echo
545 :expander-p 'tree-widget-expander-p
546 :open-icon 'tree-widget-open-icon
547 :close-icon 'tree-widget-close-icon
548 :empty-icon 'tree-widget-empty-icon
549 :leaf-icon 'tree-widget-leaf-icon
550 :guide 'tree-widget-guide
551 :end-guide 'tree-widget-end-guide
552 :no-guide 'tree-widget-no-guide
553 :handle 'tree-widget-handle
554 :no-handle 'tree-widget-no-handle
560 (defun tree-widget-p (widget)
561 "Return non-nil if WIDGET is a tree-widget."
563 (while (and type (not (eq type 'tree-widget)))
565 (eq type 'tree-widget)))
567 (defun tree-widget-node (widget)
570 Signal an error if the :node widget is a tree-widget.
571 WIDGET is, or derives from, a tree-widget."
574 ;; Check that the :node widget is not a tree-widget.
575 (and (tree-widget-p node)
576 (error "Invalid tree-widget :node %S" node))
584 (defun tree-widget-keep (arg widget)
589 (defun tree-widget-children-value-save (widget &optional args node)
591 WIDGET is, or derives from, a tree-widget.
605 (if (tree-widget-p child)
606 ;;;; The child is a tree node.
618 (tree-widget-keep arg child)
620 (tree-widget-children-value-save
622 ;;;; Another non tree node.
626 (tree-widget-keep arg child)))))
631 (defvar tree-widget-before-create-icon-functions nil
632 "Hooks run before to create a tree-widget icon.
634 The value of the icon widget :node property is a tree :node widget or
638 and feel of the tree-widget by changing the values of the :tag
642 (defun tree-widget-icon-create (icon)
644 (run-hook-with-args 'tree-widget-before-create-icon-functions icon)
646 (tree-widget-find-image (widget-get icon :glyph-name)))
656 'display (list 'space :width tree-widget-space-width)))
658 (defun tree-widget-convert-widget (widget)
660 (let ((tree (widget-types-convert-widget widget)))
662 (widget-put tree :expander (or (widget-get tree :expander)
663 (widget-get tree :dynargs)))
664 tree))
666 (defun tree-widget-value-create (tree)
667 "Create the TREE tree-widget."
668 (let* ((node (tree-widget-node tree))
669 (flags (widget-get tree :tree-widget--guide-flags))
670 (indent (widget-get tree :indent))
674 (widget-image-enable (tree-widget-use-image-p)) ; Emacs
677 (and indent (not (widget-get tree :parent))
679 (if (widget-get tree :open)
681 (let ((args (widget-get tree :args))
682 (guide (widget-get tree :guide))
683 (noguide (widget-get tree :no-guide))
684 (endguide (widget-get tree :end-guide))
685 (handle (widget-get tree :handle))
686 (nohandle (widget-get tree :no-handle))
687 (guidi (tree-widget-find-image "guide"))
688 (noguidi (tree-widget-find-image "no-guide"))
689 (endguidi (tree-widget-find-image "end-guide"))
690 (handli (tree-widget-find-image "handle"))
691 (nohandli (tree-widget-find-image "no-handle")))
693 (when (and (widget-get tree :expander)
694 (widget-apply tree :expander-p))
696 (widget-apply tree :expander)))
697 (widget-put tree :args args))
699 (widget-put tree :node (widget-convert node))
700 ;; Create the icon widget for the expanded tree.
702 tree (widget-get tree (if args :open-icon :empty-icon))
704 :node (widget-get tree :node))
706 ;; Create the tree node widget.
707 (push (widget-create-child tree (widget-get tree :node))
711 ;; Create the tree children.
719 tree (if f guide noguide)
722 tree nohandle :tag-glyph nohandli))
725 tree (if args guide endguide)
729 tree handle :tag-glyph handli)
730 (if (tree-widget-p node)
731 ;; Create a sub-tree node.
733 tree node :tree-widget--guide-flags
738 tree (widget-get tree :leaf-icon)
741 node :tree-widget--guide-flags
743 :tree-widget--leaf-flag t)
746 (push (widget-create-child tree node) children)
751 (widget-put tree :node (widget-convert node))
752 ;; Create the icon widget for the collapsed tree.
754 tree (widget-get tree :close-icon)
756 :node (widget-get tree :node))
758 ;; Create the tree node widget.
759 (push (widget-create-child tree (widget-get tree :node))
763 ;; Save widget children and buttons. The tree-widget :node child
765 (widget-put tree :children (nreverse children))
766 (widget-put tree :buttons buttons)))
771 (defsubst tree-widget-leaf-node-icon-p (icon)
774 (widget-get icon :tree-widget--leaf-flag))
776 (defun tree-widget-icon-action (icon &optional event)
778 If ICON :node is a leaf node it handles the :action. The tree-widget
781 (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
785 (defun tree-widget-icon-help-echo (icon)
787 If ICON :node is a leaf node it handles the :help-echo. The tree-widget
789 (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon)
796 (defvar tree-widget-after-toggle-functions nil
797 "Hooks run after toggling a tree-widget expansion.
798 Each function is passed a tree-widget. If the value of the :open
799 property is non-nil the tree has been expanded, else collapsed.
802 (defun tree-widget-action (tree &optional event)
803 "Handle the :action of the TREE tree-widget.
804 That is, toggle expansion of the TREE tree-widget.
806 (let ((open (not (widget-get tree :open))))
810 (tree-widget-children-value-save tree))
811 (widget-put tree :open open)
812 (widget-value-set tree open)
813 (run-hook-with-args 'tree-widget-after-toggle-functions tree)))
815 (defun tree-widget-help-echo (tree)
816 "Return the help-echo string of the TREE tree-widget."
817 (if (widget-get tree :open)
821 (defun tree-widget-expander-p (tree)
822 "Return non-nil if the TREE tree-widget :expander has to be called.
824 (null (widget-get tree :args)))
826 (provide 'tree-widget)
829 ;;; tree-widget.el ends here