Mercurial > emacs
changeset 65747:cfaa6269b03d
(tree-widget-themes-load-path): New variable.
(tree-widget-themes-directory): Doc fix.
(tree-widget-image-formats) [Emacs]: Doc fix.
(tree-widget--locate-sub-directory): New function.
(tree-widget-themes-directory): Use it.
| author | David Ponce <david@dponce.com> |
|---|---|
| date | Fri, 30 Sep 2005 06:28:53 +0000 |
| parents | 6f5a2198d5e4 |
| children | 980399883216 |
| files | lisp/tree-widget.el |
| diffstat | 1 files changed, 64 insertions(+), 42 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/tree-widget.el Fri Sep 30 06:28:17 2005 +0000 +++ b/lisp/tree-widget.el Fri Sep 30 06:28:53 2005 +0000 @@ -131,14 +131,29 @@ :type 'boolean :group 'tree-widget) +(defvar tree-widget-themes-load-path + '(load-path + (let ((dir (if (fboundp 'locate-data-directory) + (locate-data-directory "tree-widget") ;; XEmacs + data-directory))) + (and dir (list dir (expand-file-name "images" dir)))) + ) + "List of locations where to search for the themes sub-directory. +Each element is an expression that will be evaluated to return a +single directory or a list of directories to search. + +The default is to search in the `load-path' first, then in the +\"images\" sub directory in the data directory, then in the data +directory. +The data directory is the value of the variable `data-directory' on +Emacs, and what `(locate-data-directory \"tree-widget\")' returns on +XEmacs.") + (defcustom tree-widget-themes-directory "tree-widget" "*Name of the directory where to look up for image themes. When nil use the directory where the tree-widget library is located. When a relative name is specified, try to locate that sub directory in -`load-path', then in the data directory, and use the first one found. -The data directory is the value of the variable `data-directory' on -Emacs, and what `(locate-data-directory \"tree-widget\")' returns on -XEmacs. +the locations specified in `tree-widget-themes-load-path'. The default is to use the \"tree-widget\" relative name." :type '(choice (const :tag "Default" "tree-widget") (const :tag "With the library" nil) @@ -236,7 +251,7 @@ (apply 'create-image `(,file ,type nil ,@props))) (defsubst tree-widget-image-formats () "Return the alist of image formats/file name extensions. -See also the option `widget-image-file-name-suffixes'." +See also the option `widget-image-conversion'." (delq nil (mapcar #'(lambda (fmt) @@ -264,47 +279,54 @@ (make-vector 4 nil)) (aset tree-widget--theme 0 name))) +(defun tree-widget--locate-sub-directory (name path) + "Locate the sub-directory NAME in PATH. +Return the absolute name of the directory found, or nil if not found." + (let (dir elt) + (while (and (not dir) (consp path)) + (setq elt (condition-case nil (eval (car path)) (error nil)) + path (cdr path)) + (cond + ((stringp elt) + (setq dir (expand-file-name name elt)) + (or (file-accessible-directory-p dir) + (setq dir nil))) + ((and elt (not (equal elt (car path)))) + (setq dir (tree-widget--locate-sub-directory name elt))))) + dir)) + (defun tree-widget-themes-directory () "Locate the directory where to search for a theme. It is defined in variable `tree-widget-themes-directory'. Return the absolute name of the directory found, or nil if the specified directory is not accessible." (let ((found (aref tree-widget--theme 1))) - (if found - ;; The directory is available in the cache. - (unless (eq found 'void) found) - (cond - ;; Use the directory where tree-widget is located. - ((null tree-widget-themes-directory) - (setq found (locate-library "tree-widget")) - (when found - (setq found (file-name-directory found)) - (or (file-accessible-directory-p found) - (setq found nil)))) - ;; Check accessibility of absolute directory name. - ((file-name-absolute-p tree-widget-themes-directory) - (setq found (expand-file-name tree-widget-themes-directory)) + (cond + ;; The directory was not found. + ((eq found 'void) + (setq found nil)) + ;; The directory is available in the cache. + (found) + ;; Use the directory where this library is located. + ((null tree-widget-themes-directory) + (setq found (locate-library "tree-widget")) + (when found + (setq found (file-name-directory found)) (or (file-accessible-directory-p found) - (setq found nil))) - ;; Locate a sub-directory in `load-path' and data directory. - (t - (let ((path - (append load-path - (list (if (fboundp 'locate-data-directory) - ;; XEmacs - (locate-data-directory "tree-widget") - ;; Emacs - data-directory))))) - (while (and path (not found)) - (when (car path) - (setq found (expand-file-name - tree-widget-themes-directory (car path))) - (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))) + (setq found nil)))) + ;; Check accessibility of absolute directory name. + ((file-name-absolute-p tree-widget-themes-directory) + (setq found (expand-file-name tree-widget-themes-directory)) + (or (file-accessible-directory-p found) + (setq found nil))) + ;; Locate a sub-directory in `tree-widget-themes-load-path'. + (t + (setq found (tree-widget--locate-sub-directory + tree-widget-themes-directory + tree-widget-themes-load-path)))) + ;; Store the result in the cache for later use. + (aset tree-widget--theme 1 (or found 'void)) + found)) (defsubst tree-widget-set-image-properties (props) "In current theme, set images properties to PROPS." @@ -351,9 +373,9 @@ plist)) (defconst tree-widget--cursors - ;; Pointer shapes when the mouse pointer is over tree-widget images. - ;; This feature works since Emacs 22, and ignored on older versions, - ;; and XEmacs. + ;; Pointer shapes when the mouse pointer is over inactive + ;; tree-widget images. This feature works since Emacs 22, and + ;; ignored on older versions, and XEmacs. '( ("guide" . arrow) ("no-guide" . arrow)