Chong Yidong <[EMAIL PROTECTED]> writes:
> How about this patch? It changes find-image to look for an image file
> in etc/images first, then in etc/, then in the load-path. The last
> two are for backward compatibility, the idea being that images should
> go into etc/images by default.
>
IMO, This is a good approach.
However, I would suggest that you define an image-load-path
variable like this:
(defvar image-load-path '("etc/images/" "etc/" load-path)
"List of directories and other load paths to search for images.
If element is a string, it defines a directory to search.
Non-absolute directories are relative to `data-directory'.
If element is a variable symbol, the value of that variable
is used as a load-path of directories to search.")
Then modify this part of your patch
> ! (if (or (file-readable-p
> ! (setq found
> ! (expand-file-name
> ! file
> ! (concat data-directory "/images"))))
> ! (file-readable-p
> ! (setq found
> ! (expand-file-name file data-directory)))
> ! (let ((path load-path))
> ! (setq found nil)
> ! (while (and (not found) path)
> ! (unless (file-readable-p
> ! (setq found (expand-file-name
> ! file (car path))))
> ! (setq found nil))
> ! (setq path (cdr path)))
> ! found))
to call the function below like this:
(setq found (image-search-load-path file image-load-path))
(defun image-search-load-path (file path)
(let (found)
(while (and (not found) (consp path))
(cond
((stringp (car path))
(setq found (expand-file-name file
(expand-file-name (car path) data-directory))
((and (symbolp (car path) (boundp (car path)))
(setq found (image-search-load-path file (symbol-value (car
path)))))))))
(setq path (cdr path)))
found))
WDYT?
> For example, if foobar.el needs an image that is installed into
> etc/images/foobar/foo.xpm, it calls
>
> (defimage foo-image ((:type xpm :file "foobar/foo.xpm" ....)))
>
>
> *** emacs/lisp/image.el.~1.48.~ 2005-08-06 18:13:43.000000000 -0400
> --- emacs/lisp/image.el 2005-09-14 03:55:29.000000000 -0400
> ***************
> *** 286,292 ****
> specification to be returned. Return nil if no specification is
> satisfied.
>
> ! The image is looked for first on `load-path' and then in `data-directory'."
> (let (image)
> (while (and specs (null image))
> (let* ((spec (car specs))
> --- 286,293 ----
> specification to be returned. Return nil if no specification is
> satisfied.
>
> ! The image is looked for first in `data-directory'/images, then in
> ! `data-directory', then in `load-path'."
> (let (image)
> (while (and specs (null image))
> (let* ((spec (car specs))
> ***************
> *** 296,315 ****
> found)
> (when (image-type-available-p type)
> (cond ((stringp file)
> ! (let ((path load-path))
> ! (while (and (not found) path)
> ! (let ((try-file (expand-file-name file (car path))))
> ! (when (file-readable-p try-file)
> ! (setq found try-file)))
> ! (setq path (cdr path)))
> ! (unless found
> ! (let ((try-file (expand-file-name file data-directory)))
> ! (if (file-readable-p try-file)
> ! (setq found try-file))))
> ! (if found
> ! (setq image
> ! (cons 'image (plist-put (copy-sequence spec)
> ! :file found))))))
> ((not (null data))
> (setq image (cons 'image spec)))))
> (setq specs (cdr specs))))
> --- 297,323 ----
> found)
> (when (image-type-available-p type)
> (cond ((stringp file)
> ! (if (or (file-readable-p
> ! (setq found
> ! (expand-file-name
> ! file
> ! (concat data-directory "/images"))))
> ! (file-readable-p
> ! (setq found
> ! (expand-file-name file data-directory)))
> ! (let ((path load-path))
> ! (setq found nil)
> ! (while (and (not found) path)
> ! (unless (file-readable-p
> ! (setq found (expand-file-name
> ! file (car path))))
> ! (setq found nil))
> ! (setq path (cdr path)))
> ! found))
> ! ;; image file found
> ! (setq image
> ! (cons 'image (plist-put (copy-sequence spec)
> ! :file found)))))
> ((not (null data))
> (setq image (cons 'image spec)))))
> (setq specs (cdr specs))))
>
>
> _______________________________________________
> Emacs-devel mailing list
> Emacs-devel@gnu.org
> http://lists.gnu.org/mailman/listinfo/emacs-devel
>
>
--
Kim F. Storm <[EMAIL PROTECTED]> http://www.cua.dk
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
