Mercurial > emacs
comparison lisp/image.el @ 90228:fa0da9b57058
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-82
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 542-553)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 116-121)
- Merge from emacs--cvs-trunk--0
- Update from CVS
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Mon, 19 Sep 2005 10:20:33 +0000 |
| parents | 2d92f5c9d6ae 39114a2ae201 |
| children | 0ca0d9181b5e |
comparison
equal
deleted
inserted
replaced
| 90227:10fe5fadaf89 | 90228:fa0da9b57058 |
|---|---|
| 46 When the first bytes of an image file match REGEXP, it is assumed to | 46 When the first bytes of an image file match REGEXP, it is assumed to |
| 47 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol, | 47 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol, |
| 48 IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called | 48 IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called |
| 49 with one argument, a string containing the image data. If PREDICATE returns | 49 with one argument, a string containing the image data. If PREDICATE returns |
| 50 a non-nil value, TYPE is the image's type.") | 50 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. | |
| 57 If an element is a variable symbol whose value is a string, that | |
| 58 value defines a directory to search. | |
| 59 If an element is a variable symbol whose value is a list, the | |
| 60 value is used as a list of directories to search.") | |
| 51 | 61 |
| 52 (defun image-jpeg-p (data) | 62 (defun image-jpeg-p (data) |
| 53 "Value is non-nil if DATA, a string, consists of JFIF image data. | 63 "Value is non-nil if DATA, a string, consists of JFIF image data. |
| 54 We accept the tag Exif because that is the same format." | 64 We accept the tag Exif because that is the same format." |
| 55 (when (string-match "\\`\xff\xd8" data) | 65 (when (string-match "\\`\xff\xd8" data) |
| 267 (let ((overlay (car overlays))) | 277 (let ((overlay (car overlays))) |
| 268 (when (overlay-get overlay 'put-image) | 278 (when (overlay-get overlay 'put-image) |
| 269 (delete-overlay overlay))) | 279 (delete-overlay overlay))) |
| 270 (setq overlays (cdr overlays))))) | 280 (setq overlays (cdr overlays))))) |
| 271 | 281 |
| 282 (defun image-search-load-path (file path) | |
| 283 (let (element found pathname) | |
| 284 (while (and (not found) (consp path)) | |
| 285 (setq element (car path)) | |
| 286 (cond | |
| 287 ((stringp element) | |
| 288 (setq found | |
| 289 (file-readable-p | |
| 290 (setq pathname (expand-file-name file element))))) | |
| 291 ((and (symbolp element) (boundp element)) | |
| 292 (setq element (symbol-value element)) | |
| 293 (cond | |
| 294 ((stringp element) | |
| 295 (setq found | |
| 296 (file-readable-p | |
| 297 (setq pathname (expand-file-name file element))))) | |
| 298 ((consp element) | |
| 299 (if (setq pathname (image-search-load-path file element)) | |
| 300 (setq found t)))))) | |
| 301 (setq path (cdr path))) | |
| 302 (if found pathname))) | |
| 272 | 303 |
| 273 ;;;###autoload | 304 ;;;###autoload |
| 274 (defun find-image (specs) | 305 (defun find-image (specs) |
| 275 "Find an image, choosing one of a list of image specifications. | 306 "Find an image, choosing one of a list of image specifications. |
| 276 | 307 |
| 284 string containing the actual image data. The specification whose TYPE | 315 string containing the actual image data. The specification whose TYPE |
| 285 is supported, and FILE exists, is used to construct the image | 316 is supported, and FILE exists, is used to construct the image |
| 286 specification to be returned. Return nil if no specification is | 317 specification to be returned. Return nil if no specification is |
| 287 satisfied. | 318 satisfied. |
| 288 | 319 |
| 289 The image is looked for first on `load-path' and then in `data-directory'." | 320 The image is looked for in `image-load-path'." |
| 290 (let (image) | 321 (let (image) |
| 291 (while (and specs (null image)) | 322 (while (and specs (null image)) |
| 292 (let* ((spec (car specs)) | 323 (let* ((spec (car specs)) |
| 293 (type (plist-get spec :type)) | 324 (type (plist-get spec :type)) |
| 294 (data (plist-get spec :data)) | 325 (data (plist-get spec :data)) |
| 295 (file (plist-get spec :file)) | 326 (file (plist-get spec :file)) |
| 296 found) | 327 found) |
| 297 (when (image-type-available-p type) | 328 (when (image-type-available-p type) |
| 298 (cond ((stringp file) | 329 (cond ((stringp file) |
| 299 (let ((path load-path)) | 330 (if (setq found (image-search-load-path |
| 300 (while (and (not found) path) | 331 file image-load-path)) |
| 301 (let ((try-file (expand-file-name file (car path)))) | 332 (setq image |
| 302 (when (file-readable-p try-file) | 333 (cons 'image (plist-put (copy-sequence spec) |
| 303 (setq found try-file))) | 334 :file found))))) |
| 304 (setq path (cdr path))) | |
| 305 (unless found | |
| 306 (let ((try-file (expand-file-name file data-directory))) | |
| 307 (if (file-readable-p try-file) | |
| 308 (setq found try-file)))) | |
| 309 (if found | |
| 310 (setq image | |
| 311 (cons 'image (plist-put (copy-sequence spec) | |
| 312 :file found)))))) | |
| 313 ((not (null data)) | 335 ((not (null data)) |
| 314 (setq image (cons 'image spec))))) | 336 (setq image (cons 'image spec))))) |
| 315 (setq specs (cdr specs)))) | 337 (setq specs (cdr specs)))) |
| 316 image)) | 338 image)) |
| 317 | 339 |