mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-03 14:10:47 -08:00
Code Issues Projects Releases Wiki Activity

(image-type-header-regexps): Rename from image-type-regexps.

Browse source 
Change uses.
(image-type-file-name-regexps): New defconst.
(image-type-from-data): Simplify loop.
(image-type-from-buffer): New defun.
(image-type-from-file-header): Use it instead of image-type-from-data.
Use image-search-load-path instead of only looking in data-directory.
(image-type-from-file-name): New defun.
(image-search-load-path): Make PATH arg optional, default to image-load-path.
Change `pathname' to `filename'.
This commit is contained in:
Kim F. Storm 2005-10-21 23:42:21 +00:00
parent 76b581f284
commit 4fde92efda
1 changed files with 91 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

117
lisp/image.el
View file

@ -33,7 +33,7 @@
:group 'multimedia)
(defconst image-type-regexps
(defconst image-type-header-regexps
'(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
("\\`P[1-6]" . pbm)
("\\`GIF8" . gif)
@ -49,6 +49,21 @@ IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
with one argument, a string containing the image data. If PREDICATE returns
a non-nil value, TYPE is the image's type.")
(defconst image-type-file-name-regexps
'(("\\.png\\'" . png)
("\\.gif\\'" . gif)
("\\.jpe?g\\'" . jpeg)
("\\.bmp\\'" . bmp)
("\\.xpm\\'" . xpm)
("\\.pbm\\'" . pbm)
("\\.xbm\\'" . xbm)
("\\.ps\\'" . postscript)
("\\.tiff?\\'" . tiff))
"Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
When the name of an image file match REGEXP, it is assumed to
be of image type IMAGE-TYPE.")
(defvar image-load-path
(list (file-name-as-directory (expand-file-name "images" data-directory))
'data-directory 'load-path)
@ -87,18 +102,50 @@ We accept the tag Exif because that is the same format."
"Determine the image type from image data DATA.
Value is a symbol specifying the image type or nil if type cannot
be determined."
(let ((types image-type-regexps)
(let ((types image-type-header-regexps)
type)
(while (and types (null type))
(while types
(let ((regexp (car (car types)))
(image-type (cdr (car types))))
(when (or (and (symbolp image-type)
(string-match regexp data))
(and (consp image-type)
(funcall (car image-type) data)
(setq image-type (cdr image-type))))
(setq type image-type))
(setq types (cdr types))))
(if (or (and (symbolp image-type)
(string-match regexp data))
(and (consp image-type)
(funcall (car image-type) data)
(setq image-type (cdr image-type))))
(setq type image-type
types nil)
(setq types (cdr types)))))
type))
;;;###autoload
(defun image-type-from-buffer ()
"Determine the image type from data in the current buffer.
Value is a symbol specifying the image type or nil if type cannot
be determined."
(let ((types image-type-header-regexps)
type
(opoint (point)))
(goto-char (point-min))
(while types
(let ((regexp (car (car types)))
(image-type (cdr (car types)))
data)
(if (or (and (symbolp image-type)
(looking-at regexp))
(and (consp image-type)
(funcall (car image-type)
(or data
(setq data
(buffer-substring
(point-min)
(min (point-max)
(+ (point-min) 256))))))
(setq image-type (cdr image-type))))
(setq type image-type
types nil)
(setq types (cdr types)))))
(goto-char opoint)
type))
@ -107,14 +154,30 @@ be determined."
"Determine the type of image file FILE from its first few bytes.
Value is a symbol specifying the image type, or nil if type cannot
be determined."
(unless (file-name-directory file)
(setq file (expand-file-name file data-directory)))
(setq file (expand-file-name file))
(let ((header (with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file nil 0 256)
(buffer-string))))
(image-type-from-data header)))
(unless (or (file-readable-p file)
(file-name-absolute-p file))
(setq file (image-search-load-path file)))
(and file
(file-readable-p file)
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file nil 0 256)
(image-type-from-buffer))))
;;;###autoload
(defun image-type-from-file-name (file)
"Determine the type of image file FILE from its name.
Value is a symbol specifying the image type, or nil if type cannot
be determined."
(let ((types image-type-file-name-regexps)
type)
(while types
(if (string-match (car (car types)) file)
(setq type (cdr (car types))
types nil)
(setq types (cdr types))))
type))
;;;###autoload
@ -124,6 +187,7 @@ Image types are symbols like `xbm' or `jpeg'."
(and (fboundp 'init-image-library)
(init-image-library type image-library-alist)))
;;;###autoload
(defun create-image (file-or-data &optional type data-p &rest props)
"Create an image.
@ -281,27 +345,29 @@ BUFFER nil or omitted means use the current buffer."
(delete-overlay overlay)))
(setq overlays (cdr overlays)))))
(defun image-search-load-path (file path)
(let (element found pathname)
(defun image-search-load-path (file &optional path)
(unless path
(setq path image-load-path))
(let (element found filename)
(while (and (not found) (consp path))
(setq element (car path))
(cond
((stringp element)
(setq found
(file-readable-p
(setq pathname (expand-file-name file element)))))
(setq filename (expand-file-name file element)))))
((and (symbolp element) (boundp element))
(setq element (symbol-value element))
(cond
((stringp element)
(setq found
(file-readable-p
(setq pathname (expand-file-name file element)))))
(setq filename (expand-file-name file element)))))
((consp element)
(if (setq pathname (image-search-load-path file element))
(if (setq filename (image-search-load-path file element))
(setq found t))))))
(setq path (cdr path)))
(if found pathname)))
(if found filename)))
;;;###autoload
(defun find-image (specs)
@ -331,8 +397,7 @@ Image files should not be larger than specified by `max-image-size'."
found)
(when (image-type-available-p type)
(cond ((stringp file)
(if (setq found (image-search-load-path
file image-load-path))
(if (setq found (image-search-load-path file))
(setq image
(cons 'image (plist-put (copy-sequence spec)
:file found)))))