Re: Sharing mail icons between MH-E and Gnus

[Reiner Steib <reinersteib+gmane@imap.cc>]

On Sun, Feb 19 2006, Bill Wohler wrote:

> mh-image-load-path has morphed a bit in the past week. I have yet to
> give some thought to generalizing it.

I modified MH-E's new `mh-image-load-path' a bit to use it in Gnus.  I
didn't do much testing but to avoid duplicate work, I'll post it here.
So please consider it as a draft.

I don't like that `mh-image-load-path' changes the variables
`load-path' or `image-load-path'.  Assume you have unbundled versions
of Gnus and MH-E installed using Emacs 21.  Which path should win, if
we both use the same variable?

`mm-image-load-path' doesn't modify anything.  It just returns a new
path.  Then it was typically used like this:

             (let ((load-path (mm-image-load-path)))
               (setup-the-toolbar-...))

Catering for Emacs 22 (`image-load-path') and Emacs 21 we can use this
in Gnus...

      (let ((load-path (gmm-image-load-path "message" nil 'load-path))
	    (image-load-path
	     (gmm-image-load-path "message" nil 'image-load-path)))
	    (gmm-tool-bar-from-list message-tool-bar
				    message-tool-bar-zap-list
				    'message-mode-map))

--8<---------------cut here---------------start------------->8---
;; From MH-E without modifications:

(defmacro gmm-defun-compat (name function arg-list &rest body)
  "Create function NAME.
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
Otherwise, create function NAME with ARG-LIST and BODY."
  (let ((defined-p (fboundp function)))
    (if defined-p
        `(defalias ',name ',function)
      `(defun ,name ,arg-list ,@body))))

(gmm-defun-compat gmm-image-search-load-path
  image-search-load-path (file &optional path)
  "Emacs 21 and XEmacs don't have `image-search-load-path'.
This function returns nil on those systems."
  nil)

;; From MH-E with modifications:

(defvar gmm-image-load-path nil
  "Directory where images for MH-E are found.
See function `gmm-image-load-path'.")

;; (defvar image-load-path)
(defun gmm-image-load-path (library &optional image path)
  "Return a suitable search path for images of LIBRARY.

Images for LIBRARY are found in \"../../etc/images\" relative to
the files in \"lisp/LIBRARY\", in `image-load-path', or in
`load-path'.

This function returns value of `load-path' augmented with the
path to IMAGE.  If PATH is given, it is used instead of
`load-path'."
  (unless library (error "No library specified."))
  (unless image
    (setq image ;; DWIM
	  (cond ((string-match "^gnus\\>\\|^message" library)
		 "describe.xpm")
		((string-match "^mh-" library)
		 "mh-logo.xpm")
		(t ;; Which icon should be used here?
		 "contact.xpm"))))
  (cond (gmm-image-load-path) ;; User setting exists.
	((let (gmm-library-name) ;; Try relative setting
	   ;; First, find library in the load-path.
	   (setq gmm-library-name (locate-library library))
	   (if (not gmm-library-name)
	       (error "Cannot find library `%s' in load-path" library))
	   ;; And then set gmm-image-load-path relative to that.
	   (setq gmm-image-load-path
		 (expand-file-name (concat
				    (file-name-directory gmm-library-name)
				    "../../etc/images")))
	   (file-exists-p (expand-file-name image gmm-image-load-path))))
	((gmm-image-search-load-path image)
	 ;; Images in image-load-path.
	 (setq gmm-image-load-path
	       (file-name-directory (gmm-image-search-load-path image))))
	((locate-library image)
	 ;; Images in load-path.
	 (setq gmm-image-load-path
	       (file-name-directory (locate-library image)))))
  ;;
  (unless (file-exists-p gmm-image-load-path)
    (error "Directory `%s' in gmm-image-load-path does not exist"
	     gmm-image-load-path))
  (unless (file-exists-p (expand-file-name image gmm-image-load-path))
    (error "Directory `%s' in gmm-image-load-path does not contain image `%s'."
	   gmm-image-load-path image))
  ;; Return augmented `image-load-path' or `load-path'.
  (cond ((and path (symbolp path))
	 (nconc (list gmm-image-load-path) (symbol-value path)))
	(t
	 (nconc (list gmm-image-load-path) load-path))))
--8<---------------cut here---------------end--------------->8---

Bye, Reiner.
-- 
       ,,,
      (o o)
---ooO-(_)-Ooo---  |  PGP key available  |  http://rsteib.home.pages.de/


-------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc. Do you grep through log files
for problems?  Stop!  Download the new AJAX search engine that makes
searching your log files as easy as surfing the  web.  DOWNLOAD SPLUNK!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=103432&bid=230486&dat=121642