[Emacs-diffs] Changes to emacs/lisp/image.el

[Kim F . Storm]

Index: emacs/lisp/image.el
diff -c emacs/lisp/image.el:1.51 emacs/lisp/image.el:1.52
*** emacs/lisp/image.el:1.51    Wed Oct 19 03:55:20 2005
--- emacs/lisp/image.el Fri Oct 21 23:42:21 2005
***************
*** 33,39 ****
    :group 'multimedia)
  
  
! (defconst image-type-regexps
    '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
      ("\\`P[1-6]" . pbm)
      ("\\`GIF8" . gif)
--- 33,39 ----
    :group 'multimedia)
  
  
! (defconst image-type-header-regexps
    '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
      ("\\`P[1-6]" . pbm)
      ("\\`GIF8" . gif)
***************
*** 49,54 ****
--- 49,69 ----
  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,104 ****
    "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)
        type)
!     (while (and types (null type))
        (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))))
      type))
  
  
--- 102,151 ----
    "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-header-regexps)
        type)
!     (while types
        (let ((regexp (car (car types)))
            (image-type (cdr (car 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,120 ****
    "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)))
  
  
  ;;;###autoload
--- 154,183 ----
    "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 (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,129 ****
--- 187,193 ----
    (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,307 ****
          (delete-overlay overlay)))
        (setq overlays (cdr overlays)))))
  
! (defun image-search-load-path (file path)
!   (let (element found pathname)
      (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)))))
         ((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)))))
         ((consp element)
!         (if (setq pathname (image-search-load-path file element))
              (setq found t))))))
        (setq path (cdr path)))
!     (if found pathname)))
  
  ;;;###autoload
  (defun find-image (specs)
--- 345,373 ----
          (delete-overlay overlay)))
        (setq overlays (cdr overlays)))))
  
! (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 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 filename (expand-file-name file element)))))
         ((consp element)
!         (if (setq filename (image-search-load-path file element))
              (setq found t))))))
        (setq path (cdr path)))
!     (if found filename)))
  
  ;;;###autoload
  (defun find-image (specs)
***************
*** 331,338 ****
             found)
        (when (image-type-available-p type)
          (cond ((stringp file)
!                (if (setq found (image-search-load-path
!                                 file image-load-path))
                     (setq image
                           (cons 'image (plist-put (copy-sequence spec)
                                                   :file found)))))
--- 397,403 ----
             found)
        (when (image-type-available-p type)
          (cond ((stringp file)
!                (if (setq found (image-search-load-path file))
                     (setq image
                           (cons 'image (plist-put (copy-sequence spec)
                                                   :file found)))))