# HG changeset patch # User David Ponce # Date 1142236171 0 # Node ID 602d4778bd8a6830e18b41361656346fd436db53 # Parent 69028f972cae0d54fdfcad7005e15f37e3c0e34c Handle themes across all occurrences of the main themes sub-directory found in tree-widget-themes-load-path. (tree-widget-themes-directory, tree-widget-theme): Doc fix. (tree-widget--locate-sub-directory): Return all occurrences. (tree-widget-themes-path): New function. Replace tree-widget-themes-directory, and return a list of directories. (tree-widget-set-parent-theme) (tree-widget-lookup-image): Use it. diff -r 69028f972cae -r 602d4778bd8a lisp/tree-widget.el --- a/lisp/tree-widget.el Mon Mar 13 07:48:29 2006 +0000 +++ b/lisp/tree-widget.el Mon Mar 13 07:49:31 2006 +0000 @@ -154,8 +154,9 @@ (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 -the locations specified in `tree-widget-themes-load-path'. +When a relative name is specified, search in all occurrences of that +sub directory found in 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) @@ -164,9 +165,9 @@ (defcustom tree-widget-theme nil "*Name of the theme where to look up for images. -It must be a sub directory of the directory specified in variable +It must be a sub directory in the directories specified in variable `tree-widget-themes-directory'. The default theme is \"default\". -When an image is not found in a theme, it is searched in the default +When an image is not found in a theme, it is searched in the parent theme. A complete theme must at least contain images with these file names @@ -275,10 +276,15 @@ (unless (member name (aref tree-widget--theme 0)) (aset tree-widget--theme 0 (append (aref tree-widget--theme 0) (list name))) - ;; Load the theme setup - (let ((default-directory (tree-widget-themes-directory))) - (when default-directory - (load (expand-file-name "tree-widget-theme-setup" name) t))))) + ;; Load the theme setup from the first directory where the theme + ;; is found. + (catch 'found + (dolist (dir (tree-widget-themes-path)) + (setq dir (expand-file-name name dir)) + (when (file-accessible-directory-p dir) + (throw 'found + (load (expand-file-name + "tree-widget-theme-setup" dir) t))))))) (defun tree-widget-set-theme (&optional name) "In the current buffer, set the theme to use for images. @@ -304,54 +310,62 @@ (tree-widget-set-parent-theme name) (tree-widget-set-parent-theme "default"))) -(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--locate-sub-directory (name path &optional found) + "Locate all occurrences of the sub-directory NAME in PATH. +Return a list of absolute directory names in reverse order, or nil if +not found." + (condition-case err + (dolist (elt path) + (setq elt (eval elt)) + (cond + ((stringp elt) + (and (file-accessible-directory-p + (setq elt (expand-file-name name elt))) + (push elt found))) + (elt + (setq found (tree-widget--locate-sub-directory + name (if (atom elt) (list elt) elt) found))))) + (error + (message "In tree-widget--locate-sub-directory: %s" + (error-message-string err)))) + found) -(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))) +(defun tree-widget-themes-path () + "Return the path where to search for a theme. +It is specified in variable `tree-widget-themes-directory'. +Return a list of absolute directory names, or nil when no directory +has been found accessible." + (let ((path (aref tree-widget--theme 1))) (cond - ;; The directory was not found. - ((eq found 'void) - (setq found nil)) - ;; The directory is available in the cache. - (found) + ;; No directory was found. + ((eq path 'void) nil) + ;; The list of directories is available in the cache. + (path) ;; 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)))) + (when (setq path (locate-library "tree-widget")) + (setq path (file-name-directory path)) + (setq path (and (file-accessible-directory-p path) + (list path))) + ;; Store the result in the cache for later use. + (aset tree-widget--theme 1 (or path 'void)) + path)) ;; 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))) + (setq path (expand-file-name tree-widget-themes-directory)) + (setq path (and (file-accessible-directory-p path) + (list path))) + ;; Store the result in the cache for later use. + (aset tree-widget--theme 1 (or path 'void)) + path) ;; 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)) + (setq path (nreverse (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 path 'void)) + path)))) (defconst tree-widget--cursors ;; Pointer shapes when the mouse pointer is over inactive @@ -391,20 +405,19 @@ function `tree-widget-set-parent-theme'). Return the first image found having a supported format, or nil if not found." - (let ((default-directory (tree-widget-themes-directory)) file) - (when default-directory - (catch 'found - (dolist (dir (aref tree-widget--theme 0)) - (dolist (fmt (tree-widget-image-formats)) - (dolist (ext (cdr fmt)) - (setq file (expand-file-name (concat name ext) dir)) - (and (file-readable-p file) - (file-regular-p file) - (throw 'found - (tree-widget-create-image - (car fmt) file - (tree-widget-image-properties name))))))) - nil)))) + (catch 'found + (dolist (default-directory (tree-widget-themes-path)) + (dolist (dir (aref tree-widget--theme 0)) + (dolist (fmt (tree-widget-image-formats)) + (dolist (ext (cdr fmt)) + (setq file (expand-file-name (concat name ext) dir)) + (and (file-readable-p file) + (file-regular-p file) + (throw 'found + (tree-widget-create-image + (car fmt) file + (tree-widget-image-properties name)))))))) + nil)) (defun tree-widget-find-image (name) "Find the image with NAME in current theme.