gmm-image-load-path-for-library redux (was: New GNOME icons)

[Bill Wohler <wohler@newt.com>]

Katsumi Yamaoka <yamaoka@jpl.org> wrote:

> >>>>> In <yamaokairqgeatp.fsf@jpl.org> Katsumi Yamaoka wrote:
> 
> > It suggests there's no way that she uses her favorite images instead
> > of the ones Emacs provides.
> 
> An alternative plan is here:
> 
>       * gmm-utils.el (gmm-image-load-path-for-library): Look for the
>       most preferred directory which may be specified in image-load-path
>       by a user.

Rats, that's why we had the mh-image-directory variable...

>       ;; Check for another directory that is specified in
>       ;; image-load-path and preferred than image-directory.
>       ((and image-directory
>             (boundp 'image-load-path))
>        (let ((image-load-path
>               (butlast
>                (symbol-value 'image-load-path)
>                (length (member (file-name-as-directory image-directory)
>                                (mapcar
>                                 (lambda (dir)
>                                   (if (stringp dir)
>                                       (file-name-as-directory dir)
>                                     dir))
>                                 (symbol-value 'image-load-path)))))))
>          (setq dir (image-search-load-path image))))
>

Oh boy, that took me about an hour to figure out ;-). Assuming I've
understood correctly, I think I see a couple of problems.

I don't see how (butlast) can be right. That code is stripping away the
directory found in .../etc/images *plus* all of the directories that
follow it which could include the user's directory. Most likely
.../etc/images won't be in image-load-path at all, so the last directory
in image-load-path will be stripped (which could be the user's
directory if they preferred to use the system images but provided images
as a fall-back).

I'm not quite sure of the whole point of that exercise anyway. Why not
just call (image-search-load-path image)?

But still, this isn't correct. If the user does *not* have a preferred
version, and you're running an external package, you'd prefer the
.../etc/images version over the one already in image-load-path. But this
code would give you the directory already in image-load-path.

A minor point, but why use (symbol-value 'image-load-path)? Why not just
the simpler and clearer image-load-path?

What I think might work is that we call (image-search-load-path image)
and use it instead of .../etc/images if and only if it isn't the system
image directory. The system image directory is (concat data-directory
"images"), right?

Here is a reworked function that seems to do what everybody wants (and
hopefully doesn't take an hour to understand ;-). What do you think?


(defun image-load-path-for-library (library image &optional path no-error)
  "Return a suitable search path for images relative to LIBRARY.

First it searches for IMAGE in a path suitable for LIBRARY, which
includes \"../../etc/images\" and \"../etc/images\" relative to
the library file itself, followed by `image-load-path' and
`load-path'.

Then this function returns a list of directories which contains
first the directory in which IMAGE was found, followed by the
value of `load-path'. If PATH is given, it is used instead of
`load-path'.

If NO-ERROR is non-nil and a suitable path can't be found, don't
signal an error. Instead, return a list of directories as before,
except that nil appears in place of the image directory.

Here is an example that uses a common idiom to provide
compatibility with versions of Emacs that lack the variable
`image-load-path':

    ;; Shush compiler.
    (defvar image-load-path)

    (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
           (image-load-path (cons (car load-path)
                                  (when (boundp 'image-load-path)
                                    image-load-path))))
      (mh-tool-bar-folder-buttons-init))"
  (unless library (error "No library specified"))
  (unless image   (error "No image specified"))
  (let (image-directory image-directory-load-path)
    ;; 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.
      (when dir
        (setq dir (file-name-directory dir))
        (while (setq parent (file-name-directory img))
          (setq img (directory-file-name parent)
                dir (expand-file-name "../" dir))))
      (setq image-directory-load-path dir))

    ;; If `image-directory-load-path' isn't Emacs' image directory,
    ;; it's probably a user preference, so use it. Then use a
    ;; relative setting if possible; otherwise, use
    ;; `image-directory-load-path'.
    (cond
     ;; User-modified image-load-path?
     ((and image-directory-load-path
           (not (equal image-directory-load-path
                       (file-name-as-directory
                        (expand-file-name "images" data-directory)))))
      (setq image-directory image-directory-load-path))
     ;; 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 (file-name-as-directory
               (expand-file-name
                (concat (file-name-directory library-name) "../../etc/images")))
         ;; Go down 1 level.
         d1ei (file-name-as-directory
               (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)))))
     (image-directory-load-path
      (setq image-directory image-directory-load-path))
     (no-error
      (message "Could not find image %s for library %s" image library))
     (t
      (error "Could not find image %s for library %s" image library)))

    ;; Return an augmented `path' or `load-path'.
    (nconc (list image-directory)
           (delete image-directory (copy-sequence (or path load-path))))))


-- 
Bill Wohler <wohler@newt.com>  http://www.newt.com/wohler/  GnuPG ID:610BD9AD
Maintainer of comp.mail.mh FAQ and MH-E. Vote Libertarian!
If you're passed on the right, you're in the wrong lane.


-------------------------------------------------------
This SF.Net email is sponsored by xPML, a groundbreaking scripting language
that extends applications into web and mobile media. Attend the live webcast
and join the prime developer group breaking into this new coding territory!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642