Mercurial > emacs
annotate lisp/tree-widget.el @ 99191:e295f1ce302e
*** empty log message ***
author | Martin Rudalics <rudalics@gmx.at> |
---|---|
date | Tue, 28 Oct 2008 17:57:09 +0000 |
parents | ee5932bf781d |
children | d42aff5ca541 |
rev | line source |
---|---|
55588 | 1 ;;; tree-widget.el --- Tree widget |
2 | |
79721 | 3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
55588 | 4 |
5 ;; Author: David Ponce <david@dponce.com> | |
6 ;; Maintainer: David Ponce <david@dponce.com> | |
7 ;; Created: 16 Feb 2001 | |
8 ;; Keywords: extensions | |
9 | |
10 ;; This file is part of GNU Emacs | |
11 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
13 ;; it under the terms of the GNU General Public License as published by |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
15 ;; (at your option) any later version. |
55588 | 16 |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
20 ;; GNU General Public License for more details. |
55588 | 21 |
22 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94278
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
55588 | 24 |
25 ;;; Commentary: | |
26 ;; | |
27 ;; This library provide a tree widget useful to display data | |
28 ;; structures organized in a hierarchical order. | |
29 ;; | |
30 ;; The following properties are specific to the tree widget: | |
31 ;; | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
32 ;; :open |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
33 ;; Set to non-nil to expand the tree. By default the tree is |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
34 ;; collapsed. |
55588 | 35 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
36 ;; :node |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
37 ;; Specify the widget used to represent the value of a tree node. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
38 ;; By default this is an `item' widget which displays the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
39 ;; tree-widget :tag property value if defined, or a string |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
40 ;; representation of the tree-widget value. |
55588 | 41 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
42 ;; :keep |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
43 ;; Specify a list of properties to keep when the tree is collapsed |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
44 ;; so they can be recovered when the tree is expanded. This |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
45 ;; property can be used in child widgets too. |
55588 | 46 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
47 ;; :expander (obsoletes :dynargs) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
48 ;; Specify a function to be called to dynamically provide the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
49 ;; tree's children in response to an expand request. This function |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
50 ;; will be passed the tree widget and must return a list of child |
69316 | 51 ;; widgets. Child widgets returned by the :expander function are |
52 ;; stored in the :args property of the tree widget. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
53 ;; |
69316 | 54 ;; :expander-p |
55 ;; Specify a predicate which must return non-nil to indicate that | |
56 ;; the :expander function above has to be called. By default, to | |
57 ;; speed up successive expand requests, the :expander-p predicate | |
58 ;; return non-nil when the :args value is nil. So, by default, to | |
59 ;; refresh child values, it is necessary to set the :args property | |
60 ;; to nil, then redraw the tree. | |
55588 | 61 ;; |
64985 | 62 ;; :open-icon (default `tree-widget-open-icon') |
63 ;; :close-icon (default `tree-widget-close-icon') | |
64 ;; :empty-icon (default `tree-widget-empty-icon') | |
65 ;; :leaf-icon (default `tree-widget-leaf-icon') | |
66 ;; Those properties define the icon widgets associated to tree | |
67 ;; nodes. Icon widgets must derive from the `tree-widget-icon' | |
68 ;; widget. The :tag and :glyph-name property values are | |
69 ;; respectively used when drawing the text and graphic | |
70 ;; representation of the tree. The :tag value must be a string | |
71 ;; that represent a node icon, like "[+]" for example. The | |
72 ;; :glyph-name value must the name of an image found in the current | |
73 ;; theme, like "close" for example (see also the variable | |
74 ;; `tree-widget-theme'). | |
55588 | 75 ;; |
64985 | 76 ;; :guide (default `tree-widget-guide') |
77 ;; :end-guide (default `tree-widget-end-guide') | |
78 ;; :no-guide (default `tree-widget-no-guide') | |
79 ;; :handle (default `tree-widget-handle') | |
80 ;; :no-handle (default `tree-widget-no-handle') | |
81 ;; Those properties define `item'-like widgets used to draw the | |
82 ;; tree guide lines. The :tag property value is used when drawing | |
83 ;; the text representation of the tree. The graphic look and feel | |
84 ;; is given by the images named "guide", "no-guide", "end-guide", | |
85 ;; "handle", and "no-handle" found in the current theme (see also | |
86 ;; the variable `tree-widget-theme'). | |
87 ;; | |
88 ;; These are the default :tag values for icons, and guide lines: | |
55588 | 89 ;; |
64985 | 90 ;; open-icon "[-]" |
91 ;; close-icon "[+]" | |
92 ;; empty-icon "[X]" | |
93 ;; leaf-icon "" | |
94 ;; guide " |" | |
95 ;; no-guide " " | |
96 ;; end-guide " `" | |
97 ;; handle "-" | |
98 ;; no-handle " " | |
55588 | 99 ;; |
64985 | 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) | |
55588 | 108 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
109 ;; By default, images will be used instead of strings to draw a |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
110 ;; nice-looking tree. See the `tree-widget-image-enable', |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
111 ;; `tree-widget-themes-directory', and `tree-widget-theme' options for |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
112 ;; more details. |
55588 | 113 |
114 ;;; History: | |
115 ;; | |
116 | |
117 ;;; Code: | |
118 (eval-when-compile (require 'cl)) | |
119 (require 'wid-edit) | |
120 | |
121 ;;; Customization | |
122 ;; | |
123 (defgroup tree-widget nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
124 "Customization support for the Tree Widget library." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
55594
diff
changeset
|
125 :version "22.1" |
55588 | 126 :group 'widgets) |
127 | |
94278
f897946caca1
(tree-widget-image-enable): Use display-images-p rather than an Emacs
Glenn Morris <rgm@gnu.org>
parents:
92137
diff
changeset
|
128 (defcustom tree-widget-image-enable (if (fboundp 'display-images-p) |
f897946caca1
(tree-widget-image-enable): Use display-images-p rather than an Emacs
Glenn Morris <rgm@gnu.org>
parents:
92137
diff
changeset
|
129 (display-images-p)) |
f897946caca1
(tree-widget-image-enable): Use display-images-p rather than an Emacs
Glenn Morris <rgm@gnu.org>
parents:
92137
diff
changeset
|
130 "Non-nil means that tree-widget will try to use images." |
55588 | 131 :type 'boolean |
132 :group 'tree-widget) | |
133 | |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
134 (defvar tree-widget-themes-load-path |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
135 '(load-path |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
136 (let ((dir (if (fboundp 'locate-data-directory) |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
137 (locate-data-directory "tree-widget") ;; XEmacs |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
138 data-directory))) |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
139 (and dir (list dir (expand-file-name "images" dir)))) |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
140 ) |
69466
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
141 "List of locations in which to search for the themes sub-directory. |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
142 Each element is an expression that will be recursively evaluated until |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
143 it returns a single directory or a list of directories. |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
144 The default is to search in the `load-path' first, then in the |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
145 \"images\" sub directory in the data directory, then in the data |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
146 directory. |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
147 The data directory is the value of the variable `data-directory' on |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
148 Emacs, and what `(locate-data-directory \"tree-widget\")' returns on |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
149 XEmacs.") |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
150 |
55588 | 151 (defcustom tree-widget-themes-directory "tree-widget" |
69466
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
152 "*Name of the directory in which to look for an image theme. |
55588 | 153 When nil use the directory where the tree-widget library is located. |
69466
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
154 When it is a relative name, search in all occurrences of that sub |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
155 directory in the path specified by `tree-widget-themes-load-path'. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
156 The default is to use the \"tree-widget\" relative name." |
55588 | 157 :type '(choice (const :tag "Default" "tree-widget") |
69466
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
158 (const :tag "Where is this library" nil) |
55588 | 159 (directory :format "%{%t%}:\n%v")) |
160 :group 'tree-widget) | |
161 | |
162 (defcustom tree-widget-theme nil | |
69466
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
163 "*Name of the theme in which to look for images. |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
164 This is a sub directory of the themes directory specified by the |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
165 `tree-widget-themes-directory' option. |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
166 The default theme is \"default\". When an image is not found in a |
63d7389cb46f
(tree-widget-themes-load-path)
David Ponce <david@dponce.com>
parents:
69459
diff
changeset
|
167 theme, it is searched in its parent theme. |
55588 | 168 |
64985 | 169 A complete theme must at least contain images with these file names |
170 with a supported extension (see also `tree-widget-image-formats'): | |
171 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
172 \"guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
173 A vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
174 \"no-guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
175 An invisible vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
176 \"end-guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
177 End of a vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
178 \"handle\" |
64985 | 179 Horizontal guide line that joins the vertical guide line to an icon. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
180 \"no-handle\" |
64985 | 181 An invisible handle. |
182 | |
183 Plus images whose name is given by the :glyph-name property of the | |
184 icon widgets used to draw the tree. By default these images are used: | |
185 | |
186 \"open\" | |
187 Icon associated to an expanded tree. | |
188 \"close\" | |
189 Icon associated to a collapsed tree. | |
190 \"empty\" | |
191 Icon associated to an expanded tree with no child. | |
192 \"leaf\" | |
193 Icon associated to a leaf node." | |
55588 | 194 :type '(choice (const :tag "Default" nil) |
195 (string :tag "Name")) | |
196 :group 'tree-widget) | |
197 | |
198 (defcustom tree-widget-image-properties-emacs | |
199 '(:ascent center :mask (heuristic t)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
200 "*Default properties of Emacs images." |
55588 | 201 :type 'plist |
202 :group 'tree-widget) | |
203 | |
204 (defcustom tree-widget-image-properties-xemacs | |
205 nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
206 "*Default properties of XEmacs images." |
55588 | 207 :type 'plist |
208 :group 'tree-widget) | |
64985 | 209 |
210 (defcustom tree-widget-space-width 0.5 | |
211 "Amount of space between an icon image and a node widget. | |
212 Must be a valid space :width display property." | |
213 :group 'tree-widget | |
214 :type 'sexp) | |
55588 | 215 |
216 ;;; Image support | |
217 ;; | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
218 (eval-and-compile ;; Emacs/XEmacs compatibility stuff |
55588 | 219 (cond |
220 ;; XEmacs | |
221 ((featurep 'xemacs) | |
222 (defsubst tree-widget-use-image-p () | |
223 "Return non-nil if image support is currently enabled." | |
224 (and tree-widget-image-enable | |
225 widget-glyph-enable | |
226 (console-on-window-system-p))) | |
227 (defsubst tree-widget-create-image (type file &optional props) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
228 "Create an image of type TYPE from FILE, and return it. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
229 Give the image the specified properties PROPS." |
55588 | 230 (apply 'make-glyph `([,type :file ,file ,@props]))) |
231 (defsubst tree-widget-image-formats () | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
232 "Return the alist of image formats/file name extensions. |
55588 | 233 See also the option `widget-image-file-name-suffixes'." |
234 (delq nil | |
235 (mapcar | |
236 #'(lambda (fmt) | |
237 (and (valid-image-instantiator-format-p (car fmt)) fmt)) | |
238 widget-image-file-name-suffixes))) | |
239 ) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
240 ;; Emacs |
55588 | 241 (t |
242 (defsubst tree-widget-use-image-p () | |
243 "Return non-nil if image support is currently enabled." | |
244 (and tree-widget-image-enable | |
245 widget-image-enable | |
246 (display-images-p))) | |
247 (defsubst tree-widget-create-image (type file &optional props) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
248 "Create an image of type TYPE from FILE, and return it. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
249 Give the image the specified properties PROPS." |
55588 | 250 (apply 'create-image `(,file ,type nil ,@props))) |
251 (defsubst tree-widget-image-formats () | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
252 "Return the alist of image formats/file name extensions. |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
253 See also the option `widget-image-conversion'." |
55588 | 254 (delq nil |
255 (mapcar | |
256 #'(lambda (fmt) | |
257 (and (image-type-available-p (car fmt)) fmt)) | |
258 widget-image-conversion))) | |
259 )) | |
260 ) | |
261 | |
262 ;; Buffer local cache of theme data. | |
263 (defvar tree-widget--theme nil) | |
264 | |
265 (defsubst tree-widget-theme-name () | |
266 "Return the current theme name, or nil if no theme is active." | |
69316 | 267 (and tree-widget--theme (car (aref tree-widget--theme 0)))) |
55588 | 268 |
69316 | 269 (defsubst tree-widget-set-parent-theme (name) |
270 "Set to NAME the parent theme of the current theme. | |
271 The default parent theme is the \"default\" theme." | |
272 (unless (member name (aref tree-widget--theme 0)) | |
273 (aset tree-widget--theme 0 | |
274 (append (aref tree-widget--theme 0) (list name))) | |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
275 ;; Load the theme setup from the first directory where the theme |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
276 ;; is found. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
277 (catch 'found |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
278 (dolist (dir (tree-widget-themes-path)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
279 (setq dir (expand-file-name name dir)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
280 (when (file-accessible-directory-p dir) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
281 (throw 'found |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
282 (load (expand-file-name |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
283 "tree-widget-theme-setup" dir) t))))))) |
69316 | 284 |
285 (defun tree-widget-set-theme (&optional name) | |
55588 | 286 "In the current buffer, set the theme to use for images. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
287 The current buffer must be where the tree widget is drawn. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
288 Optional argument NAME is the name of the theme to use. It defaults |
55588 | 289 to the value of the variable `tree-widget-theme'. |
69316 | 290 Does nothing if NAME is already the current theme. |
291 | |
292 If there is a \"tree-widget-theme-setup\" library in the theme | |
293 directory, load it to setup a parent theme or the images properties. | |
294 Typically it should contain something like this: | |
295 | |
296 (tree-widget-set-parent-theme \"my-parent-theme\") | |
297 (tree-widget-set-image-properties | |
298 (if (featurep 'xemacs) | |
299 '(:ascent center) | |
300 '(:ascent center :mask (heuristic t)) | |
301 ))" | |
55588 | 302 (or name (setq name (or tree-widget-theme "default"))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
303 (unless (string-equal name (tree-widget-theme-name)) |
55588 | 304 (set (make-local-variable 'tree-widget--theme) |
305 (make-vector 4 nil)) | |
69316 | 306 (tree-widget-set-parent-theme name) |
307 (tree-widget-set-parent-theme "default"))) | |
55588 | 308 |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
309 (defun tree-widget--locate-sub-directory (name path &optional found) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
310 "Locate all occurrences of the sub-directory NAME in PATH. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
311 Return a list of absolute directory names in reverse order, or nil if |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
312 not found." |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
313 (condition-case err |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
314 (dolist (elt path) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
315 (setq elt (eval elt)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
316 (cond |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
317 ((stringp elt) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
318 (and (file-accessible-directory-p |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
319 (setq elt (expand-file-name name elt))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
320 (push elt found))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
321 (elt |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
322 (setq found (tree-widget--locate-sub-directory |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
323 name (if (atom elt) (list elt) elt) found))))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
324 (error |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
325 (message "In tree-widget--locate-sub-directory: %s" |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
326 (error-message-string err)))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
327 found) |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
328 |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
329 (defun tree-widget-themes-path () |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
330 "Return the path where to search for a theme. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
331 It is specified in variable `tree-widget-themes-directory'. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
332 Return a list of absolute directory names, or nil when no directory |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
333 has been found accessible." |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
334 (let ((path (aref tree-widget--theme 1))) |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
335 (cond |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
336 ;; No directory was found. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
337 ((eq path 'void) nil) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
338 ;; The list of directories is available in the cache. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
339 (path) |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
340 ;; Use the directory where this library is located. |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
341 ((null tree-widget-themes-directory) |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
342 (when (setq path (locate-library "tree-widget")) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
343 (setq path (file-name-directory path)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
344 (setq path (and (file-accessible-directory-p path) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
345 (list path))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
346 ;; Store the result in the cache for later use. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
347 (aset tree-widget--theme 1 (or path 'void)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
348 path)) |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
349 ;; Check accessibility of absolute directory name. |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
350 ((file-name-absolute-p tree-widget-themes-directory) |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
351 (setq path (expand-file-name tree-widget-themes-directory)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
352 (setq path (and (file-accessible-directory-p path) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
353 (list path))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
354 ;; Store the result in the cache for later use. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
355 (aset tree-widget--theme 1 (or path 'void)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
356 path) |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
357 ;; Locate a sub-directory in `tree-widget-themes-load-path'. |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
358 (t |
69459
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
359 (setq path (nreverse (tree-widget--locate-sub-directory |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
360 tree-widget-themes-directory |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
361 tree-widget-themes-load-path))) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
362 ;; Store the result in the cache for later use. |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
363 (aset tree-widget--theme 1 (or path 'void)) |
602d4778bd8a
Handle themes across all occurrences of the main
David Ponce <david@dponce.com>
parents:
69316
diff
changeset
|
364 path)))) |
55588 | 365 |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
366 (defconst tree-widget--cursors |
65747
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
367 ;; Pointer shapes when the mouse pointer is over inactive |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
368 ;; tree-widget images. This feature works since Emacs 22, and |
cfaa6269b03d
(tree-widget-themes-load-path): New variable.
David Ponce <david@dponce.com>
parents:
65649
diff
changeset
|
369 ;; ignored on older versions, and XEmacs. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
370 '( |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
371 ("guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
372 ("no-guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
373 ("end-guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
374 ("handle" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
375 ("no-handle" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
376 )) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
377 |
69316 | 378 (defsubst tree-widget-set-image-properties (props) |
379 "In current theme, set images properties to PROPS. | |
380 Does nothing if images properties have already been set for that | |
381 theme." | |
382 (or (aref tree-widget--theme 2) | |
383 (aset tree-widget--theme 2 props))) | |
384 | |
385 (defsubst tree-widget-image-properties (name) | |
386 "Return the properties of image NAME in current theme. | |
387 Default global properties are provided for respectively Emacs and | |
388 XEmacs in the variables `tree-widget-image-properties-emacs', and | |
389 `tree-widget-image-properties-xemacs'." | |
390 ;; Add the pointer shape | |
391 (cons :pointer | |
392 (cons (or (cdr (assoc name tree-widget--cursors)) 'hand) | |
393 (tree-widget-set-image-properties | |
394 (if (featurep 'xemacs) | |
395 tree-widget-image-properties-xemacs | |
396 tree-widget-image-properties-emacs))))) | |
397 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
398 (defun tree-widget-lookup-image (name) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
399 "Look up in current theme for an image with NAME. |
69316 | 400 Search first in current theme, then in parent themes (see also the |
401 function `tree-widget-set-parent-theme'). | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
402 Return the first image found having a supported format, or nil if not |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
403 found." |
92137
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
404 (let (file) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
405 (catch 'found |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
406 (dolist (default-directory (tree-widget-themes-path)) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
407 (dolist (dir (aref tree-widget--theme 0)) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
408 (dolist (fmt (tree-widget-image-formats)) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
409 (dolist (ext (cdr fmt)) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
410 (setq file (expand-file-name (concat name ext) dir)) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
411 (and (file-readable-p file) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
412 (file-regular-p file) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
413 (throw 'found |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
414 (tree-widget-create-image |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
415 (car fmt) file |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
416 (tree-widget-image-properties name)))))))) |
f03174f40e16
(tree-widget-lookup-image): Let-bind `file'.
Glenn Morris <rgm@gnu.org>
parents:
79721
diff
changeset
|
417 nil))) |
55588 | 418 |
419 (defun tree-widget-find-image (name) | |
420 "Find the image with NAME in current theme. | |
421 NAME is an image file name sans extension. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
422 Return the image found, or nil if not found." |
55588 | 423 (when (tree-widget-use-image-p) |
424 ;; Ensure there is an active theme. | |
425 (tree-widget-set-theme (tree-widget-theme-name)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
426 (let ((image (assoc name (aref tree-widget--theme 3)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
427 ;; The image NAME is found in the cache. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
428 (if image |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
429 (cdr image) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
430 ;; Search the image in current, and default themes. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
431 (prog1 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
432 (setq image (tree-widget-lookup-image name)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
433 ;; Store image reference in the cache for later use. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
434 (push (cons name image) (aref tree-widget--theme 3)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
435 ))) |
55588 | 436 |
437 ;;; Widgets | |
438 ;; | |
66187
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
439 (defun tree-widget-button-click (event) |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
440 "Move to the position clicked on, and if it is a button, invoke it. |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
441 EVENT is the mouse event received." |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
442 (interactive "e") |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
443 (mouse-set-point event) |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
444 (let ((pos (widget-event-point event))) |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
445 (if (get-char-property pos 'button) |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
446 (widget-button-click event)))) |
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
447 |
55588 | 448 (defvar tree-widget-button-keymap |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
449 (let ((km (make-sparse-keymap))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
450 (if (boundp 'widget-button-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
451 ;; XEmacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
452 (progn |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
453 (set-keymap-parent km widget-button-keymap) |
66187
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
454 (define-key km [button1] 'tree-widget-button-click)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
455 ;; Emacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
456 (set-keymap-parent km widget-keymap) |
66187
5955934355f2
(tree-widget-button-click): New function.
David Ponce <david@dponce.com>
parents:
65747
diff
changeset
|
457 (define-key km [down-mouse-1] 'tree-widget-button-click)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
458 km) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
459 "Keymap used inside node buttons. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
460 Handle mouse button 1 click on buttons.") |
55588 | 461 |
64985 | 462 (define-widget 'tree-widget-icon 'push-button |
463 "Basic widget other tree-widget icons are derived from." | |
55588 | 464 :format "%[%t%]" |
465 :button-keymap tree-widget-button-keymap ; XEmacs | |
466 :keymap tree-widget-button-keymap ; Emacs | |
64985 | 467 :create 'tree-widget-icon-create |
468 :action 'tree-widget-icon-action | |
469 :help-echo 'tree-widget-icon-help-echo | |
55588 | 470 ) |
471 | |
64985 | 472 (define-widget 'tree-widget-open-icon 'tree-widget-icon |
473 "Icon for an expanded tree-widget node." | |
474 :tag "[-]" | |
475 :glyph-name "open" | |
55588 | 476 ) |
477 | |
64985 | 478 (define-widget 'tree-widget-empty-icon 'tree-widget-icon |
479 "Icon for an expanded tree-widget node with no child." | |
480 :tag "[X]" | |
481 :glyph-name "empty" | |
55588 | 482 ) |
483 | |
64985 | 484 (define-widget 'tree-widget-close-icon 'tree-widget-icon |
485 "Icon for a collapsed tree-widget node." | |
486 :tag "[+]" | |
487 :glyph-name "close" | |
55588 | 488 ) |
489 | |
64985 | 490 (define-widget 'tree-widget-leaf-icon 'tree-widget-icon |
491 "Icon for a tree-widget leaf node." | |
492 :tag "" | |
493 :glyph-name "leaf" | |
494 :button-face 'default | |
55588 | 495 ) |
496 | |
497 (define-widget 'tree-widget-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
498 "Vertical guide line." |
55588 | 499 :tag " |" |
500 ;;:tag-glyph (tree-widget-find-image "guide") | |
501 :format "%t" | |
502 ) | |
503 | |
504 (define-widget 'tree-widget-end-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
505 "End of a vertical guide line." |
55588 | 506 :tag " `" |
507 ;;:tag-glyph (tree-widget-find-image "end-guide") | |
508 :format "%t" | |
509 ) | |
510 | |
511 (define-widget 'tree-widget-no-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
512 "Invisible vertical guide line." |
55588 | 513 :tag " " |
514 ;;:tag-glyph (tree-widget-find-image "no-guide") | |
515 :format "%t" | |
516 ) | |
517 | |
518 (define-widget 'tree-widget-handle 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
519 "Horizontal guide line that joins a vertical guide line to a node." |
64985 | 520 :tag "-" |
55588 | 521 ;;:tag-glyph (tree-widget-find-image "handle") |
522 :format "%t" | |
523 ) | |
524 | |
525 (define-widget 'tree-widget-no-handle 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
526 "Invisible handle." |
55588 | 527 :tag " " |
528 ;;:tag-glyph (tree-widget-find-image "no-handle") | |
529 :format "%t" | |
530 ) | |
531 | |
532 (define-widget 'tree-widget 'default | |
533 "Tree widget." | |
534 :format "%v" | |
69316 | 535 :convert-widget 'tree-widget-convert-widget |
55588 | 536 :value-get 'widget-value-value-get |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
537 :value-delete 'widget-children-value-delete |
55588 | 538 :value-create 'tree-widget-value-create |
64985 | 539 :action 'tree-widget-action |
540 :help-echo 'tree-widget-help-echo | |
69316 | 541 :expander-p 'tree-widget-expander-p |
64985 | 542 :open-icon 'tree-widget-open-icon |
543 :close-icon 'tree-widget-close-icon | |
544 :empty-icon 'tree-widget-empty-icon | |
545 :leaf-icon 'tree-widget-leaf-icon | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
546 :guide 'tree-widget-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
547 :end-guide 'tree-widget-end-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
548 :no-guide 'tree-widget-no-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
549 :handle 'tree-widget-handle |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
550 :no-handle 'tree-widget-no-handle |
55588 | 551 ) |
552 | |
553 ;;; Widget support functions | |
554 ;; | |
555 (defun tree-widget-p (widget) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
556 "Return non-nil if WIDGET is a tree-widget." |
55588 | 557 (let ((type (widget-type widget))) |
558 (while (and type (not (eq type 'tree-widget))) | |
559 (setq type (widget-type (get type 'widget-type)))) | |
560 (eq type 'tree-widget))) | |
561 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
562 (defun tree-widget-node (widget) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
563 "Return WIDGET's :node child widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
564 If not found, setup an `item' widget as default. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
565 Signal an error if the :node widget is a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
566 WIDGET is, or derives from, a tree-widget." |
55588 | 567 (let ((node (widget-get widget :node))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
568 (if node |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
569 ;; Check that the :node widget is not a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
570 (and (tree-widget-p node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
571 (error "Invalid tree-widget :node %S" node)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
572 ;; Setup an item widget as default :node. |
55588 | 573 (setq node `(item :tag ,(or (widget-get widget :tag) |
574 (widget-princ-to-string | |
575 (widget-value widget))))) | |
576 (widget-put widget :node node)) | |
577 node)) | |
578 | |
579 (defun tree-widget-keep (arg widget) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
580 "Save in ARG the WIDGET's properties specified by :keep." |
55588 | 581 (dolist (prop (widget-get widget :keep)) |
582 (widget-put arg prop (widget-get widget prop)))) | |
583 | |
584 (defun tree-widget-children-value-save (widget &optional args node) | |
585 "Save WIDGET children values. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
586 WIDGET is, or derives from, a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
587 Children properties and values are saved in ARGS if non-nil, else in |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
588 WIDGET's :args property value. Properties and values of the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
589 WIDGET's :node sub-widget are saved in NODE if non-nil, else in |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
590 WIDGET's :node sub-widget." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
591 (let ((args (cons (or node (widget-get widget :node)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
592 (or args (widget-get widget :args)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
593 (children (widget-get widget :children)) |
55588 | 594 arg child) |
595 (while (and args children) | |
596 (setq arg (car args) | |
597 args (cdr args) | |
598 child (car children) | |
599 children (cdr children)) | |
600 (if (tree-widget-p child) | |
601 ;;;; The child is a tree node. | |
602 (progn | |
603 ;; Backtrack :args and :node properties. | |
604 (widget-put arg :args (widget-get child :args)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
605 (widget-put arg :node (widget-get child :node)) |
55588 | 606 ;; Save :open property. |
607 (widget-put arg :open (widget-get child :open)) | |
608 ;; The node is open. | |
609 (when (widget-get child :open) | |
610 ;; Save the widget value. | |
611 (widget-put arg :value (widget-value child)) | |
612 ;; Save properties specified in :keep. | |
613 (tree-widget-keep arg child) | |
614 ;; Save children. | |
615 (tree-widget-children-value-save | |
616 child (widget-get arg :args) (widget-get arg :node)))) | |
617 ;;;; Another non tree node. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
618 ;; Save the widget value. |
55588 | 619 (widget-put arg :value (widget-value child)) |
620 ;; Save properties specified in :keep. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
621 (tree-widget-keep arg child))))) |
64985 | 622 |
623 ;;; Widget creation | |
624 ;; | |
625 (defvar tree-widget-before-create-icon-functions nil | |
626 "Hooks run before to create a tree-widget icon. | |
627 Each function is passed the icon widget not yet created. | |
628 The value of the icon widget :node property is a tree :node widget or | |
629 a leaf node widget, not yet created. | |
630 This hook can be used to dynamically change properties of the icon and | |
631 associated node widgets. For example, to dynamically change the look | |
632 and feel of the tree-widget by changing the values of the :tag | |
633 and :glyph-name properties of the icon widget. | |
634 This hook should be local in the buffer setup to display widgets.") | |
55588 | 635 |
64985 | 636 (defun tree-widget-icon-create (icon) |
637 "Create the ICON widget." | |
638 (run-hook-with-args 'tree-widget-before-create-icon-functions icon) | |
639 (widget-put icon :tag-glyph | |
640 (tree-widget-find-image (widget-get icon :glyph-name))) | |
641 ;; Ensure there is at least one char to display the image. | |
642 (and (widget-get icon :tag-glyph) | |
643 (equal "" (or (widget-get icon :tag) "")) | |
644 (widget-put icon :tag " ")) | |
645 (widget-default-create icon) | |
646 ;; Insert space between the icon and the node widget. | |
647 (insert-char ? 1) | |
648 (put-text-property | |
649 (1- (point)) (point) | |
650 'display (list 'space :width tree-widget-space-width))) | |
55588 | 651 |
69316 | 652 (defun tree-widget-convert-widget (widget) |
653 "Convert :args as widget types in WIDGET." | |
654 (let ((tree (widget-types-convert-widget widget))) | |
655 ;; Compatibility | |
656 (widget-put tree :expander (or (widget-get tree :expander) | |
657 (widget-get tree :dynargs))) | |
658 tree)) | |
659 | |
55588 | 660 (defun tree-widget-value-create (tree) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
661 "Create the TREE tree-widget." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
662 (let* ((node (tree-widget-node tree)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
663 (flags (widget-get tree :tree-widget--guide-flags)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
664 (indent (widget-get tree :indent)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
665 ;; Setup widget's image support. Looking up for images, and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
666 ;; setting widgets' :tag-glyph is done here, to allow to |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
667 ;; dynamically change the image theme. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
668 (widget-image-enable (tree-widget-use-image-p)) ; Emacs |
55588 | 669 (widget-glyph-enable widget-image-enable) ; XEmacs |
670 children buttons) | |
63482
0f66f455f7d7
(tree-widget-value-create): Simplify last change.
David Ponce <david@dponce.com>
parents:
63467
diff
changeset
|
671 (and indent (not (widget-get tree :parent)) |
63467
c4d3f401bf34
eval-and-compile inlined functions so they will
David Ponce <david@dponce.com>
parents:
63465
diff
changeset
|
672 (insert-char ?\ indent)) |
55588 | 673 (if (widget-get tree :open) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
674 ;;;; Expanded node. |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
675 (let ((args (widget-get tree :args)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
676 (guide (widget-get tree :guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
677 (noguide (widget-get tree :no-guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
678 (endguide (widget-get tree :end-guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
679 (handle (widget-get tree :handle)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
680 (nohandle (widget-get tree :no-handle)) |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
681 (guidi (tree-widget-find-image "guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
682 (noguidi (tree-widget-find-image "no-guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
683 (endguidi (tree-widget-find-image "end-guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
684 (handli (tree-widget-find-image "handle")) |
64985 | 685 (nohandli (tree-widget-find-image "no-handle"))) |
69316 | 686 ;; Request children at run time, when requested. |
687 (when (and (widget-get tree :expander) | |
688 (widget-apply tree :expander-p)) | |
689 (setq args (mapcar 'widget-convert | |
690 (widget-apply tree :expander))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
691 (widget-put tree :args args)) |
65613
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
692 ;; Defer the node widget creation after icon creation. |
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
693 (widget-put tree :node (widget-convert node)) |
64985 | 694 ;; Create the icon widget for the expanded tree. |
55588 | 695 (push (widget-create-child-and-convert |
65649
e2b8d96a5a4f
(tree-widget-value-create): Fix previous change.
David Ponce <david@dponce.com>
parents:
65613
diff
changeset
|
696 tree (widget-get tree (if args :open-icon :empty-icon)) |
e2b8d96a5a4f
(tree-widget-value-create): Fix previous change.
David Ponce <david@dponce.com>
parents:
65613
diff
changeset
|
697 ;; Pass the node widget to child. |
e2b8d96a5a4f
(tree-widget-value-create): Fix previous change.
David Ponce <david@dponce.com>
parents:
65613
diff
changeset
|
698 :node (widget-get tree :node)) |
55588 | 699 buttons) |
64985 | 700 ;; Create the tree node widget. |
65613
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
701 (push (widget-create-child tree (widget-get tree :node)) |
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
702 children) |
64985 | 703 ;; Update the icon :node with the created node widget. |
704 (widget-put (car buttons) :node (car children)) | |
705 ;; Create the tree children. | |
55588 | 706 (while args |
64985 | 707 (setq node (car args) |
708 args (cdr args)) | |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
709 (and indent (insert-char ?\ indent)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
710 ;; Insert guide lines elements from previous levels. |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
711 (dolist (f (reverse flags)) |
55588 | 712 (widget-create-child-and-convert |
713 tree (if f guide noguide) | |
714 :tag-glyph (if f guidi noguidi)) | |
715 (widget-create-child-and-convert | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
716 tree nohandle :tag-glyph nohandli)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
717 ;; Insert guide line element for this level. |
55588 | 718 (widget-create-child-and-convert |
719 tree (if args guide endguide) | |
720 :tag-glyph (if args guidi endguidi)) | |
721 ;; Insert the node handle line | |
722 (widget-create-child-and-convert | |
723 tree handle :tag-glyph handli) | |
64985 | 724 (if (tree-widget-p node) |
725 ;; Create a sub-tree node. | |
726 (push (widget-create-child-and-convert | |
727 tree node :tree-widget--guide-flags | |
728 (cons (if args t) flags)) | |
729 children) | |
730 ;; Create the icon widget for a leaf node. | |
55588 | 731 (push (widget-create-child-and-convert |
64985 | 732 tree (widget-get tree :leaf-icon) |
733 ;; At this point the node widget isn't yet created. | |
734 :node (setq node (widget-convert | |
735 node :tree-widget--guide-flags | |
736 (cons (if args t) flags))) | |
737 :tree-widget--leaf-flag t) | |
738 buttons) | |
739 ;; Create the leaf node widget. | |
740 (push (widget-create-child tree node) children) | |
741 ;; Update the icon :node with the created node widget. | |
742 (widget-put (car buttons) :node (car children))))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
743 ;;;; Collapsed node. |
65613
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
744 ;; Defer the node widget creation after icon creation. |
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
745 (widget-put tree :node (widget-convert node)) |
64985 | 746 ;; Create the icon widget for the collapsed tree. |
55588 | 747 (push (widget-create-child-and-convert |
65649
e2b8d96a5a4f
(tree-widget-value-create): Fix previous change.
David Ponce <david@dponce.com>
parents:
65613
diff
changeset
|
748 tree (widget-get tree :close-icon) |
e2b8d96a5a4f
(tree-widget-value-create): Fix previous change.
David Ponce <david@dponce.com>
parents:
65613
diff
changeset
|
749 ;; Pass the node widget to child. |
e2b8d96a5a4f
(tree-widget-value-create): Fix previous change.
David Ponce <david@dponce.com>
parents:
65613
diff
changeset
|
750 :node (widget-get tree :node)) |
55588 | 751 buttons) |
64985 | 752 ;; Create the tree node widget. |
65613
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
753 (push (widget-create-child tree (widget-get tree :node)) |
cc7dd4ad84cd
(tree-widget-value-create): Save the converted tree :node widget.
David Ponce <david@dponce.com>
parents:
64985
diff
changeset
|
754 children) |
64985 | 755 ;; Update the icon :node with the created node widget. |
756 (widget-put (car buttons) :node (car children))) | |
757 ;; Save widget children and buttons. The tree-widget :node child | |
758 ;; is the first element in :children. | |
55588 | 759 (widget-put tree :children (nreverse children)) |
64985 | 760 (widget-put tree :buttons buttons))) |
761 | |
762 ;;; Widget callbacks | |
763 ;; | |
764 (defsubst tree-widget-leaf-node-icon-p (icon) | |
765 "Return non-nil if ICON is a leaf node icon. | |
766 That is, if its :node property value is a leaf node widget." | |
767 (widget-get icon :tree-widget--leaf-flag)) | |
768 | |
769 (defun tree-widget-icon-action (icon &optional event) | |
770 "Handle the ICON widget :action. | |
771 If ICON :node is a leaf node it handles the :action. The tree-widget | |
772 parent of ICON handles the :action otherwise. | |
773 Pass the received EVENT to :action." | |
774 (let ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon) | |
775 :node :parent)))) | |
776 (widget-apply node :action event))) | |
777 | |
778 (defun tree-widget-icon-help-echo (icon) | |
779 "Return the help-echo string of ICON. | |
780 If ICON :node is a leaf node it handles the :help-echo. The tree-widget | |
781 parent of ICON handles the :help-echo otherwise." | |
782 (let* ((node (widget-get icon (if (tree-widget-leaf-node-icon-p icon) | |
783 :node :parent))) | |
784 (help-echo (widget-get node :help-echo))) | |
785 (if (functionp help-echo) | |
786 (funcall help-echo node) | |
787 help-echo))) | |
788 | |
789 (defvar tree-widget-after-toggle-functions nil | |
790 "Hooks run after toggling a tree-widget expansion. | |
791 Each function is passed a tree-widget. If the value of the :open | |
792 property is non-nil the tree has been expanded, else collapsed. | |
793 This hook should be local in the buffer setup to display widgets.") | |
794 | |
795 (defun tree-widget-action (tree &optional event) | |
796 "Handle the :action of the TREE tree-widget. | |
797 That is, toggle expansion of the TREE tree-widget. | |
798 Ignore the EVENT argument." | |
799 (let ((open (not (widget-get tree :open)))) | |
800 (or open | |
801 ;; Before to collapse the node, save children values so next | |
802 ;; open can recover them. | |
803 (tree-widget-children-value-save tree)) | |
804 (widget-put tree :open open) | |
805 (widget-value-set tree open) | |
806 (run-hook-with-args 'tree-widget-after-toggle-functions tree))) | |
807 | |
808 (defun tree-widget-help-echo (tree) | |
809 "Return the help-echo string of the TREE tree-widget." | |
810 (if (widget-get tree :open) | |
811 "Collapse node" | |
812 "Expand node")) | |
55588 | 813 |
69316 | 814 (defun tree-widget-expander-p (tree) |
815 "Return non-nil if the TREE tree-widget :expander has to be called. | |
816 That is, if TREE :args is nil." | |
817 (null (widget-get tree :args))) | |
818 | |
55588 | 819 (provide 'tree-widget) |
820 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
821 ;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8 |
55588 | 822 ;;; tree-widget.el ends here |