# HG changeset patch # User Bill Wohler # Date 1142031146 0 # Node ID e5e4303f80506aef41c52ff49deae3b345ecd6ff # Parent e184d816a2b128bc902e92d58bec9b98d446d161 (image-load-path-for-library): Merge at least three functions from Gnus and MH-E into this one function that can now be shared. diff -r e184d816a2b1 -r e5e4303f8050 lisp/ChangeLog --- a/lisp/ChangeLog Fri Mar 10 20:06:33 2006 +0000 +++ b/lisp/ChangeLog Fri Mar 10 22:52:26 2006 +0000 @@ -1,3 +1,9 @@ +2006-03-10 Bill Wohler + + * image.el (image-load-path-for-library): Merge at least three + functions from Gnus and MH-E into this one function that can now + be shared. + 2006-03-11 Nick Roberts * progmodes/gdb-ui.el (gdb-remove-text-properties): Rename from diff -r e184d816a2b1 -r e5e4303f8050 lisp/image.el --- a/lisp/image.el Fri Mar 10 20:06:33 2006 +0000 +++ b/lisp/image.el Fri Mar 10 22:52:26 2006 +0000 @@ -77,6 +77,80 @@ (list (file-name-as-directory (expand-file-name "images" data-directory)) 'data-directory 'load-path))) +(defun image-load-path-for-library (library image &optional path) + "Return a suitable search path for images relative to LIBRARY. + +Images for LIBRARY are searched for in \"../../etc/images\" and +\"../etc/images\" relative to the files in \"lisp/LIBRARY\" as +well as in `image-load-path' and `load-path'. + +This function returns the value of `load-path' augmented with the +path to IMAGE. If PATH is given, it is used instead of +`load-path'. + +Here is an example that uses a common idiom to provide +compatibility with versions of Emacs that lack the variable +`image-load-path': + + (let ((load-path + (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) + (image-load-path + (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path))) + (mh-tool-bar-folder-buttons-init))" + (unless library (error "No library specified")) + (unless image (error "No image specified")) + (let ((image-directory)) + (cond + ;; Try relative setting. + ((let (library-name d1ei d2ei) + ;; First, find library in the load-path. + (setq library-name (locate-library library)) + (if (not library-name) + (error "Cannot find library %s in load-path" library)) + ;; And then set image-directory relative to that. + (setq + ;; Go down 2 levels. + d2ei (expand-file-name + (concat (file-name-directory library-name) "../../etc/images")) + ;; Go down 1 level. + d1ei (expand-file-name + (concat (file-name-directory library-name) "../etc/images"))) + (setq image-directory + ;; Set it to nil if image is not found. + (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) + ((file-exists-p (expand-file-name image d1ei)) d1ei))))) + ;; Check for images in image-load-path or load-path. + ((let ((img image) + (dir (or + ;; Images in image-load-path. + (image-search-load-path image) + ;; Images in load-path. + (locate-library image))) + parent) + ;; Since the image might be in a nested directory (for + ;; example, mail/attach.pbm), adjust `image-directory' + ;; accordingly. + (and dir + (setq dir (file-name-directory dir)) + (progn + (while (setq parent (file-name-directory img)) + (setq img (directory-file-name parent) + dir (expand-file-name "../" dir))) + (setq image-directory dir))))) + (t + (error "Could not find image %s for library %s" image library))) + + ;; Return augmented `image-load-path' or `load-path'. + (cond ((and path (symbolp path)) + (nconc (list image-directory) + (delete image-directory + (if (boundp path) + (copy-sequence (symbol-value path)) + nil)))) + (t + (nconc (list image-directory) + (delete image-directory (copy-sequence load-path))))))) + (defun image-jpeg-p (data) "Value is non-nil if DATA, a string, consists of JFIF image data. We accept the tag Exif because that is the same format."