* mh-compat.el (mh-image-load-path-for-library): Move here from

[bpt/emacs.git] / lisp / mh-e / mh-compat.el

diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index faa91a3..77e39de 100644 (file)
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -115,6 +115,84 @@ introduced in Emacs 22."
       `(face-background ,face ,frame)
     `(face-background ,face ,frame ,inherit)))
 
+(mh-defun-compat mh-image-load-path-for-library
+  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))
+
+This function is used by Emacs versions that don't have
+`image-load-path-for-library'."
+  (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.
+                  (mh-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)))))))
+
 (mh-defun-compat mh-image-search-load-path
   image-search-load-path (file &optional path)
   "Emacs 21 and XEmacs don't have `image-search-load-path'.