/[emacs]/emacs/lisp/image.el
ViewVC logotype

Diff of /emacs/lisp/image.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.48 by ttn, Sat Aug 6 22:13:43 2005 UTC revision 1.49 by cyd, Thu Sep 15 14:00:09 2005 UTC
# Line 49  IMAGE-TYPE must be a pair (PREDICATE . T Line 49  IMAGE-TYPE must be a pair (PREDICATE . T
49  with one argument, a string containing the image data.  If PREDICATE returns  with one argument, a string containing the image data.  If PREDICATE returns
50  a non-nil value, TYPE is the image's type.")  a non-nil value, TYPE is the image's type.")
51    
52    (defvar image-load-path
53      (list (file-name-as-directory (expand-file-name "images" data-directory))
54            data-directory 'load-path)
55      "List of locations in which to search for image files.
56    If an element is a string, it defines a directory to search in.
57    If an element is a variable symbol, the value of that variable is
58    used as a list of directories to search.")
59    
60  (defun image-jpeg-p (data)  (defun image-jpeg-p (data)
61    "Value is non-nil if DATA, a string, consists of JFIF image data.    "Value is non-nil if DATA, a string, consists of JFIF image data.
62  We accept the tag Exif because that is the same format."  We accept the tag Exif because that is the same format."
# Line 269  BUFFER nil or omitted means use the curr Line 277  BUFFER nil or omitted means use the curr
277            (delete-overlay overlay)))            (delete-overlay overlay)))
278        (setq overlays (cdr overlays)))))        (setq overlays (cdr overlays)))))
279    
280    (defun image-search-load-path (file path)
281      (let (found pathname)
282        (while (and (not found) (consp path))
283          (cond
284           ((stringp (car path))
285            (setq found
286                  (file-readable-p
287                   (setq pathname (expand-file-name file (car path))))))
288           ((and (symbolp (car path)) (boundp (car path)))
289            (if (setq pathname (image-search-load-path
290                                file (symbol-value (car path))))
291                (setq found t))))
292          (setq path (cdr path)))
293        (if found pathname)))
294    
295  ;;;###autoload  ;;;###autoload
296  (defun find-image (specs)  (defun find-image (specs)
# Line 286  is supported, and FILE exists, is used t Line 308  is supported, and FILE exists, is used t
308  specification to be returned.  Return nil if no specification is  specification to be returned.  Return nil if no specification is
309  satisfied.  satisfied.
310    
311  The image is looked for first on `load-path' and then in `data-directory'."  The image is looked for in `image-load-path'."
312    (let (image)    (let (image)
313      (while (and specs (null image))      (while (and specs (null image))
314        (let* ((spec (car specs))        (let* ((spec (car specs))
# Line 296  The image is looked for first on `load-p Line 318  The image is looked for first on `load-p
318               found)               found)
319          (when (image-type-available-p type)          (when (image-type-available-p type)
320            (cond ((stringp file)            (cond ((stringp file)
321                   (let ((path load-path))                   (if (setq found (image-search-load-path
322                     (while (and (not found) path)                                    file image-load-path))
323                       (let ((try-file (expand-file-name file (car path))))                       (setq image
324                         (when (file-readable-p try-file)                             (cons 'image (plist-put (copy-sequence spec)
325                           (setq found try-file)))                                                     :file found)))))
                      (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))))))  
326                  ((not (null data))                  ((not (null data))
327                   (setq image (cons 'image spec)))))                   (setq image (cons 'image spec)))))
328          (setq specs (cdr specs))))          (setq specs (cdr specs))))

Legend:
Removed from v.1.48  
changed lines
  Added in v.1.49

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26