59 |
;; values, it is necessary to set the :args property to nil, then |
;; values, it is necessary to set the :args property to nil, then |
60 |
;; redraw the tree. |
;; redraw the tree. |
61 |
;; |
;; |
62 |
;; :open-control (default `tree-widget-open-control') |
;; :open-icon (default `tree-widget-open-icon') |
63 |
;; :close-control (default `tree-widget-close-control') |
;; :close-icon (default `tree-widget-close-icon') |
64 |
;; :empty-control (default `tree-widget-empty-control') |
;; :empty-icon (default `tree-widget-empty-icon') |
65 |
;; :leaf-control (default `tree-widget-leaf-control') |
;; :leaf-icon (default `tree-widget-leaf-icon') |
66 |
;; :guide (default `tree-widget-guide') |
;; Those properties define the icon widgets associated to tree |
67 |
;; :end-guide (default `tree-widget-end-guide') |
;; nodes. Icon widgets must derive from the `tree-widget-icon' |
68 |
;; :no-guide (default `tree-widget-no-guide') |
;; widget. The :tag and :glyph-name property values are |
69 |
;; :handle (default `tree-widget-handle') |
;; respectively used when drawing the text and graphic |
70 |
;; :no-handle (default `tree-widget-no-handle') |
;; representation of the tree. The :tag value must be a string |
71 |
;; Those properties define the widgets used to draw the tree, and |
;; that represent a node icon, like "[+]" for example. The |
72 |
;; permit to customize its look and feel. For example, using |
;; :glyph-name value must the name of an image found in the current |
73 |
;; `item' widgets with these :tag values: |
;; theme, like "close" for example (see also the variable |
74 |
;; |
;; `tree-widget-theme'). |
75 |
;; open-control "[-] " (OC) |
;; |
76 |
;; close-control "[+] " (CC) |
;; :guide (default `tree-widget-guide') |
77 |
;; empty-control "[X] " (EC) |
;; :end-guide (default `tree-widget-end-guide') |
78 |
;; leaf-control "[>] " (LC) |
;; :no-guide (default `tree-widget-no-guide') |
79 |
;; guide " |" (GU) |
;; :handle (default `tree-widget-handle') |
80 |
;; noguide " " (NG) |
;; :no-handle (default `tree-widget-no-handle') |
81 |
;; end-guide " `" (EG) |
;; Those properties define `item'-like widgets used to draw the |
82 |
;; handle "-" (HA) |
;; tree guide lines. The :tag property value is used when drawing |
83 |
;; no-handle " " (NH) |
;; the text representation of the tree. The graphic look and feel |
84 |
;; |
;; is given by the images named "guide", "no-guide", "end-guide", |
85 |
;; A tree will look like this: |
;; "handle", and "no-handle" found in the current theme (see also |
86 |
;; |
;; the variable `tree-widget-theme'). |
87 |
;; [-] 1 (OC :node) |
;; |
88 |
;; |-[+] 1.0 (GU+HA+CC :node) |
;; These are the default :tag values for icons, and guide lines: |
89 |
;; |-[X] 1.1 (GU+HA+EC :node) |
;; |
90 |
;; `-[-] 1.2 (EG+HA+OC :node) |
;; open-icon "[-]" |
91 |
;; |-[>] 1.2.1 (NG+NH+GU+HA+LC child) |
;; close-icon "[+]" |
92 |
;; `-[>] 1.2.2 (NG+NH+EG+HA+LC child) |
;; empty-icon "[X]" |
93 |
|
;; leaf-icon "" |
94 |
|
;; guide " |" |
95 |
|
;; no-guide " " |
96 |
|
;; end-guide " `" |
97 |
|
;; handle "-" |
98 |
|
;; no-handle " " |
99 |
|
;; |
100 |
|
;; The text representation of a tree looks like this: |
101 |
|
;; |
102 |
|
;; [-] 1 (open-icon :node) |
103 |
|
;; |-[+] 1.0 (guide+handle+close-icon :node) |
104 |
|
;; |-[X] 1.1 (guide+handle+empty-icon :node) |
105 |
|
;; `-[-] 1.2 (end-guide+handle+open-icon :node) |
106 |
|
;; |- 1.2.1 (no-guide+no-handle+guide+handle+leaf-icon leaf) |
107 |
|
;; `- 1.2.2 (no-guide+no-handle+end-guide+handle+leaf-icon leaf) |
108 |
;; |
;; |
109 |
;; By default, images will be used instead of strings to draw a |
;; By default, images will be used instead of strings to draw a |
110 |
;; nice-looking tree. See the `tree-widget-image-enable', |
;; nice-looking tree. See the `tree-widget-image-enable', |
148 |
(defcustom tree-widget-theme nil |
(defcustom tree-widget-theme nil |
149 |
"*Name of the theme where to look up for images. |
"*Name of the theme where to look up for images. |
150 |
It must be a sub directory of the directory specified in variable |
It must be a sub directory of the directory specified in variable |
151 |
`tree-widget-themes-directory'. The default is \"default\". When an |
`tree-widget-themes-directory'. The default theme is \"default\". |
152 |
image is not found in this theme, the default theme is searched too. |
When an image is not found in a theme, it is searched in the default |
153 |
A complete theme must contain images with these file names with a |
theme. |
154 |
supported extension (see also `tree-widget-image-formats'): |
|
155 |
|
A complete theme must at least contain images with these file names |
156 |
|
with a supported extension (see also `tree-widget-image-formats'): |
157 |
|
|
|
\"open\" |
|
|
Represent an expanded node. |
|
|
\"close\" |
|
|
Represent a collapsed node. |
|
|
\"empty\" |
|
|
Represent an expanded node with no child. |
|
|
\"leaf\" |
|
|
Represent a leaf node. |
|
158 |
\"guide\" |
\"guide\" |
159 |
A vertical guide line. |
A vertical guide line. |
160 |
\"no-guide\" |
\"no-guide\" |
162 |
\"end-guide\" |
\"end-guide\" |
163 |
End of a vertical guide line. |
End of a vertical guide line. |
164 |
\"handle\" |
\"handle\" |
165 |
Horizontal guide line that joins the vertical guide line to a node. |
Horizontal guide line that joins the vertical guide line to an icon. |
166 |
\"no-handle\" |
\"no-handle\" |
167 |
An invisible handle." |
An invisible handle. |
168 |
|
|
169 |
|
Plus images whose name is given by the :glyph-name property of the |
170 |
|
icon widgets used to draw the tree. By default these images are used: |
171 |
|
|
172 |
|
\"open\" |
173 |
|
Icon associated to an expanded tree. |
174 |
|
\"close\" |
175 |
|
Icon associated to a collapsed tree. |
176 |
|
\"empty\" |
177 |
|
Icon associated to an expanded tree with no child. |
178 |
|
\"leaf\" |
179 |
|
Icon associated to a leaf node." |
180 |
:type '(choice (const :tag "Default" nil) |
:type '(choice (const :tag "Default" nil) |
181 |
(string :tag "Name")) |
(string :tag "Name")) |
182 |
:group 'tree-widget) |
:group 'tree-widget) |
192 |
"*Default properties of XEmacs images." |
"*Default properties of XEmacs images." |
193 |
:type 'plist |
:type 'plist |
194 |
:group 'tree-widget) |
:group 'tree-widget) |
195 |
|
|
196 |
|
(defcustom tree-widget-space-width 0.5 |
197 |
|
"Amount of space between an icon image and a node widget. |
198 |
|
Must be a valid space :width display property." |
199 |
|
:group 'tree-widget |
200 |
|
:type 'sexp) |
201 |
|
|
202 |
;;; Image support |
;;; Image support |
203 |
;; |
;; |
324 |
'(:ascent center :mask (heuristic t)) |
'(:ascent center :mask (heuristic t)) |
325 |
)) |
)) |
326 |
|
|
327 |
|
When there is no \"tree-widget-theme-setup\" library in the current |
328 |
|
theme directory, load the one from the default theme, if available. |
329 |
Default global properties are provided for respectively Emacs and |
Default global properties are provided for respectively Emacs and |
330 |
XEmacs in the variables `tree-widget-image-properties-emacs', and |
XEmacs in the variables `tree-widget-image-properties-emacs', and |
331 |
`tree-widget-image-properties-xemacs'." |
`tree-widget-image-properties-xemacs'." |
337 |
(file-name-directory file)) t t) |
(file-name-directory file)) t t) |
338 |
;; If properties have been setup, use them. |
;; If properties have been setup, use them. |
339 |
(unless (setq plist (aref tree-widget--theme 2)) |
(unless (setq plist (aref tree-widget--theme 2)) |
340 |
;; By default, use supplied global properties. |
;; Try from the default theme. |
341 |
(setq plist (if (featurep 'xemacs) |
(load (expand-file-name "../default/tree-widget-theme-setup" |
342 |
tree-widget-image-properties-xemacs |
(file-name-directory file)) t t) |
343 |
tree-widget-image-properties-emacs)) |
;; If properties have been setup, use them. |
344 |
;; Setup the cache. |
(unless (setq plist (aref tree-widget--theme 2)) |
345 |
(tree-widget-set-image-properties plist))) |
;; By default, use supplied global properties. |
346 |
|
(setq plist (if (featurep 'xemacs) |
347 |
|
tree-widget-image-properties-xemacs |
348 |
|
tree-widget-image-properties-emacs)) |
349 |
|
;; Setup the cache. |
350 |
|
(tree-widget-set-image-properties plist)))) |
351 |
plist)) |
plist)) |
352 |
|
|
353 |
(defconst tree-widget--cursors |
(defconst tree-widget--cursors |
355 |
;; This feature works since Emacs 22, and ignored on older versions, |
;; This feature works since Emacs 22, and ignored on older versions, |
356 |
;; and XEmacs. |
;; and XEmacs. |
357 |
'( |
'( |
|
("open" . hand ) |
|
|
("close" . hand ) |
|
|
("empty" . arrow) |
|
|
("leaf" . arrow) |
|
358 |
("guide" . arrow) |
("guide" . arrow) |
359 |
("no-guide" . arrow) |
("no-guide" . arrow) |
360 |
("end-guide" . arrow) |
("end-guide" . arrow) |
387 |
;; Add the pointer shape |
;; Add the pointer shape |
388 |
(cons :pointer |
(cons :pointer |
389 |
(cons |
(cons |
390 |
(cdr (assoc name tree-widget--cursors)) |
(or (cdr (assoc name tree-widget--cursors)) |
391 |
|
'hand) |
392 |
(tree-widget-image-properties file))))))))) |
(tree-widget-image-properties file))))))))) |
393 |
nil))))) |
nil))))) |
394 |
|
|
426 |
"Keymap used inside node buttons. |
"Keymap used inside node buttons. |
427 |
Handle mouse button 1 click on buttons.") |
Handle mouse button 1 click on buttons.") |
428 |
|
|
429 |
(define-widget 'tree-widget-control 'push-button |
(define-widget 'tree-widget-icon 'push-button |
430 |
"Basic widget other tree-widget node buttons are derived from." |
"Basic widget other tree-widget icons are derived from." |
431 |
:format "%[%t%]" |
:format "%[%t%]" |
432 |
:button-keymap tree-widget-button-keymap ; XEmacs |
:button-keymap tree-widget-button-keymap ; XEmacs |
433 |
:keymap tree-widget-button-keymap ; Emacs |
:keymap tree-widget-button-keymap ; Emacs |
434 |
|
:create 'tree-widget-icon-create |
435 |
|
:action 'tree-widget-icon-action |
436 |
|
:help-echo 'tree-widget-icon-help-echo |
437 |
) |
) |
438 |
|
|
439 |
(define-widget 'tree-widget-open-control 'tree-widget-control |
(define-widget 'tree-widget-open-icon 'tree-widget-icon |
440 |
"Button for an expanded tree-widget node." |
"Icon for an expanded tree-widget node." |
441 |
:tag "[-] " |
:tag "[-]" |
442 |
;;:tag-glyph (tree-widget-find-image "open") |
:glyph-name "open" |
443 |
:notify 'tree-widget-close-node |
) |
444 |
:help-echo "Collapse node" |
|
445 |
) |
(define-widget 'tree-widget-empty-icon 'tree-widget-icon |
446 |
|
"Icon for an expanded tree-widget node with no child." |
447 |
(define-widget 'tree-widget-empty-control 'tree-widget-open-control |
:tag "[X]" |
448 |
"Button for an expanded tree-widget node with no child." |
:glyph-name "empty" |
449 |
:tag "[X] " |
) |
450 |
;;:tag-glyph (tree-widget-find-image "empty") |
|
451 |
) |
(define-widget 'tree-widget-close-icon 'tree-widget-icon |
452 |
|
"Icon for a collapsed tree-widget node." |
453 |
(define-widget 'tree-widget-close-control 'tree-widget-control |
:tag "[+]" |
454 |
"Button for a collapsed tree-widget node." |
:glyph-name "close" |
455 |
:tag "[+] " |
) |
456 |
;;:tag-glyph (tree-widget-find-image "close") |
|
457 |
:notify 'tree-widget-open-node |
(define-widget 'tree-widget-leaf-icon 'tree-widget-icon |
458 |
:help-echo "Expand node" |
"Icon for a tree-widget leaf node." |
459 |
) |
:tag "" |
460 |
|
:glyph-name "leaf" |
461 |
(define-widget 'tree-widget-leaf-control 'item |
:button-face 'default |
|
"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" |
|
462 |
) |
) |
463 |
|
|
464 |
(define-widget 'tree-widget-guide 'item |
(define-widget 'tree-widget-guide 'item |
484 |
|
|
485 |
(define-widget 'tree-widget-handle 'item |
(define-widget 'tree-widget-handle 'item |
486 |
"Horizontal guide line that joins a vertical guide line to a node." |
"Horizontal guide line that joins a vertical guide line to a node." |
487 |
:tag " " |
:tag "-" |
488 |
;;:tag-glyph (tree-widget-find-image "handle") |
;;:tag-glyph (tree-widget-find-image "handle") |
489 |
:format "%t" |
:format "%t" |
490 |
) |
) |
503 |
:value-get 'widget-value-value-get |
:value-get 'widget-value-value-get |
504 |
:value-delete 'widget-children-value-delete |
:value-delete 'widget-children-value-delete |
505 |
:value-create 'tree-widget-value-create |
:value-create 'tree-widget-value-create |
506 |
:open-control 'tree-widget-open-control |
:action 'tree-widget-action |
507 |
:close-control 'tree-widget-close-control |
:help-echo 'tree-widget-help-echo |
508 |
:empty-control 'tree-widget-empty-control |
:open-icon 'tree-widget-open-icon |
509 |
:leaf-control 'tree-widget-leaf-control |
:close-icon 'tree-widget-close-icon |
510 |
|
:empty-icon 'tree-widget-empty-icon |
511 |
|
:leaf-icon 'tree-widget-leaf-icon |
512 |
:guide 'tree-widget-guide |
:guide 'tree-widget-guide |
513 |
:end-guide 'tree-widget-end-guide |
:end-guide 'tree-widget-end-guide |
514 |
:no-guide 'tree-widget-no-guide |
:no-guide 'tree-widget-no-guide |
585 |
(widget-put arg :value (widget-value child)) |
(widget-put arg :value (widget-value child)) |
586 |
;; Save properties specified in :keep. |
;; Save properties specified in :keep. |
587 |
(tree-widget-keep arg child))))) |
(tree-widget-keep arg child))))) |
588 |
|
|
589 |
(defvar tree-widget-after-toggle-functions nil |
;;; Widget creation |
590 |
"Hooks run after toggling a tree-widget expansion. |
;; |
591 |
Each function will receive the tree-widget as its unique argument. |
(defvar tree-widget-before-create-icon-functions nil |
592 |
This hook should be local in the buffer used to display widgets.") |
"Hooks run before to create a tree-widget icon. |
593 |
|
Each function is passed the icon widget not yet created. |
594 |
(defun tree-widget-close-node (widget &rest ignore) |
The value of the icon widget :node property is a tree :node widget or |
595 |
"Collapse the tree-widget, parent of WIDGET. |
a leaf node widget, not yet created. |
596 |
WIDGET is, or derives from, a tree-widget-open-control widget. |
This hook can be used to dynamically change properties of the icon and |
597 |
IGNORE other arguments." |
associated node widgets. For example, to dynamically change the look |
598 |
(let ((tree (widget-get widget :parent))) |
and feel of the tree-widget by changing the values of the :tag |
599 |
;; Before to collapse the node, save children values so next open |
and :glyph-name properties of the icon widget. |
600 |
;; can recover them. |
This hook should be local in the buffer setup to display widgets.") |
601 |
(tree-widget-children-value-save tree) |
|
602 |
(widget-put tree :open nil) |
(defun tree-widget-icon-create (icon) |
603 |
(widget-value-set tree nil) |
"Create the ICON widget." |
604 |
(run-hook-with-args 'tree-widget-after-toggle-functions tree))) |
(run-hook-with-args 'tree-widget-before-create-icon-functions icon) |
605 |
|
(widget-put icon :tag-glyph |
606 |
(defun tree-widget-open-node (widget &rest ignore) |
(tree-widget-find-image (widget-get icon :glyph-name))) |
607 |
"Expand the tree-widget, parent of WIDGET. |
;; Ensure there is at least one char to display the image. |
608 |
WIDGET is, or derives from, a tree-widget-close-control widget. |
(and (widget-get icon :tag-glyph) |
609 |
IGNORE other arguments." |
(equal "" (or (widget-get icon :tag) "")) |
610 |
(let ((tree (widget-get widget :parent))) |
(widget-put icon :tag " ")) |
611 |
(widget-put tree :open t) |
(widget-default-create icon) |
612 |
(widget-value-set tree t) |
;; Insert space between the icon and the node widget. |
613 |
(run-hook-with-args 'tree-widget-after-toggle-functions tree))) |
(insert-char ? 1) |
614 |
|
(put-text-property |
615 |
|
(1- (point)) (point) |
616 |
|
'display (list 'space :width tree-widget-space-width))) |
617 |
|
|
618 |
(defun tree-widget-value-create (tree) |
(defun tree-widget-value-create (tree) |
619 |
"Create the TREE tree-widget." |
"Create the TREE tree-widget." |
633 |
(let ((args (widget-get tree :args)) |
(let ((args (widget-get tree :args)) |
634 |
(xpandr (or (widget-get tree :expander) |
(xpandr (or (widget-get tree :expander) |
635 |
(widget-get tree :dynargs))) |
(widget-get tree :dynargs))) |
|
(leaf (widget-get tree :leaf-control)) |
|
636 |
(guide (widget-get tree :guide)) |
(guide (widget-get tree :guide)) |
637 |
(noguide (widget-get tree :no-guide)) |
(noguide (widget-get tree :no-guide)) |
638 |
(endguide (widget-get tree :end-guide)) |
(endguide (widget-get tree :end-guide)) |
639 |
(handle (widget-get tree :handle)) |
(handle (widget-get tree :handle)) |
640 |
(nohandle (widget-get tree :no-handle)) |
(nohandle (widget-get tree :no-handle)) |
|
(leafi (tree-widget-find-image "leaf")) |
|
641 |
(guidi (tree-widget-find-image "guide")) |
(guidi (tree-widget-find-image "guide")) |
642 |
(noguidi (tree-widget-find-image "no-guide")) |
(noguidi (tree-widget-find-image "no-guide")) |
643 |
(endguidi (tree-widget-find-image "end-guide")) |
(endguidi (tree-widget-find-image "end-guide")) |
644 |
(handli (tree-widget-find-image "handle")) |
(handli (tree-widget-find-image "handle")) |
645 |
(nohandli (tree-widget-find-image "no-handle")) |
(nohandli (tree-widget-find-image "no-handle"))) |
|
child) |
|
646 |
;; Request children at run time, when not already done. |
;; Request children at run time, when not already done. |
647 |
(when (and (not args) xpandr) |
(when (and (not args) xpandr) |
648 |
(setq args (mapcar 'widget-convert (funcall xpandr tree))) |
(setq args (mapcar 'widget-convert (funcall xpandr tree))) |
649 |
(widget-put tree :args args)) |
(widget-put tree :args args)) |
650 |
;; Insert the node "open" button. |
;; Create the icon widget for the expanded tree. |
651 |
(push (widget-create-child-and-convert |
(push (widget-create-child-and-convert |
652 |
tree (widget-get |
tree (widget-get tree (if args :open-icon :empty-icon)) |
653 |
tree (if args :open-control :empty-control)) |
;; At this point the node widget isn't yet created. |
654 |
:tag-glyph (tree-widget-find-image |
:node (setq node (widget-convert node))) |
|
(if args "open" "empty"))) |
|
655 |
buttons) |
buttons) |
656 |
;; Insert the :node element. |
;; Create the tree node widget. |
657 |
(push (widget-create-child-and-convert tree node) |
(push (widget-create-child tree node) children) |
658 |
children) |
;; Update the icon :node with the created node widget. |
659 |
;; Insert children. |
(widget-put (car buttons) :node (car children)) |
660 |
|
;; Create the tree children. |
661 |
(while args |
(while args |
662 |
(setq child (car args) |
(setq node (car args) |
663 |
args (cdr args)) |
args (cdr args)) |
664 |
(and indent (insert-char ?\ indent)) |
(and indent (insert-char ?\ indent)) |
665 |
;; Insert guide lines elements from previous levels. |
;; Insert guide lines elements from previous levels. |
666 |
(dolist (f (reverse flags)) |
(dolist (f (reverse flags)) |
676 |
;; Insert the node handle line |
;; Insert the node handle line |
677 |
(widget-create-child-and-convert |
(widget-create-child-and-convert |
678 |
tree handle :tag-glyph handli) |
tree handle :tag-glyph handli) |
679 |
;; If leaf node, insert a leaf node button. |
(if (tree-widget-p node) |
680 |
(unless (tree-widget-p child) |
;; Create a sub-tree node. |
681 |
|
(push (widget-create-child-and-convert |
682 |
|
tree node :tree-widget--guide-flags |
683 |
|
(cons (if args t) flags)) |
684 |
|
children) |
685 |
|
;; Create the icon widget for a leaf node. |
686 |
(push (widget-create-child-and-convert |
(push (widget-create-child-and-convert |
687 |
tree leaf :tag-glyph leafi) |
tree (widget-get tree :leaf-icon) |
688 |
buttons)) |
;; At this point the node widget isn't yet created. |
689 |
;; Finally, insert the child widget. |
:node (setq node (widget-convert |
690 |
(push (widget-create-child-and-convert |
node :tree-widget--guide-flags |
691 |
tree child |
(cons (if args t) flags))) |
692 |
:tree-widget--guide-flags (cons (if args t) flags)) |
:tree-widget--leaf-flag t) |
693 |
children))) |
buttons) |
694 |
|
;; Create the leaf node widget. |
695 |
|
(push (widget-create-child tree node) children) |
696 |
|
;; Update the icon :node with the created node widget. |
697 |
|
(widget-put (car buttons) :node (car children))))) |
698 |
;;;; Collapsed node. |
;;;; Collapsed node. |
699 |
;; Insert the "closed" node button. |
;; Create the icon widget for the collapsed tree. |
700 |
(push (widget-create-child-and-convert |
(push (widget-create-child-and-convert |
701 |
tree (widget-get tree :close-control) |
tree (widget-get tree :close-icon) |
702 |
:tag-glyph (tree-widget-find-image "close")) |
;; At this point the node widget isn't yet created. |
703 |
|
:node (setq node (widget-convert node))) |
704 |
buttons) |
buttons) |
705 |
;; Insert the :node element. |
;; Create the tree node widget. |
706 |
(push (widget-create-child-and-convert tree node) |
(push (widget-create-child tree node) children) |
707 |
children)) |
;; Update the icon :node with the created node widget. |
708 |
;; Save widget children and buttons. The :node child is the first |
(widget-put (car buttons) :node (car children))) |
709 |
;; element in children. |
;; Save widget children and buttons. The tree-widget :node child |
710 |
|
;; is the first element in :children. |
711 |
(widget-put tree :children (nreverse children)) |
(widget-put tree :children (nreverse children)) |
712 |
(widget-put tree :buttons buttons) |
(widget-put tree :buttons buttons))) |
713 |
)) |
|
714 |
|
;;; Widget callbacks |
715 |
|
;; |
716 |
|
(defsubst tree-widget-leaf-node-icon-p (icon) |
717 |
|
"Return non-nil if ICON is a leaf node icon. |
718 |
|
That is, if its :node property value is a leaf node widget." |
719 |
|
(widget-get icon :tree-widget--leaf-flag)) |
720 |
|
|
721 |
|
(defun tree-widget-icon-action (icon &optional event) |
722 |
|
"Handle the ICON widget :action. |
723 |
|
If ICON :node is a leaf node it handles the :action. The tree-widget |
724 |
|
parent of ICON handles the :action otherwise. |
725 |
|
Pass the received EVENT to :action." |
726 |
|
(let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon) |
727 |
|
:node :parent)))) |
728 |
|
(widget-apply node :action event))) |
729 |
|
|
730 |
|
(defun tree-widget-icon-help-echo (icon) |
731 |
|
"Return the help-echo string of ICON. |
732 |
|
If ICON :node is a leaf node it handles the :help-echo. The tree-widget |
733 |
|
parent of ICON handles the :help-echo otherwise." |
734 |
|
(let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon) |
735 |
|
:node :parent))) |
736 |
|
(help-echo (widget-get node :help-echo))) |
737 |
|
(if (functionp help-echo) |
738 |
|
(funcall help-echo node) |
739 |
|
help-echo))) |
740 |
|
|
741 |
|
(defvar tree-widget-after-toggle-functions nil |
742 |
|
"Hooks run after toggling a tree-widget expansion. |
743 |
|
Each function is passed a tree-widget. If the value of the :open |
744 |
|
property is non-nil the tree has been expanded, else collapsed. |
745 |
|
This hook should be local in the buffer setup to display widgets.") |
746 |
|
|
747 |
|
(defun tree-widget-action (tree &optional event) |
748 |
|
"Handle the :action of the TREE tree-widget. |
749 |
|
That is, toggle expansion of the TREE tree-widget. |
750 |
|
Ignore the EVENT argument." |
751 |
|
(let ((open (not (widget-get tree :open)))) |
752 |
|
(or open |
753 |
|
;; Before to collapse the node, save children values so next |
754 |
|
;; open can recover them. |
755 |
|
(tree-widget-children-value-save tree)) |
756 |
|
(widget-put tree :open open) |
757 |
|
(widget-value-set tree open) |
758 |
|
(run-hook-with-args 'tree-widget-after-toggle-functions tree))) |
759 |
|
|
760 |
|
(defun tree-widget-help-echo (tree) |
761 |
|
"Return the help-echo string of the TREE tree-widget." |
762 |
|
(if (widget-get tree :open) |
763 |
|
"Collapse node" |
764 |
|
"Expand node")) |
765 |
|
|
766 |
(provide 'tree-widget) |
(provide 'tree-widget) |
767 |
|
|