mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-02 11:21:42 +00:00
Code Issues Releases Activity

Handle themes across all occurrences of the main

Browse Source 
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.
This commit is contained in:
David Ponce 2006-03-13 07:49:31 +00:00
parent 4f8f072e2e
commit a32703cbe0
1 changed files with 75 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

137
lisp/tree-widget.el
View File

@ -154,8 +154,9 @@ XEmacs.")
(defcustom tree-widget-themes-directory "tree-widget" (defcustom tree-widget-themes-directory "tree-widget"
"*Name of the directory where to look up for image themes. "*Name of the directory where to look up for image themes.
When nil use the directory where the tree-widget library is located. 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 When a relative name is specified, search in all occurrences of that
the locations specified in `tree-widget-themes-load-path'. sub directory found in the locations specified in
`tree-widget-themes-load-path'.
The default is to use the \"tree-widget\" relative name." The default is to use the \"tree-widget\" relative name."
:type '(choice (const :tag "Default" "tree-widget") :type '(choice (const :tag "Default" "tree-widget")
(const :tag "With the library" nil) (const :tag "With the library" nil)
@ -164,9 +165,9 @@ The default is to use the \"tree-widget\" relative name."
(defcustom tree-widget-theme nil (defcustom tree-widget-theme nil
"*Name of the theme where to look up for images. "*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\". `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. theme.
A complete theme must at least contain images with these file names A complete theme must at least contain images with these file names
@ -275,10 +276,15 @@ The default parent theme is the \"default\" theme."
(unless (member name (aref tree-widget--theme 0)) (unless (member name (aref tree-widget--theme 0))
(aset tree-widget--theme 0 (aset tree-widget--theme 0
(append (aref tree-widget--theme 0) (list name))) (append (aref tree-widget--theme 0) (list name)))
;; Load the theme setup ;; Load the theme setup from the first directory where the theme
(let ((default-directory (tree-widget-themes-directory))) ;; is found.
(when default-directory (catch 'found
(load (expand-file-name "tree-widget-theme-setup" name) t))))) (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) (defun tree-widget-set-theme (&optional name)
"In the current buffer, set the theme to use for images. "In the current buffer, set the theme to use for images.
@ -304,54 +310,62 @@ Typically it should contain something like this:
(tree-widget-set-parent-theme name) (tree-widget-set-parent-theme name)
(tree-widget-set-parent-theme "default"))) (tree-widget-set-parent-theme "default")))
(defun tree-widget--locate-sub-directory (name path) (defun tree-widget--locate-sub-directory (name path &optional found)
"Locate the sub-directory NAME in PATH. "Locate all occurrences of the sub-directory NAME in PATH.
Return the absolute name of the directory found, or nil if not found." Return a list of absolute directory names in reverse order, or nil if
(let (dir elt) not found."
(while (and (not dir) (consp path)) (condition-case err
(setq elt (condition-case nil (eval (car path)) (error nil)) (dolist (elt path)
path (cdr path)) (setq elt (eval elt))
(cond (cond
((stringp elt) ((stringp elt)
(setq dir (expand-file-name name elt)) (and (file-accessible-directory-p
(or (file-accessible-directory-p dir) (setq elt (expand-file-name name elt)))
(setq dir nil))) (push elt found)))
((and elt (not (equal elt (car path)))) (elt
(setq dir (tree-widget--locate-sub-directory name elt))))) (setq found (tree-widget--locate-sub-directory
dir)) 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 () (defun tree-widget-themes-path ()
"Locate the directory where to search for a theme. "Return the path where to search for a theme.
It is defined in variable `tree-widget-themes-directory'. It is specified in variable `tree-widget-themes-directory'.
Return the absolute name of the directory found, or nil if the Return a list of absolute directory names, or nil when no directory
specified directory is not accessible." has been found accessible."
(let ((found (aref tree-widget--theme 1))) (let ((path (aref tree-widget--theme 1)))
(cond (cond
;; The directory was not found. ;; No directory was found.
((eq found 'void) ((eq path 'void) nil)
(setq found nil)) ;; The list of directories is available in the cache.
;; The directory is available in the cache. (path)
(found)
;; Use the directory where this library is located. ;; Use the directory where this library is located.
((null tree-widget-themes-directory) ((null tree-widget-themes-directory)
(setq found (locate-library "tree-widget")) (when (setq path (locate-library "tree-widget"))
(when found (setq path (file-name-directory path))
(setq found (file-name-directory found)) (setq path (and (file-accessible-directory-p path)
(or (file-accessible-directory-p found) (list path)))
(setq found nil)))) ;; Store the result in the cache for later use.
(aset tree-widget--theme 1 (or path 'void))
path))
;; Check accessibility of absolute directory name. ;; Check accessibility of absolute directory name.
((file-name-absolute-p tree-widget-themes-directory) ((file-name-absolute-p tree-widget-themes-directory)
(setq found (expand-file-name tree-widget-themes-directory)) (setq path (expand-file-name tree-widget-themes-directory))
(or (file-accessible-directory-p found) (setq path (and (file-accessible-directory-p path)
(setq found nil))) (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'. ;; Locate a sub-directory in `tree-widget-themes-load-path'.
(t (t
(setq found (tree-widget--locate-sub-directory (setq path (nreverse (tree-widget--locate-sub-directory
tree-widget-themes-directory tree-widget-themes-directory
tree-widget-themes-load-path)))) tree-widget-themes-load-path)))
;; Store the result in the cache for later use. ;; Store the result in the cache for later use.
(aset tree-widget--theme 1 (or found 'void)) (aset tree-widget--theme 1 (or path 'void))
found)) path))))
(defconst tree-widget--cursors (defconst tree-widget--cursors
;; Pointer shapes when the mouse pointer is over inactive ;; Pointer shapes when the mouse pointer is over inactive
@ -391,20 +405,19 @@ Search first in current theme, then in parent themes (see also the
function `tree-widget-set-parent-theme'). function `tree-widget-set-parent-theme').
Return the first image found having a supported format, or nil if not Return the first image found having a supported format, or nil if not
found." found."
(let ((default-directory (tree-widget-themes-directory)) file) (catch 'found
(when default-directory (dolist (default-directory (tree-widget-themes-path))
(catch 'found (dolist (dir (aref tree-widget--theme 0))
(dolist (dir (aref tree-widget--theme 0)) (dolist (fmt (tree-widget-image-formats))
(dolist (fmt (tree-widget-image-formats)) (dolist (ext (cdr fmt))
(dolist (ext (cdr fmt)) (setq file (expand-file-name (concat name ext) dir))
(setq file (expand-file-name (concat name ext) dir)) (and (file-readable-p file)
(and (file-readable-p file) (file-regular-p file)
(file-regular-p file) (throw 'found
(throw 'found (tree-widget-create-image
(tree-widget-create-image (car fmt) file
(car fmt) file (tree-widget-image-properties name))))))))
(tree-widget-image-properties name))))))) nil))
nil))))
(defun tree-widget-find-image (name) (defun tree-widget-find-image (name)
"Find the image with NAME in current theme. "Find the image with NAME in current theme.