131 |
:type 'boolean |
:type 'boolean |
132 |
:group 'tree-widget) |
:group 'tree-widget) |
133 |
|
|
134 |
|
(defvar tree-widget-themes-load-path |
135 |
|
'(load-path |
136 |
|
(let ((dir (if (fboundp 'locate-data-directory) |
137 |
|
(locate-data-directory "tree-widget") ;; XEmacs |
138 |
|
data-directory))) |
139 |
|
(and dir (list dir (expand-file-name "images" dir)))) |
140 |
|
) |
141 |
|
"List of locations where to search for the themes sub-directory. |
142 |
|
Each element is an expression that will be evaluated to return a |
143 |
|
single directory or a list of directories to search. |
144 |
|
|
145 |
|
The default is to search in the `load-path' first, then in the |
146 |
|
\"images\" sub directory in the data directory, then in the data |
147 |
|
directory. |
148 |
|
The data directory is the value of the variable `data-directory' on |
149 |
|
Emacs, and what `(locate-data-directory \"tree-widget\")' returns on |
150 |
|
XEmacs.") |
151 |
|
|
152 |
(defcustom tree-widget-themes-directory "tree-widget" |
(defcustom tree-widget-themes-directory "tree-widget" |
153 |
"*Name of the directory where to look up for image themes. |
"*Name of the directory where to look up for image themes. |
154 |
When nil use the directory where the tree-widget library is located. |
When nil use the directory where the tree-widget library is located. |
155 |
When a relative name is specified, try to locate that sub directory in |
When a relative name is specified, try to locate that sub directory in |
156 |
`load-path', then in the data directory, and use the first one found. |
the locations specified in `tree-widget-themes-load-path'. |
|
The data directory is the value of the variable `data-directory' on |
|
|
Emacs, and what `(locate-data-directory \"tree-widget\")' returns on |
|
|
XEmacs. |
|
157 |
The default is to use the \"tree-widget\" relative name." |
The default is to use the \"tree-widget\" relative name." |
158 |
:type '(choice (const :tag "Default" "tree-widget") |
:type '(choice (const :tag "Default" "tree-widget") |
159 |
(const :tag "With the library" nil) |
(const :tag "With the library" nil) |
251 |
(apply 'create-image `(,file ,type nil ,@props))) |
(apply 'create-image `(,file ,type nil ,@props))) |
252 |
(defsubst tree-widget-image-formats () |
(defsubst tree-widget-image-formats () |
253 |
"Return the alist of image formats/file name extensions. |
"Return the alist of image formats/file name extensions. |
254 |
See also the option `widget-image-file-name-suffixes'." |
See also the option `widget-image-conversion'." |
255 |
(delq nil |
(delq nil |
256 |
(mapcar |
(mapcar |
257 |
#'(lambda (fmt) |
#'(lambda (fmt) |
279 |
(make-vector 4 nil)) |
(make-vector 4 nil)) |
280 |
(aset tree-widget--theme 0 name))) |
(aset tree-widget--theme 0 name))) |
281 |
|
|
282 |
|
(defun tree-widget--locate-sub-directory (name path) |
283 |
|
"Locate the sub-directory NAME in PATH. |
284 |
|
Return the absolute name of the directory found, or nil if not found." |
285 |
|
(let (dir elt) |
286 |
|
(while (and (not dir) (consp path)) |
287 |
|
(setq elt (condition-case nil (eval (car path)) (error nil)) |
288 |
|
path (cdr path)) |
289 |
|
(cond |
290 |
|
((stringp elt) |
291 |
|
(setq dir (expand-file-name name elt)) |
292 |
|
(or (file-accessible-directory-p dir) |
293 |
|
(setq dir nil))) |
294 |
|
((and elt (not (equal elt (car path)))) |
295 |
|
(setq dir (tree-widget--locate-sub-directory name elt))))) |
296 |
|
dir)) |
297 |
|
|
298 |
(defun tree-widget-themes-directory () |
(defun tree-widget-themes-directory () |
299 |
"Locate the directory where to search for a theme. |
"Locate the directory where to search for a theme. |
300 |
It is defined in variable `tree-widget-themes-directory'. |
It is defined in variable `tree-widget-themes-directory'. |
301 |
Return the absolute name of the directory found, or nil if the |
Return the absolute name of the directory found, or nil if the |
302 |
specified directory is not accessible." |
specified directory is not accessible." |
303 |
(let ((found (aref tree-widget--theme 1))) |
(let ((found (aref tree-widget--theme 1))) |
304 |
(if found |
(cond |
305 |
;; The directory is available in the cache. |
;; The directory was not found. |
306 |
(unless (eq found 'void) found) |
((eq found 'void) |
307 |
(cond |
(setq found nil)) |
308 |
;; Use the directory where tree-widget is located. |
;; The directory is available in the cache. |
309 |
((null tree-widget-themes-directory) |
(found) |
310 |
(setq found (locate-library "tree-widget")) |
;; Use the directory where this library is located. |
311 |
(when found |
((null tree-widget-themes-directory) |
312 |
(setq found (file-name-directory found)) |
(setq found (locate-library "tree-widget")) |
313 |
(or (file-accessible-directory-p found) |
(when found |
314 |
(setq found nil)))) |
(setq found (file-name-directory found)) |
|
;; Check accessibility of absolute directory name. |
|
|
((file-name-absolute-p tree-widget-themes-directory) |
|
|
(setq found (expand-file-name tree-widget-themes-directory)) |
|
315 |
(or (file-accessible-directory-p found) |
(or (file-accessible-directory-p found) |
316 |
(setq found nil))) |
(setq found nil)))) |
317 |
;; Locate a sub-directory in `load-path' and data directory. |
;; Check accessibility of absolute directory name. |
318 |
(t |
((file-name-absolute-p tree-widget-themes-directory) |
319 |
(let ((path |
(setq found (expand-file-name tree-widget-themes-directory)) |
320 |
(append load-path |
(or (file-accessible-directory-p found) |
321 |
(list (if (fboundp 'locate-data-directory) |
(setq found nil))) |
322 |
;; XEmacs |
;; Locate a sub-directory in `tree-widget-themes-load-path'. |
323 |
(locate-data-directory "tree-widget") |
(t |
324 |
;; Emacs |
(setq found (tree-widget--locate-sub-directory |
325 |
data-directory))))) |
tree-widget-themes-directory |
326 |
(while (and path (not found)) |
tree-widget-themes-load-path)))) |
327 |
(when (car path) |
;; Store the result in the cache for later use. |
328 |
(setq found (expand-file-name |
(aset tree-widget--theme 1 (or found 'void)) |
329 |
tree-widget-themes-directory (car path))) |
found)) |
|
(or (file-accessible-directory-p found) |
|
|
(setq found nil))) |
|
|
(setq path (cdr path)))))) |
|
|
;; Store the result in the cache for later use. |
|
|
(aset tree-widget--theme 1 (or found 'void)) |
|
|
found))) |
|
330 |
|
|
331 |
(defsubst tree-widget-set-image-properties (props) |
(defsubst tree-widget-set-image-properties (props) |
332 |
"In current theme, set images properties to PROPS." |
"In current theme, set images properties to PROPS." |
373 |
plist)) |
plist)) |
374 |
|
|
375 |
(defconst tree-widget--cursors |
(defconst tree-widget--cursors |
376 |
;; Pointer shapes when the mouse pointer is over tree-widget images. |
;; Pointer shapes when the mouse pointer is over inactive |
377 |
;; This feature works since Emacs 22, and ignored on older versions, |
;; tree-widget images. This feature works since Emacs 22, and |
378 |
;; and XEmacs. |
;; ignored on older versions, and XEmacs. |
379 |
'( |
'( |
380 |
("guide" . arrow) |
("guide" . arrow) |
381 |
("no-guide" . arrow) |
("no-guide" . arrow) |