(c-require-final-newline): Added a variable to make the initialization of

[bpt/emacs.git] / lisp / image.el

diff --git a/lisp/image.el b/lisp/image.el
index fe9dd5b..ac1ef55 100644 (file)
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1,6 +1,8 @@
 ;;; image.el --- image API
 
-;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
 ;; Keywords: multimedia
 
 ;; This file is part of GNU Emacs.
@@ -24,18 +26,49 @@
 
 ;;; Code:
 
+
+(defgroup image ()
+  "Image support."
+  :group 'multimedia)
+
+
 (defconst image-type-regexps
-  '(("^/\\*.*XPM.\\*/" . xpm)
-    ("^P[1-6]" . pbm)
-    ("^GIF8" . gif)
-    ("JFIF" . jpeg)
-    ("^\211PNG\r\n" . png)
-    ("^#define" . xbm)
-    ("^\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff)
-    ("^%!PS" . ghostscript))
+  '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
+    ("\\`P[1-6]" . pbm)
+    ("\\`GIF8" . gif)
+    ("\\`\211PNG\r\n" . png)
+    ("\\`[\t\n\r ]*#define" . xbm)
+    ("\\`\\(MM\0\\*\\|II\\*\0\\)" . tiff)
+    ("\\`[\t\n\r ]*%!PS" . postscript)
+    ("\\`\xff\xd8" . (image-jpeg-p . jpeg)))
   "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
 When the first bytes of an image file match REGEXP, it is assumed to
-be of image type IMAGE-TYPE.")
+be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol.  If not a symbol,
+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 ")
+
+
+(defun image-jpeg-p (data)
+  "Value is non-nil if DATA, a string, consists of JFIF image data.
+We accept the tag Exif because that is the same format."
+  (when (string-match "\\`\xff\xd8" data)
+    (catch 'jfif
+      (let ((len (length data)) (i 2))
+       (while (< i len)
+         (when (/= (aref data i) #xff)
+           (throw 'jfif nil))
+         (setq i (1+ i))
+         (when (>= (+ i 2) len)
+           (throw 'jfif nil))
+         (let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
+                          (aref data (+ i 2))))
+               (code (aref data i)))
+           (when (and (>= code #xe0) (<= code #xef))
+             ;; APP0 LEN1 LEN2 "JFIF\0"
+             (throw 'jfif 
+                    (string-match "JFIF\\|Exif" (substring data i (+ i nbytes)))))
+           (setq i (+ i 1 nbytes))))))))
 
 
 ;;;###autoload
@@ -48,7 +81,11 @@ be determined."
     (while (and types (null type))
       (let ((regexp (car (car types)))
            (image-type (cdr (car types))))
-       (when (string-match regexp data)
+       (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))))
     type))
@@ -63,6 +100,7 @@ be determined."
     (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)))
@@ -82,10 +120,10 @@ FILE-OR-DATA is an image file name or image data.
 Optional TYPE is a symbol describing the image type.  If TYPE is omitted
 or nil, try to determine the image type from its first few bytes
 of image data.  If that doesn't work, and FILE-OR-DATA is a file name,
-use its file extension.as image type.
+use its file extension as image type.
 Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
 Optional PROPS are additional image attributes to assign to the image,
-like, e.g. `:heuristic-mask t'.
+like, e.g. `:mask MASK'.
 Value is the image created, or nil if images of type TYPE are not supported."
   (when (and (not data-p) (not (stringp file-or-data)))
     (error "Invalid image file name `%s'" file-or-data))
@@ -122,9 +160,7 @@ AREA is where to display the image.  AREA nil or omitted means
 display it in the text area, a value of `left-margin' means
 display it in the left marginal area, a value of `right-margin'
 means display it in the right marginal area."
-  ;; Use a space as least likely to cause trouble when it's a hidden
-  ;; character in the buffer.
-  (unless string (setq string " "))
+  (unless string (setq string "x"))
   (let ((buffer (current-buffer)))
     (unless (eq (car-safe image) 'image)
       (error "Not an image: %s" image))
@@ -148,7 +184,9 @@ AREA is where to display the image.  AREA nil or omitted means
 display it in the text area, a value of `left-margin' means
 display it in the left marginal area, a value of `right-margin'
 means display it in the right marginal area."
-  (unless string (setq string "x"))
+  ;; Use a space as least likely to cause trouble when it's a hidden
+  ;; character in the buffer.
+  (unless string (setq string " "))
   (unless (eq (car-safe image) 'image)
     (error "Not an image: %s" image))
   (unless (or (null area) (memq area '(left-margin right-margin)))
@@ -165,11 +203,7 @@ means display it in the right marginal area."
   (let ((start (point)))
     (insert string)
     (add-text-properties start (point)
-                        (list 'display image
-                              ;; `image' has the right properties to
-                              ;; mark an intangible field.
-                              'intangible image
-                              'rear-nonsticky (list 'display)))))
+                        `(display ,image rear-nonsticky (display)))))
 
 
 ;;;###autoload
@@ -225,7 +259,8 @@ The image is looked for first on `load-path' and then in `data-directory'."
                           (setq found try-file))))
                   (if found
                       (setq image
-                            (cons 'image (plist-put spec :file found))))))
+                            (cons 'image (plist-put (copy-sequence spec)
+                                                    :file found))))))
                ((not (null data))
                 (setq image (cons 'image spec)))))
        (setq specs (cdr specs))))