Mercurial > emacs
annotate lisp/tree-widget.el @ 64749:5e716228ee1e
Update "copyright years" section.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Sat, 06 Aug 2005 16:20:52 +0000 |
parents | 6fb026ad601f |
children | 293aca58a37e |
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 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
62 ;; :open-control (default `tree-widget-open-control') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
63 ;; :close-control (default `tree-widget-close-control') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
64 ;; :empty-control (default `tree-widget-empty-control') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
65 ;; :leaf-control (default `tree-widget-leaf-control') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
66 ;; :guide (default `tree-widget-guide') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
67 ;; :end-guide (default `tree-widget-end-guide') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
68 ;; :no-guide (default `tree-widget-no-guide') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
69 ;; :handle (default `tree-widget-handle') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
70 ;; :no-handle (default `tree-widget-no-handle') |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
71 ;; Those properties define the widgets used to draw the tree, and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
72 ;; permit to customize its look and feel. For example, using |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
73 ;; `item' widgets with these :tag values: |
55588 | 74 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
75 ;; open-control "[-] " (OC) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
76 ;; close-control "[+] " (CC) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
77 ;; empty-control "[X] " (EC) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
78 ;; leaf-control "[>] " (LC) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
79 ;; guide " |" (GU) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
80 ;; noguide " " (NG) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
81 ;; end-guide " `" (EG) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
82 ;; handle "-" (HA) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
83 ;; no-handle " " (NH) |
55588 | 84 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
85 ;; A tree will look like this: |
55588 | 86 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
87 ;; [-] 1 (OC :node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
88 ;; |-[+] 1.0 (GU+HA+CC :node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
89 ;; |-[X] 1.1 (GU+HA+EC :node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
90 ;; `-[-] 1.2 (EG+HA+OC :node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
91 ;; |-[>] 1.2.1 (NG+NH+GU+HA+LC child) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
92 ;; `-[>] 1.2.2 (NG+NH+EG+HA+LC child) |
55588 | 93 ;; |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
94 ;; 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
|
95 ;; nice-looking tree. See the `tree-widget-image-enable', |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
96 ;; `tree-widget-themes-directory', and `tree-widget-theme' options for |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
97 ;; more details. |
55588 | 98 |
99 ;;; History: | |
100 ;; | |
101 | |
102 ;;; Code: | |
103 (eval-when-compile (require 'cl)) | |
104 (require 'wid-edit) | |
105 | |
106 ;;; Customization | |
107 ;; | |
108 (defgroup tree-widget nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
109 "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
|
110 :version "22.1" |
55588 | 111 :group 'widgets) |
112 | |
113 (defcustom tree-widget-image-enable | |
114 (not (or (featurep 'xemacs) (< emacs-major-version 21))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
115 "*Non-nil means that tree-widget will try to use images." |
55588 | 116 :type 'boolean |
117 :group 'tree-widget) | |
118 | |
119 (defcustom tree-widget-themes-directory "tree-widget" | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
120 "*Name of the directory where to look up for image themes. |
55588 | 121 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
|
122 When a relative name is specified, try to locate that sub directory in |
55588 | 123 `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
|
124 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
|
125 Emacs, and what `(locate-data-directory \"tree-widget\")' returns on |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
126 XEmacs. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
127 The default is to use the \"tree-widget\" relative name." |
55588 | 128 :type '(choice (const :tag "Default" "tree-widget") |
129 (const :tag "With the library" nil) | |
130 (directory :format "%{%t%}:\n%v")) | |
131 :group 'tree-widget) | |
132 | |
133 (defcustom tree-widget-theme nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
134 "*Name of the theme where to look up for images. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
135 It must be a sub directory of the directory specified in variable |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
136 `tree-widget-themes-directory'. The default is \"default\". When an |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
137 image is not found in this theme, the default theme is searched too. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
138 A complete theme must contain images with these file names with a |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
139 supported extension (see also `tree-widget-image-formats'): |
55588 | 140 |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
141 \"open\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
142 Represent an expanded node. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
143 \"close\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
144 Represent a collapsed node. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
145 \"empty\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
146 Represent an expanded node with no child. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
147 \"leaf\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
148 Represent a leaf node. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
149 \"guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
150 A vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
151 \"no-guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
152 An invisible vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
153 \"end-guide\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
154 End of a vertical guide line. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
155 \"handle\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
156 Horizontal guide line that joins the vertical guide line to a node. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
157 \"no-handle\" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
158 An invisible handle." |
55588 | 159 :type '(choice (const :tag "Default" nil) |
160 (string :tag "Name")) | |
161 :group 'tree-widget) | |
162 | |
163 (defcustom tree-widget-image-properties-emacs | |
164 '(:ascent center :mask (heuristic t)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
165 "*Default properties of Emacs images." |
55588 | 166 :type 'plist |
167 :group 'tree-widget) | |
168 | |
169 (defcustom tree-widget-image-properties-xemacs | |
170 nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
171 "*Default properties of XEmacs images." |
55588 | 172 :type 'plist |
173 :group 'tree-widget) | |
174 | |
175 ;;; Image support | |
176 ;; | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
177 (eval-and-compile ;; Emacs/XEmacs compatibility stuff |
55588 | 178 (cond |
179 ;; XEmacs | |
180 ((featurep 'xemacs) | |
181 (defsubst tree-widget-use-image-p () | |
182 "Return non-nil if image support is currently enabled." | |
183 (and tree-widget-image-enable | |
184 widget-glyph-enable | |
185 (console-on-window-system-p))) | |
186 (defsubst tree-widget-create-image (type file &optional props) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
187 "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
|
188 Give the image the specified properties PROPS." |
55588 | 189 (apply 'make-glyph `([,type :file ,file ,@props]))) |
190 (defsubst tree-widget-image-formats () | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
191 "Return the alist of image formats/file name extensions. |
55588 | 192 See also the option `widget-image-file-name-suffixes'." |
193 (delq nil | |
194 (mapcar | |
195 #'(lambda (fmt) | |
196 (and (valid-image-instantiator-format-p (car fmt)) fmt)) | |
197 widget-image-file-name-suffixes))) | |
198 ) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
199 ;; Emacs |
55588 | 200 (t |
201 (defsubst tree-widget-use-image-p () | |
202 "Return non-nil if image support is currently enabled." | |
203 (and tree-widget-image-enable | |
204 widget-image-enable | |
205 (display-images-p))) | |
206 (defsubst tree-widget-create-image (type file &optional props) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
207 "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
|
208 Give the image the specified properties PROPS." |
55588 | 209 (apply 'create-image `(,file ,type nil ,@props))) |
210 (defsubst tree-widget-image-formats () | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
211 "Return the alist of image formats/file name extensions. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
212 See also the option `widget-image-file-name-suffixes'." |
55588 | 213 (delq nil |
214 (mapcar | |
215 #'(lambda (fmt) | |
216 (and (image-type-available-p (car fmt)) fmt)) | |
217 widget-image-conversion))) | |
218 )) | |
219 ) | |
220 | |
221 ;; Buffer local cache of theme data. | |
222 (defvar tree-widget--theme nil) | |
223 | |
224 (defsubst tree-widget-theme-name () | |
225 "Return the current theme name, or nil if no theme is active." | |
226 (and tree-widget--theme (aref tree-widget--theme 0))) | |
227 | |
228 (defsubst tree-widget-set-theme (&optional name) | |
229 "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
|
230 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
|
231 Optional argument NAME is the name of the theme to use. It defaults |
55588 | 232 to the value of the variable `tree-widget-theme'. |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
233 Does nothing if NAME is already the current theme." |
55588 | 234 (or name (setq name (or tree-widget-theme "default"))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
235 (unless (string-equal name (tree-widget-theme-name)) |
55588 | 236 (set (make-local-variable 'tree-widget--theme) |
237 (make-vector 4 nil)) | |
238 (aset tree-widget--theme 0 name))) | |
239 | |
240 (defun tree-widget-themes-directory () | |
241 "Locate the directory where to search for a theme. | |
242 It is defined in variable `tree-widget-themes-directory'. | |
243 Return the absolute name of the directory found, or nil if the | |
244 specified directory is not accessible." | |
245 (let ((found (aref tree-widget--theme 1))) | |
246 (if found | |
247 ;; The directory is available in the cache. | |
248 (unless (eq found 'void) found) | |
249 (cond | |
250 ;; Use the directory where tree-widget is located. | |
251 ((null tree-widget-themes-directory) | |
252 (setq found (locate-library "tree-widget")) | |
253 (when found | |
254 (setq found (file-name-directory found)) | |
255 (or (file-accessible-directory-p found) | |
256 (setq found nil)))) | |
257 ;; Check accessibility of absolute directory name. | |
258 ((file-name-absolute-p tree-widget-themes-directory) | |
259 (setq found (expand-file-name tree-widget-themes-directory)) | |
260 (or (file-accessible-directory-p found) | |
261 (setq found nil))) | |
262 ;; Locate a sub-directory in `load-path' and data directory. | |
263 (t | |
264 (let ((path | |
265 (append load-path | |
266 (list (if (fboundp 'locate-data-directory) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
267 ;; XEmacs |
55588 | 268 (locate-data-directory "tree-widget") |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
269 ;; Emacs |
55588 | 270 data-directory))))) |
271 (while (and path (not found)) | |
272 (when (car path) | |
273 (setq found (expand-file-name | |
274 tree-widget-themes-directory (car path))) | |
275 (or (file-accessible-directory-p found) | |
276 (setq found nil))) | |
277 (setq path (cdr path)))))) | |
278 ;; Store the result in the cache for later use. | |
279 (aset tree-widget--theme 1 (or found 'void)) | |
280 found))) | |
281 | |
282 (defsubst tree-widget-set-image-properties (props) | |
283 "In current theme, set images properties to PROPS." | |
284 (aset tree-widget--theme 2 props)) | |
285 | |
286 (defun tree-widget-image-properties (file) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
287 "Return the properties of an image in current theme. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
288 FILE is the absolute file name of an image. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
289 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
290 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
|
291 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
|
292 properties. Typically it should contain something like this: |
55588 | 293 |
294 (tree-widget-set-image-properties | |
295 (if (featurep 'xemacs) | |
296 '(:ascent center) | |
297 '(:ascent center :mask (heuristic t)) | |
298 )) | |
299 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
300 Default global properties are provided for respectively Emacs and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
301 XEmacs in the variables `tree-widget-image-properties-emacs', and |
55588 | 302 `tree-widget-image-properties-xemacs'." |
303 ;; If properties are in the cache, use them. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
304 (let ((plist (aref tree-widget--theme 2))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
305 (unless plist |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
306 ;; Load tree-widget-theme-setup if available. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
307 (load (expand-file-name "tree-widget-theme-setup" |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
308 (file-name-directory file)) t t) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
309 ;; If properties have been setup, use them. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
310 (unless (setq plist (aref tree-widget--theme 2)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
311 ;; By default, use supplied global properties. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
312 (setq plist (if (featurep 'xemacs) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
313 tree-widget-image-properties-xemacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
314 tree-widget-image-properties-emacs)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
315 ;; Setup the cache. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
316 (tree-widget-set-image-properties plist))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
317 plist)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
318 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
319 (defconst tree-widget--cursors |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
320 ;; 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
|
321 ;; 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
|
322 ;; and XEmacs. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
323 '( |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
324 ("open" . hand ) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
325 ("close" . hand ) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
326 ("empty" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
327 ("leaf" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
328 ("guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
329 ("no-guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
330 ("end-guide" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
331 ("handle" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
332 ("no-handle" . arrow) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
333 )) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
334 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
335 (defun tree-widget-lookup-image (name) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
336 "Look up in current theme for an image with NAME. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
337 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
|
338 variable `tree-widget-theme'). |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
339 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
|
340 found." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
341 (let ((default-directory (tree-widget-themes-directory))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
342 (when default-directory |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
343 (let (file (theme (tree-widget-theme-name))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
344 (catch 'found |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
345 (dolist (dir (if (string-equal theme "default") |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
346 '("default") (list theme "default"))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
347 (dolist (fmt (tree-widget-image-formats)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
348 (dolist (ext (cdr fmt)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
349 (setq file (expand-file-name (concat name ext) dir)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
350 (and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
351 (file-readable-p file) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
352 (file-regular-p file) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
353 (throw |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
354 'found |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
355 (tree-widget-create-image |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
356 (car fmt) file |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
357 ;; Add the pointer shape |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
358 (cons :pointer |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
359 (cons |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
360 (cdr (assoc name tree-widget--cursors)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
361 (tree-widget-image-properties file))))))))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
362 nil))))) |
55588 | 363 |
364 (defun tree-widget-find-image (name) | |
365 "Find the image with NAME in current theme. | |
366 NAME is an image file name sans extension. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
367 Return the image found, or nil if not found." |
55588 | 368 (when (tree-widget-use-image-p) |
369 ;; Ensure there is an active theme. | |
370 (tree-widget-set-theme (tree-widget-theme-name)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
371 (let ((image (assoc name (aref tree-widget--theme 3)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
372 ;; The image NAME is found in the cache. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
373 (if image |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
374 (cdr image) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
375 ;; Search the image in current, and default themes. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
376 (prog1 |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
377 (setq image (tree-widget-lookup-image name)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
378 ;; Store image reference in the cache for later use. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
379 (push (cons name image) (aref tree-widget--theme 3)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
380 ))) |
55588 | 381 |
382 ;;; Widgets | |
383 ;; | |
384 (defvar tree-widget-button-keymap | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
385 (let ((km (make-sparse-keymap))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
386 (if (boundp 'widget-button-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
387 ;; XEmacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
388 (progn |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
389 (set-keymap-parent km widget-button-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
390 (define-key km [button1] 'widget-button-click)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
391 ;; Emacs |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
392 (set-keymap-parent km widget-keymap) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
393 (define-key km [down-mouse-1] 'widget-button-click)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
394 km) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
395 "Keymap used inside node buttons. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
396 Handle mouse button 1 click on buttons.") |
55588 | 397 |
398 (define-widget 'tree-widget-control 'push-button | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
399 "Basic widget other tree-widget node buttons are derived from." |
55588 | 400 :format "%[%t%]" |
401 :button-keymap tree-widget-button-keymap ; XEmacs | |
402 :keymap tree-widget-button-keymap ; Emacs | |
403 ) | |
404 | |
405 (define-widget 'tree-widget-open-control 'tree-widget-control | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
406 "Button for an expanded tree-widget node." |
55588 | 407 :tag "[-] " |
408 ;;:tag-glyph (tree-widget-find-image "open") | |
409 :notify 'tree-widget-close-node | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
410 :help-echo "Collapse node" |
55588 | 411 ) |
412 | |
413 (define-widget 'tree-widget-empty-control 'tree-widget-open-control | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
414 "Button for an expanded tree-widget node with no child." |
55588 | 415 :tag "[X] " |
416 ;;:tag-glyph (tree-widget-find-image "empty") | |
417 ) | |
418 | |
419 (define-widget 'tree-widget-close-control 'tree-widget-control | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
420 "Button for a collapsed tree-widget node." |
55588 | 421 :tag "[+] " |
422 ;;:tag-glyph (tree-widget-find-image "close") | |
423 :notify 'tree-widget-open-node | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
424 :help-echo "Expand node" |
55588 | 425 ) |
426 | |
427 (define-widget 'tree-widget-leaf-control 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
428 "Representation of a tree-widget leaf node." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
429 :tag " " ;; Need at least one char to display the image :-( |
55588 | 430 ;;:tag-glyph (tree-widget-find-image "leaf") |
431 :format "%t" | |
432 ) | |
433 | |
434 (define-widget 'tree-widget-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
435 "Vertical guide line." |
55588 | 436 :tag " |" |
437 ;;:tag-glyph (tree-widget-find-image "guide") | |
438 :format "%t" | |
439 ) | |
440 | |
441 (define-widget 'tree-widget-end-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
442 "End of a vertical guide line." |
55588 | 443 :tag " `" |
444 ;;:tag-glyph (tree-widget-find-image "end-guide") | |
445 :format "%t" | |
446 ) | |
447 | |
448 (define-widget 'tree-widget-no-guide 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
449 "Invisible vertical guide line." |
55588 | 450 :tag " " |
451 ;;:tag-glyph (tree-widget-find-image "no-guide") | |
452 :format "%t" | |
453 ) | |
454 | |
455 (define-widget 'tree-widget-handle 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
456 "Horizontal guide line that joins a vertical guide line to a node." |
55588 | 457 :tag " " |
458 ;;:tag-glyph (tree-widget-find-image "handle") | |
459 :format "%t" | |
460 ) | |
461 | |
462 (define-widget 'tree-widget-no-handle 'item | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
463 "Invisible handle." |
55588 | 464 :tag " " |
465 ;;:tag-glyph (tree-widget-find-image "no-handle") | |
466 :format "%t" | |
467 ) | |
468 | |
469 (define-widget 'tree-widget 'default | |
470 "Tree widget." | |
471 :format "%v" | |
472 :convert-widget 'widget-types-convert-widget | |
473 :value-get 'widget-value-value-get | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
474 :value-delete 'widget-children-value-delete |
55588 | 475 :value-create 'tree-widget-value-create |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
476 :open-control 'tree-widget-open-control |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
477 :close-control 'tree-widget-close-control |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
478 :empty-control 'tree-widget-empty-control |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
479 :leaf-control 'tree-widget-leaf-control |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
480 :guide 'tree-widget-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
481 :end-guide 'tree-widget-end-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
482 :no-guide 'tree-widget-no-guide |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
483 :handle 'tree-widget-handle |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
484 :no-handle 'tree-widget-no-handle |
55588 | 485 ) |
486 | |
487 ;;; Widget support functions | |
488 ;; | |
489 (defun tree-widget-p (widget) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
490 "Return non-nil if WIDGET is a tree-widget." |
55588 | 491 (let ((type (widget-type widget))) |
492 (while (and type (not (eq type 'tree-widget))) | |
493 (setq type (widget-type (get type 'widget-type)))) | |
494 (eq type 'tree-widget))) | |
495 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
496 (defun tree-widget-node (widget) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
497 "Return WIDGET's :node child widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
498 If not found, setup an `item' widget as default. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
499 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
|
500 WIDGET is, or derives from, a tree-widget." |
55588 | 501 (let ((node (widget-get widget :node))) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
502 (if node |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
503 ;; Check that the :node widget is not a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
504 (and (tree-widget-p node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
505 (error "Invalid tree-widget :node %S" node)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
506 ;; Setup an item widget as default :node. |
55588 | 507 (setq node `(item :tag ,(or (widget-get widget :tag) |
508 (widget-princ-to-string | |
509 (widget-value widget))))) | |
510 (widget-put widget :node node)) | |
511 node)) | |
512 | |
513 (defun tree-widget-keep (arg widget) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
514 "Save in ARG the WIDGET's properties specified by :keep." |
55588 | 515 (dolist (prop (widget-get widget :keep)) |
516 (widget-put arg prop (widget-get widget prop)))) | |
517 | |
518 (defun tree-widget-children-value-save (widget &optional args node) | |
519 "Save WIDGET children values. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
520 WIDGET is, or derives from, a tree-widget. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
521 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
|
522 WIDGET's :args property value. Properties and values of the |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
523 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
|
524 WIDGET's :node sub-widget." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
525 (let ((args (cons (or node (widget-get widget :node)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
526 (or args (widget-get widget :args)))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
527 (children (widget-get widget :children)) |
55588 | 528 arg child) |
529 (while (and args children) | |
530 (setq arg (car args) | |
531 args (cdr args) | |
532 child (car children) | |
533 children (cdr children)) | |
534 (if (tree-widget-p child) | |
535 ;;;; The child is a tree node. | |
536 (progn | |
537 ;; Backtrack :args and :node properties. | |
538 (widget-put arg :args (widget-get child :args)) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
539 (widget-put arg :node (widget-get child :node)) |
55588 | 540 ;; Save :open property. |
541 (widget-put arg :open (widget-get child :open)) | |
542 ;; The node is open. | |
543 (when (widget-get child :open) | |
544 ;; Save the widget value. | |
545 (widget-put arg :value (widget-value child)) | |
546 ;; Save properties specified in :keep. | |
547 (tree-widget-keep arg child) | |
548 ;; Save children. | |
549 (tree-widget-children-value-save | |
550 child (widget-get arg :args) (widget-get arg :node)))) | |
551 ;;;; Another non tree node. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
552 ;; Save the widget value. |
55588 | 553 (widget-put arg :value (widget-value child)) |
554 ;; Save properties specified in :keep. | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
555 (tree-widget-keep arg child))))) |
55588 | 556 |
557 (defvar tree-widget-after-toggle-functions nil | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
558 "Hooks run after toggling a tree-widget expansion. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
559 Each function will receive the tree-widget as its unique argument. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
560 This hook should be local in the buffer used to display widgets.") |
55588 | 561 |
562 (defun tree-widget-close-node (widget &rest ignore) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
563 "Collapse the tree-widget, parent of WIDGET. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
564 WIDGET is, or derives from, a tree-widget-open-control widget. |
55588 | 565 IGNORE other arguments." |
566 (let ((tree (widget-get widget :parent))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
567 ;; Before to collapse the node, save children values so next open |
55588 | 568 ;; can recover them. |
569 (tree-widget-children-value-save tree) | |
570 (widget-put tree :open nil) | |
571 (widget-value-set tree nil) | |
572 (run-hook-with-args 'tree-widget-after-toggle-functions tree))) | |
573 | |
574 (defun tree-widget-open-node (widget &rest ignore) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
575 "Expand the tree-widget, parent of WIDGET. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
576 WIDGET is, or derives from, a tree-widget-close-control widget. |
55588 | 577 IGNORE other arguments." |
578 (let ((tree (widget-get widget :parent))) | |
579 (widget-put tree :open t) | |
580 (widget-value-set tree t) | |
581 (run-hook-with-args 'tree-widget-after-toggle-functions tree))) | |
582 | |
583 (defun tree-widget-value-create (tree) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
584 "Create the TREE tree-widget." |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
585 (let* ((node (tree-widget-node tree)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
586 (flags (widget-get tree :tree-widget--guide-flags)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
587 (indent (widget-get tree :indent)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
588 ;; Setup widget's image support. Looking up for images, and |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
589 ;; setting widgets' :tag-glyph is done here, to allow to |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
590 ;; dynamically change the image theme. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
591 (widget-image-enable (tree-widget-use-image-p)) ; Emacs |
55588 | 592 (widget-glyph-enable widget-image-enable) ; XEmacs |
593 children buttons) | |
63482
0f66f455f7d7
(tree-widget-value-create): Simplify last change.
David Ponce <david@dponce.com>
parents:
63467
diff
changeset
|
594 (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
|
595 (insert-char ?\ indent)) |
55588 | 596 (if (widget-get tree :open) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
597 ;;;; Expanded node. |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
598 (let ((args (widget-get tree :args)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
599 (xpandr (or (widget-get tree :expander) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
600 (widget-get tree :dynargs))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
601 (leaf (widget-get tree :leaf-control)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
602 (guide (widget-get tree :guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
603 (noguide (widget-get tree :no-guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
604 (endguide (widget-get tree :end-guide)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
605 (handle (widget-get tree :handle)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
606 (nohandle (widget-get tree :no-handle)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
607 (leafi (tree-widget-find-image "leaf")) |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
608 (guidi (tree-widget-find-image "guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
609 (noguidi (tree-widget-find-image "no-guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
610 (endguidi (tree-widget-find-image "end-guide")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
611 (handli (tree-widget-find-image "handle")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
612 (nohandli (tree-widget-find-image "no-handle")) |
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
613 child) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
614 ;; Request children at run time, when not already done. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
615 (when (and (not args) xpandr) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
616 (setq args (mapcar 'widget-convert (funcall xpandr tree))) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
617 (widget-put tree :args args)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
618 ;; Insert the node "open" button. |
55588 | 619 (push (widget-create-child-and-convert |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
620 tree (widget-get |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
621 tree (if args :open-control :empty-control)) |
55588 | 622 :tag-glyph (tree-widget-find-image |
623 (if args "open" "empty"))) | |
624 buttons) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
625 ;; Insert the :node element. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
626 (push (widget-create-child-and-convert tree node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
627 children) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
628 ;; Insert children. |
55588 | 629 (while args |
630 (setq child (car args) | |
631 args (cdr args)) | |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
632 (and indent (insert-char ?\ indent)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
633 ;; Insert guide lines elements from previous levels. |
63465
1df1bb151415
(tree-widget-super-format-handler)
David Ponce <david@dponce.com>
parents:
59996
diff
changeset
|
634 (dolist (f (reverse flags)) |
55588 | 635 (widget-create-child-and-convert |
636 tree (if f guide noguide) | |
637 :tag-glyph (if f guidi noguidi)) | |
638 (widget-create-child-and-convert | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
639 tree nohandle :tag-glyph nohandli)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
640 ;; Insert guide line element for this level. |
55588 | 641 (widget-create-child-and-convert |
642 tree (if args guide endguide) | |
643 :tag-glyph (if args guidi endguidi)) | |
644 ;; Insert the node handle line | |
645 (widget-create-child-and-convert | |
646 tree handle :tag-glyph handli) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
647 ;; If leaf node, insert a leaf node button. |
55588 | 648 (unless (tree-widget-p child) |
649 (push (widget-create-child-and-convert | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
650 tree leaf :tag-glyph leafi) |
55588 | 651 buttons)) |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
652 ;; Finally, insert the child widget. |
55588 | 653 (push (widget-create-child-and-convert |
654 tree child | |
655 :tree-widget--guide-flags (cons (if args t) flags)) | |
656 children))) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
657 ;;;; Collapsed node. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
658 ;; Insert the "closed" node button. |
55588 | 659 (push (widget-create-child-and-convert |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
660 tree (widget-get tree :close-control) |
55588 | 661 :tag-glyph (tree-widget-find-image "close")) |
662 buttons) | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
663 ;; Insert the :node element. |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
664 (push (widget-create-child-and-convert tree node) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
665 children)) |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
666 ;; Save widget children and buttons. The :node child is the first |
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
667 ;; element in children. |
55588 | 668 (widget-put tree :children (nreverse children)) |
669 (widget-put tree :buttons buttons) | |
670 )) | |
671 | |
672 (provide 'tree-widget) | |
673 | |
64077
f823765b0fab
Improve header Commentary section.
David Ponce <david@dponce.com>
parents:
63482
diff
changeset
|
674 ;; arch-tag: c3a1ada2-1663-41dc-9d16-2479ed8320e8 |
55588 | 675 ;;; tree-widget.el ends here |