Mercurial > emacs
annotate lisp/tree-widget.el @ 65463:c1c7dc22a3c4
*** empty log message ***
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Mon, 12 Sep 2005 13:42:15 +0000 |
parents | 293aca58a37e |
children | cc7dd4ad84cd |
rev | line source |
---|---|
55588 | 1 ;;; tree-widget.el --- Tree widget |
2 | |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
3 ;; Copyright (C) 2004, 2005 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 | |
12 ;; This program is free software; you can redistribute it and/or | |
13 ;; modify it under the terms of the GNU General Public License as | |
14 ;; published by the Free Software Foundation; either version 2, or (at | |
15 ;; your option) any later version. | |
16 | |
17 ;; This program is distributed in the hope that it will be useful, but | |
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
20 ;; General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with this program; see the file COPYING. If not, write to | |
64091 | 24 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02110-1301, USA. | |
55588 | 26 |
27 ;;; Commentary: | |
28 ;; | |
29 ;; This library provide a tree widget useful to display data | |
30 ;; structures organized in a hierarchical order. | |
31 ;; | |
32 ;; The following properties are specific to the tree widget: | |
33 ;; | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
34 ;; :open |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
35 ;; 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
|
36 ;; collapsed. |
55588 | 37 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
38 ;; :node |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
39 ;; 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
|
40 ;; By default this is an `item' widget which displays the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
41 ;; tree-widget :tag property value if defined, or a string |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
42 ;; representation of the tree-widget value. |
55588 | 43 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
44 ;; :keep |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
45 ;; 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
|
46 ;; 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
|
47 ;; property can be used in child widgets too. |
55588 | 48 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
49 ;; :expander (obsoletes :dynargs) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
50 ;; Specify a function to be called to dynamically provide the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
51 ;; 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
|
52 ;; will be passed the tree widget and must return a list of child |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
53 ;; widgets. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
54 ;; |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
55 ;; *Please note:* Child widgets returned by the :expander function |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
56 ;; are stored in the :args property of the tree widget. To speed |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
57 ;; up successive expand requests, the :expander function is not |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
58 ;; called again when the :args value is non-nil. To refresh child |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
59 ;; values, it is necessary to set the :args property to nil, then |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
60 ;; 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 | |
128 (defcustom tree-widget-image-enable | |
129 (not (or (featurep 'xemacs) (< emacs-major-version 21))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
130 "*Non-nil means that tree-widget will try to use images." |
55588 | 131 :type 'boolean |
132 :group 'tree-widget) | |
133 | |
134 (defcustom tree-widget-themes-directory "tree-widget" | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
135 "*Name of the directory where to look up for image themes. |
55588 | 136 When nil use the directory where the tree-widget library is located. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
137 When a relative name is specified, try to locate that sub directory in |
55588 | 138 `load-path', then in the data directory, and use the first one found. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
139 The data directory is the value of the variable `data-directory' on |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
140 Emacs, and what `(locate-data-directory \"tree-widget\")' returns on |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
141 XEmacs. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
142 The default is to use the \"tree-widget\" relative name." |
55588 | 143 :type '(choice (const :tag "Default" "tree-widget") |
144 (const :tag "With the library" nil) | |
145 (directory :format "%{%t%}:\n%v")) | |
146 :group 'tree-widget) | |
147 | |
148 (defcustom tree-widget-theme nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
149 "*Name of the theme where to look up for images. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
150 It must be a sub directory of the directory specified in variable |
64985 | 151 `tree-widget-themes-directory'. The default theme is \"default\". |
152 When an image is not found in a theme, it is searched in the default | |
153 theme. | |
55588 | 154 |
64985 | 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 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
158 \"guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
159 A vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
160 \"no-guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
161 An invisible vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
162 \"end-guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
163 End of a vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
164 \"handle\" |
64985 | 165 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
|
166 \"no-handle\" |
64985 | 167 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." | |
55588 | 180 :type '(choice (const :tag "Default" nil) |
181 (string :tag "Name")) | |
182 :group 'tree-widget) | |
183 | |
184 (defcustom tree-widget-image-properties-emacs | |
185 '(:ascent center :mask (heuristic t)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
186 "*Default properties of Emacs images." |
55588 | 187 :type 'plist |
188 :group 'tree-widget) | |
189 | |
190 (defcustom tree-widget-image-properties-xemacs | |
191 nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
192 "*Default properties of XEmacs images." |
55588 | 193 :type 'plist |
194 :group 'tree-widget) | |
64985 | 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) | |
55588 | 201 |
202 ;;; Image support | |
203 ;; | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
204 (eval-and-compile ;; Emacs/XEmacs compatibility stuff |
55588 | 205 (cond |
206 ;; XEmacs | |
207 ((featurep 'xemacs) | |
208 (defsubst tree-widget-use-image-p () | |
209 "Return non-nil if image support is currently enabled." | |
210 (and tree-widget-image-enable | |
211 widget-glyph-enable | |
212 (console-on-window-system-p))) | |
213 (defsubst tree-widget-create-image (type file &optional props) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
214 "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
|
215 Give the image the specified properties PROPS." |
55588 | 216 (apply 'make-glyph `([,type :file ,file ,@props]))) |
217 (defsubst tree-widget-image-formats () | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
218 "Return the alist of image formats/file name extensions. |
55588 | 219 See also the option `widget-image-file-name-suffixes'." |
220 (delq nil | |
221 (mapcar | |
222 #'(lambda (fmt) | |
223 (and (valid-image-instantiator-format-p (car fmt)) fmt)) | |
224 widget-image-file-name-suffixes))) | |
225 ) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
226 ;; Emacs |
55588 | 227 (t |
228 (defsubst tree-widget-use-image-p () | |
229 "Return non-nil if image support is currently enabled." | |
230 (and tree-widget-image-enable | |
231 widget-image-enable | |
232 (display-images-p))) | |
233 (defsubst tree-widget-create-image (type file &optional props) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
234 "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
|
235 Give the image the specified properties PROPS." |
55588 | 236 (apply 'create-image `(,file ,type nil ,@props))) |
237 (defsubst tree-widget-image-formats () | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
238 "Return the alist of image formats/file name extensions. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
239 See also the option `widget-image-file-name-suffixes'." |
55588 | 240 (delq nil |
241 (mapcar | |
242 #'(lambda (fmt) | |
243 (and (image-type-available-p (car fmt)) fmt)) | |
244 widget-image-conversion))) | |
245 )) | |
246 ) | |
247 | |
248 ;; Buffer local cache of theme data. | |
249 (defvar tree-widget--theme nil) | |
250 | |
251 (defsubst tree-widget-theme-name () | |
252 "Return the current theme name, or nil if no theme is active." | |
253 (and tree-widget--theme (aref tree-widget--theme 0))) | |
254 | |
255 (defsubst tree-widget-set-theme (&optional name) | |
256 "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
|
257 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
|
258 Optional argument NAME is the name of the theme to use. It defaults |
55588 | 259 to the value of the variable `tree-widget-theme'. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
260 Does nothing if NAME is already the current theme." |
55588 | 261 (or name (setq name (or tree-widget-theme "default"))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
262 (unless (string-equal name (tree-widget-theme-name)) |
55588 | 263 (set (make-local-variable 'tree-widget--theme) |
264 (make-vector 4 nil)) | |
265 (aset tree-widget--theme 0 name))) | |
266 | |
267 (defun tree-widget-themes-directory () | |
268 "Locate the directory where to search for a theme. | |
269 It is defined in variable `tree-widget-themes-directory'. | |
270 Return the absolute name of the directory found, or nil if the | |
271 specified directory is not accessible." | |
272 (let ((found (aref tree-widget--theme 1))) | |
273 (if found | |
274 ;; The directory is available in the cache. | |
275 (unless (eq found 'void) found) | |
276 (cond | |
277 ;; Use the directory where tree-widget is located. | |
278 ((null tree-widget-themes-directory) | |
279 (setq found (locate-library "tree-widget")) | |
280 (when found | |
281 (setq found (file-name-directory found)) | |
282 (or (file-accessible-directory-p found) | |
283 (setq found nil)))) | |
284 ;; Check accessibility of absolute directory name. | |
285 ((file-name-absolute-p tree-widget-themes-directory) | |
286 (setq found (expand-file-name tree-widget-themes-directory)) | |
287 (or (file-accessible-directory-p found) | |
288 (setq found nil))) | |
289 ;; Locate a sub-directory in `load-path' and data directory. | |
290 (t | |
291 (let ((path | |
292 (append load-path | |
293 (list (if (fboundp 'locate-data-directory) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
294 ;; XEmacs |
55588 | 295 (locate-data-directory "tree-widget") |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
296 ;; Emacs |
55588 | 297 data-directory))))) |
298 (while (and path (not found)) | |
299 (when (car path) | |
300 (setq found (expand-file-name | |
301 tree-widget-themes-directory (car path))) | |
302 (or (file-accessible-directory-p found) | |
303 (setq found nil))) | |
304 (setq path (cdr path)))))) | |
305 ;; Store the result in the cache for later use. | |
306 (aset tree-widget--theme 1 (or found 'void)) | |
307 found))) | |
308 | |
309 (defsubst tree-widget-set-image-properties (props) | |
310 "In current theme, set images properties to PROPS." | |
311 (aset tree-widget--theme 2 props)) | |
312 | |
313 (defun tree-widget-image-properties (file) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
314 "Return the properties of an image in current theme. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
315 FILE is the absolute file name of an image. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
316 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
317 If there is a \"tree-widget-theme-setup\" library in the theme |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
318 directory, where is located FILE, load it to setup theme images |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
319 properties. Typically it should contain something like this: |
55588 | 320 |
321 (tree-widget-set-image-properties | |
322 (if (featurep 'xemacs) | |
323 '(:ascent center) | |
324 '(:ascent center :mask (heuristic t)) | |
325 )) | |
326 | |
64985 | 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. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
329 Default global properties are provided for respectively Emacs and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
330 XEmacs in the variables `tree-widget-image-properties-emacs', and |
55588 | 331 `tree-widget-image-properties-xemacs'." |
332 ;; If properties are in the cache, use them. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
333 (let ((plist (aref tree-widget--theme 2))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
334 (unless plist |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
335 ;; Load tree-widget-theme-setup if available. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
336 (load (expand-file-name "tree-widget-theme-setup" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
337 (file-name-directory file)) t t) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
338 ;; If properties have been setup, use them. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
339 (unless (setq plist (aref tree-widget--theme 2)) |
64985 | 340 ;; Try from the default theme. |
341 (load (expand-file-name "../default/tree-widget-theme-setup" | |
342 (file-name-directory file)) t t) | |
343 ;; If properties have been setup, use them. | |
344 (unless (setq plist (aref tree-widget--theme 2)) | |
345 ;; 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)))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
351 plist)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
352 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
353 (defconst tree-widget--cursors |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
354 ;; Pointer shapes when the mouse pointer is over tree-widget images. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
355 ;; This feature works since Emacs 22, and ignored on older versions, |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
356 ;; and XEmacs. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
357 '( |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
358 ("guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
359 ("no-guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
360 ("end-guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
361 ("handle" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
362 ("no-handle" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
363 )) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
364 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
365 (defun tree-widget-lookup-image (name) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
366 "Look up in current theme for an image with NAME. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
367 Search first in current theme, then in default theme (see also the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
368 variable `tree-widget-theme'). |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
369 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
|
370 found." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
371 (let ((default-directory (tree-widget-themes-directory))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
372 (when default-directory |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
373 (let (file (theme (tree-widget-theme-name))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
374 (catch 'found |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
375 (dolist (dir (if (string-equal theme "default") |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
376 '("default") (list theme "default"))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
377 (dolist (fmt (tree-widget-image-formats)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
378 (dolist (ext (cdr fmt)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
379 (setq file (expand-file-name (concat name ext) dir)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
380 (and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
381 (file-readable-p file) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
382 (file-regular-p file) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
383 (throw |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
384 'found |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
385 (tree-widget-create-image |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
386 (car fmt) file |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
387 ;; Add the pointer shape |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
388 (cons :pointer |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
389 (cons |
64985 | 390 (or (cdr (assoc name tree-widget--cursors)) |
391 'hand) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
392 (tree-widget-image-properties file))))))))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
393 nil))))) |
55588 | 394 |
395 (defun tree-widget-find-image (name) | |
396 "Find the image with NAME in current theme. | |
397 NAME is an image file name sans extension. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
398 Return the image found, or nil if not found." |
55588 | 399 (when (tree-widget-use-image-p) |
400 ;; Ensure there is an active theme. | |
401 (tree-widget-set-theme (tree-widget-theme-name)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
402 (let ((image (assoc name (aref tree-widget--theme 3)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
403 ;; The image NAME is found in the cache. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
404 (if image |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
405 (cdr image) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
406 ;; Search the image in current, and default themes. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
407 (prog1 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
408 (setq image (tree-widget-lookup-image name)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
409 ;; Store image reference in the cache for later use. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
410 (push (cons name image) (aref tree-widget--theme 3)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
411 ))) |
55588 | 412 |
413 ;;; Widgets | |
414 ;; | |
415 (defvar tree-widget-button-keymap | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
416 (let ((km (make-sparse-keymap))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
417 (if (boundp 'widget-button-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
418 ;; XEmacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
419 (progn |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
420 (set-keymap-parent km widget-button-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
421 (define-key km [button1] 'widget-button-click)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
422 ;; Emacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
423 (set-keymap-parent km widget-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
424 (define-key km [down-mouse-1] 'widget-button-click)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
425 km) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
426 "Keymap used inside node buttons. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
427 Handle mouse button 1 click on buttons.") |
55588 | 428 |
64985 | 429 (define-widget 'tree-widget-icon 'push-button |
430 "Basic widget other tree-widget icons are derived from." | |
55588 | 431 :format "%[%t%]" |
432 :button-keymap tree-widget-button-keymap ; XEmacs | |
433 :keymap tree-widget-button-keymap ; Emacs | |
64985 | 434 :create 'tree-widget-icon-create |
435 :action 'tree-widget-icon-action | |
436 :help-echo 'tree-widget-icon-help-echo | |
55588 | 437 ) |
438 | |
64985 | 439 (define-widget 'tree-widget-open-icon 'tree-widget-icon |
440 "Icon for an expanded tree-widget node." | |
441 :tag "[-]" | |
442 :glyph-name "open" | |
55588 | 443 ) |
444 | |
64985 | 445 (define-widget 'tree-widget-empty-icon 'tree-widget-icon |
446 "Icon for an expanded tree-widget node with no child." | |
447 :tag "[X]" | |
448 :glyph-name "empty" | |
55588 | 449 ) |
450 | |
64985 | 451 (define-widget 'tree-widget-close-icon 'tree-widget-icon |
452 "Icon for a collapsed tree-widget node." | |
453 :tag "[+]" | |
454 :glyph-name "close" | |
55588 | 455 ) |
456 | |
64985 | 457 (define-widget 'tree-widget-leaf-icon 'tree-widget-icon |
458 "Icon for a tree-widget leaf node." | |
459 :tag "" | |
460 :glyph-name "leaf" | |
461 :button-face 'default | |
55588 | 462 ) |
463 | |
464 (define-widget 'tree-widget-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
465 "Vertical guide line." |
55588 | 466 :tag " |" |
467 ;;:tag-glyph (tree-widget-find-image "guide") | |
468 :format "%t" | |
469 ) | |
470 | |
471 (define-widget 'tree-widget-end-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
472 "End of a vertical guide line." |
55588 | 473 :tag " `" |
474 ;;:tag-glyph (tree-widget-find-image "end-guide") | |
475 :format "%t" | |
476 ) | |
477 | |
478 (define-widget 'tree-widget-no-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
479 "Invisible vertical guide line." |
55588 | 480 :tag " " |
481 ;;:tag-glyph (tree-widget-find-image "no-guide") | |
482 :format "%t" | |
483 ) | |
484 | |
485 (define-widget 'tree-widget-handle 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
486 "Horizontal guide line that joins a vertical guide line to a node." |
64985 | 487 :tag "-" |
55588 | 488 ;;:tag-glyph (tree-widget-find-image "handle") |
489 :format "%t" | |
490 ) | |
491 | |
492 (define-widget 'tree-widget-no-handle 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
493 "Invisible handle." |
55588 | 494 :tag " " |
495 ;;:tag-glyph (tree-widget-find-image "no-handle") | |
496 :format "%t" | |
497 ) | |
498 | |
499 (define-widget 'tree-widget 'default | |
500 "Tree widget." | |
501 :format "%v" | |
502 :convert-widget 'widget-types-convert-widget | |
503 :value-get 'widget-value-value-get | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
504 :value-delete 'widget-children-value-delete |
55588 | 505 :value-create 'tree-widget-value-create |
64985 | 506 :action 'tree-widget-action |
507 :help-echo 'tree-widget-help-echo | |
508 :open-icon 'tree-widget-open-icon | |
509 :close-icon 'tree-widget-close-icon | |
510 :empty-icon 'tree-widget-empty-icon | |
511 :leaf-icon 'tree-widget-leaf-icon | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
512 :guide 'tree-widget-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
513 :end-guide 'tree-widget-end-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
514 :no-guide 'tree-widget-no-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
515 :handle 'tree-widget-handle |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
516 :no-handle 'tree-widget-no-handle |
55588 | 517 ) |
518 | |
519 ;;; Widget support functions | |
520 ;; | |
521 (defun tree-widget-p (widget) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
522 "Return non-nil if WIDGET is a tree-widget." |
55588 | 523 (let ((type (widget-type widget))) |
524 (while (and type (not (eq type 'tree-widget))) | |
525 (setq type (widget-type (get type 'widget-type)))) | |
526 (eq type 'tree-widget))) | |
527 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
528 (defun tree-widget-node (widget) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
529 "Return WIDGET's :node child widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
530 If not found, setup an `item' widget as default. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
531 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
|
532 WIDGET is, or derives from, a tree-widget." |
55588 | 533 (let ((node (widget-get widget :node))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
534 (if node |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
535 ;; Check that the :node widget is not a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
536 (and (tree-widget-p node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
537 (error "Invalid tree-widget :node %S" node)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
538 ;; Setup an item widget as default :node. |
55588 | 539 (setq node `(item :tag ,(or (widget-get widget :tag) |
540 (widget-princ-to-string | |
541 (widget-value widget))))) | |
542 (widget-put widget :node node)) | |
543 node)) | |
544 | |
545 (defun tree-widget-keep (arg widget) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
546 "Save in ARG the WIDGET's properties specified by :keep." |
55588 | 547 (dolist (prop (widget-get widget :keep)) |
548 (widget-put arg prop (widget-get widget prop)))) | |
549 | |
550 (defun tree-widget-children-value-save (widget &optional args node) | |
551 "Save WIDGET children values. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
552 WIDGET is, or derives from, a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
553 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
|
554 WIDGET's :args property value. Properties and values of the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
555 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
|
556 WIDGET's :node sub-widget." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
557 (let ((args (cons (or node (widget-get widget :node)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
558 (or args (widget-get widget :args)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
559 (children (widget-get widget :children)) |
55588 | 560 arg child) |
561 (while (and args children) | |
562 (setq arg (car args) | |
563 args (cdr args) | |
564 child (car children) | |
565 children (cdr children)) | |
566 (if (tree-widget-p child) | |
567 ;;;; The child is a tree node. | |
568 (progn | |
569 ;; Backtrack :args and :node properties. | |
570 (widget-put arg :args (widget-get child :args)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
571 (widget-put arg :node (widget-get child :node)) |
55588 | 572 ;; Save :open property. |
573 (widget-put arg :open (widget-get child :open)) | |
574 ;; The node is open. | |
575 (when (widget-get child :open) | |
576 ;; Save the widget value. | |
577 (widget-put arg :value (widget-value child)) | |
578 ;; Save properties specified in :keep. | |
579 (tree-widget-keep arg child) | |
580 ;; Save children. | |
581 (tree-widget-children-value-save | |
582 child (widget-get arg :args) (widget-get arg :node)))) | |
583 ;;;; Another non tree node. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
584 ;; Save the widget value. |
55588 | 585 (widget-put arg :value (widget-value child)) |
586 ;; Save properties specified in :keep. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
587 (tree-widget-keep arg child))))) |
64985 | 588 |
589 ;;; Widget creation | |
590 ;; | |
591 (defvar tree-widget-before-create-icon-functions nil | |
592 "Hooks run before to create a tree-widget icon. | |
593 Each function is passed the icon widget not yet created. | |
594 The value of the icon widget :node property is a tree :node widget or | |
595 a leaf node widget, not yet created. | |
596 This hook can be used to dynamically change properties of the icon and | |
597 associated node widgets. For example, to dynamically change the look | |
598 and feel of the tree-widget by changing the values of the :tag | |
599 and :glyph-name properties of the icon widget. | |
600 This hook should be local in the buffer setup to display widgets.") | |
55588 | 601 |
64985 | 602 (defun tree-widget-icon-create (icon) |
603 "Create the ICON widget." | |
604 (run-hook-with-args 'tree-widget-before-create-icon-functions icon) | |
605 (widget-put icon :tag-glyph | |
606 (tree-widget-find-image (widget-get icon :glyph-name))) | |
607 ;; Ensure there is at least one char to display the image. | |
608 (and (widget-get icon :tag-glyph) | |
609 (equal "" (or (widget-get icon :tag) "")) | |
610 (widget-put icon :tag " ")) | |
611 (widget-default-create icon) | |
612 ;; Insert space between the icon and the node widget. | |
613 (insert-char ? 1) | |
614 (put-text-property | |
615 (1- (point)) (point) | |
616 'display (list 'space :width tree-widget-space-width))) | |
55588 | 617 |
618 (defun tree-widget-value-create (tree) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
619 "Create the TREE tree-widget." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
620 (let* ((node (tree-widget-node tree)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
621 (flags (widget-get tree :tree-widget--guide-flags)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
622 (indent (widget-get tree :indent)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
623 ;; Setup widget's image support. Looking up for images, and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
624 ;; setting widgets' :tag-glyph is done here, to allow to |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
625 ;; dynamically change the image theme. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
626 (widget-image-enable (tree-widget-use-image-p)) ; Emacs |
55588 | 627 (widget-glyph-enable widget-image-enable) ; XEmacs |
628 children buttons) | |
63482
0f66f455f7d7
(tree-widget-value-create): Simplify last change.
David Ponce <david@dponce.com>
parents:
63467
diff
changeset
|
629 (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
|
630 (insert-char ?\ indent)) |
55588 | 631 (if (widget-get tree :open) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
632 ;;;; Expanded node. |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
633 (let ((args (widget-get tree :args)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
634 (xpandr (or (widget-get tree :expander) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
635 (widget-get tree :dynargs))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
636 (guide (widget-get tree :guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
637 (noguide (widget-get tree :no-guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
638 (endguide (widget-get tree :end-guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
639 (handle (widget-get tree :handle)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
640 (nohandle (widget-get tree :no-handle)) |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
641 (guidi (tree-widget-find-image "guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
642 (noguidi (tree-widget-find-image "no-guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
643 (endguidi (tree-widget-find-image "end-guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
644 (handli (tree-widget-find-image "handle")) |
64985 | 645 (nohandli (tree-widget-find-image "no-handle"))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
646 ;; Request children at run time, when not already done. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
647 (when (and (not args) xpandr) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
648 (setq args (mapcar 'widget-convert (funcall xpandr tree))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
649 (widget-put tree :args args)) |
64985 | 650 ;; Create the icon widget for the expanded tree. |
55588 | 651 (push (widget-create-child-and-convert |
64985 | 652 tree (widget-get tree (if args :open-icon :empty-icon)) |
653 ;; At this point the node widget isn't yet created. | |
654 :node (setq node (widget-convert node))) | |
55588 | 655 buttons) |
64985 | 656 ;; Create the tree node widget. |
657 (push (widget-create-child tree node) children) | |
658 ;; Update the icon :node with the created node widget. | |
659 (widget-put (car buttons) :node (car children)) | |
660 ;; Create the tree children. | |
55588 | 661 (while args |
64985 | 662 (setq node (car args) |
663 args (cdr args)) | |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
664 (and indent (insert-char ?\ indent)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
665 ;; Insert guide lines elements from previous levels. |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
666 (dolist (f (reverse flags)) |
55588 | 667 (widget-create-child-and-convert |
668 tree (if f guide noguide) | |
669 :tag-glyph (if f guidi noguidi)) | |
670 (widget-create-child-and-convert | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
671 tree nohandle :tag-glyph nohandli)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
672 ;; Insert guide line element for this level. |
55588 | 673 (widget-create-child-and-convert |
674 tree (if args guide endguide) | |
675 :tag-glyph (if args guidi endguidi)) | |
676 ;; Insert the node handle line | |
677 (widget-create-child-and-convert | |
678 tree handle :tag-glyph handli) | |
64985 | 679 (if (tree-widget-p node) |
680 ;; 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. | |
55588 | 686 (push (widget-create-child-and-convert |
64985 | 687 tree (widget-get tree :leaf-icon) |
688 ;; At this point the node widget isn't yet created. | |
689 :node (setq node (widget-convert | |
690 node :tree-widget--guide-flags | |
691 (cons (if args t) flags))) | |
692 :tree-widget--leaf-flag t) | |
693 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))))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
698 ;;;; Collapsed node. |
64985 | 699 ;; Create the icon widget for the collapsed tree. |
55588 | 700 (push (widget-create-child-and-convert |
64985 | 701 tree (widget-get tree :close-icon) |
702 ;; At this point the node widget isn't yet created. | |
703 :node (setq node (widget-convert node))) | |
55588 | 704 buttons) |
64985 | 705 ;; Create the tree node widget. |
706 (push (widget-create-child tree node) children) | |
707 ;; Update the icon :node with the created node widget. | |
708 (widget-put (car buttons) :node (car children))) | |
709 ;; Save widget children and buttons. The tree-widget :node child | |
710 ;; is the first element in :children. | |
55588 | 711 (widget-put tree :children (nreverse children)) |
64985 | 712 (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")) | |
55588 | 765 |
766 (provide 'tree-widget) | |
767 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
768 ;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8 |
55588 | 769 ;;; tree-widget.el ends here |