This is a spot of code extending image-mode (emacs 22) or
auto-image-file-mode (emacs 21 and 22) to show the text comments from
png, jpeg and gif files.

I wanted to see author and copyright info from png files (there's
specified fields for that info), and it seemed cute to do it from emacs
as opposed to running one of the various tag info programs.

This is sort of at "concept" stage. It could show further info, or go
through the image libraries. I think the idea of image-mode showing
text comments is pretty sound though, especially since emacs at one time
was a text editor, not an image viewer.

;;; imagetext.el --- show text parts of image files

;; Copyright 2006, 2007 Kevin Ryde

;; Author: Kevin Ryde zip.com.au>
;; Version: 1
;; Keywords: multimedia
;; URL: http://www.geocities.com/user42_kevin/imagetext/index.html

;; imagetext.el is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 2, or (at your option) any later
;; version.
;;
;; imagetext.el is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
;; Public License for more details.
;;
;; You can get a copy of the GNU General Public License online at
;; http://www.gnu.org/licenses/gpl.txt, or you should have one in the file
;; COPYING which comes with GNU Emacs and other GNU programs. Failing that,
;; write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301 USA.

;;; Commentary:

;; This code extends `image-mode' in Emacs 22 and `auto-image-file-mode' in
;; Emacs 21 and 22 to show text comment parts of PNG, JPEG and GIF files.
;; The image size is shown too (for all image types).
;;
;; There's no way to edit the image text, but of course there's no way to
;; edit the image itself either.
;;
;; Caution: The plain image modes don't change the buffer contents, so you
;; can save under a different filename. But the text added here breaks
;; that. In Emacs 22 `image-mode' if you switch back to raw with the usual
;; C-c C-c then the text extras are removed too, and hopefully it should
;; work to save from there.

;;; Install:

;; For auto-image-file-mode, put the following in your .emacs. Note for
;; Emacs 21 you also need a copy of bindat.el (from emacs 22, it works in
;; emacs 21 unmodified),
;;
;; (eval-after-load "image-file"
;; '(require 'imagetext))
;;
;; For Emacs 22 image-mode, put the following in your .emacs,
;;
;; (autoload 'imagetext-show "imagetext")
;; (add-hook 'image-mode-hook 'imagetext-show)
;;
;; image-mode.el can work in Emacs 21 too actually, with some gentle
;; persuasion.

;;; History:

;; Version 1 - the first version.

;;; Code:

(require 'bindat)

;;-----------------------------------------------------------------------------
;; misc

(defun imagetext-bindat-nulterm ()
"Pick out a nul-terminated string for a bindat specification.
For example

(my-asciz-field eval (imagetext-bindat-nulterm))

The terminating 0 byte is skipped, and not included in the string
returned as the field value."

(let ((start bindat-idx)
(pos bindat-idx)
(end (length bindat-raw)))
(while (and (< pos end)
(/= (aref bindat-raw bindat-idx) 0))
(setq bindat-idx (1+ bindat-idx)))
(prog1 (substring bindat-raw start bindat-idx)
(setq bindat-idx (min end (1+ bindat-idx))))))

(defun imagetext-inflate (str)
"Inflate Zlib (RFC 1950) format compressed data STR.
STR should be unibyte and the return is similarly a unibyte string.

This is implemented by running the gzip program, which is pretty
nasty since usually Emacs has zlib linked in already (used by
libpng) so one day there might be a direct interface to it."

(let* ((flg (aref str 1))
(fdict (logand flg #x20))
(cm (logand #x0F (aref str 0))))
(if (= 01 fdict)
""

(with-temp-buffer
(set-buffer-multibyte nil)
(insert (string 31 139 ;; ID1,ID2
cm ;; CM compression method
0 ;; FLG flags
0 0 0 0 ;; MTIME
0 ;; XFL extra flags
3)) ;; OS = Unix
(insert (substring str 2)) ;; drop CMF and FLG
(insert (string 0 0 0 0)) ;; ISIZE faked
(let* ((coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion)
(status (call-process-region (point-min) (point-max) "gzip"
t '(t nil) nil "-d")))
;; report if died by signal, other errors are expected because we
;; leave the zlib ADLER32 checksum pretending to be CRC32 (wrong
;; of course), and the ISIZE uncompressed size is faked
(when (stringp status)
(goto-char (point-min))
(insert (format "" status))))
(buffer-string)))))

(defun imagetext-size-string (image)
"Return a string representing the size of IMAGE."

;; `image-size' throws an error on a non-gui display, which is a shame
;; because the image libraries can give the info without displaying
(let ((str "\n\n")
(size (condition-case nil (image-size image t) (error nil))))
(when size
(setq str (format "%%sSize %%dx%%d" str (car size) (cdr size)))
(if (fboundp 'image-extension-data) ;; emacs 22
(let* ((extdata (image-extension-data image))
(count (plist-get extdata 'count))) ;; multi-image GIF
(when count
(setq str (format "%%s, %%d images" str count)))))
(setq str (concat str "\n")))
str))

;;-----------------------------------------------------------------------------
;; png bits

(defun imagetext-png-zTXt-inflate (method data)
"Inflate a PNG compresed data string.
METHOD is the integer method code, but only 0 for \"inflate\" is
supported, for others a warning message string is returned.
DATA is a unibyte string and on success the return is likewise a
unibyte string."
(cond ((= method 0)
(imagetext-inflate data))
(t
(format "" method))))

(defun imagetext-png-strings ()
"Extract text comments from a PNG file in the current buffer.
The return is a list of strings describing the elements found.
The buffer should be unibyte, but the strings returned are
decoded into multibyte forms."

(let ((raw (buffer-substring-no-properties (point-min) (point-max)))
(pos 8)
ret)
(while (< pos (length raw))
;; chunk
(let* ((struct (bindat-unpack '((length u32)
(type str 4)
(data str (length))
(crc str 4)
((eval (setq pos bindat-idx))))
raw pos))
(type (bindat-get-field struct 'type))
(data (bindat-get-field struct 'data)))

(if nil ;; diagnostic message, disabled
(push (format "%%s: %%s bytes\n" type (length data)) ret))

(cond
((string-equal type "tEXt")
(let* ((struct (bindat-unpack
'((keyword eval (imagetext-bindat-nulterm))
(text str (eval (- (length bindat-raw)
bindat-idx))))
data)))
(push (format "%%s: %%s\n"
(decode-coding-string
(bindat-get-field struct 'keyword) 'latin-1)
(decode-coding-string
(bindat-get-field struct 'text) 'latin-1)) ret)))

((string-equal type "zTXt")
(let* ((struct (bindat-unpack
'((keyword eval (imagetext-bindat-nulterm))
(method u8)
(comptext str (eval (- (length bindat-raw)
bindat-idx))))
data)))
(push (format "%%s: %%s\n"
(decode-coding-string
(bindat-get-field struct 'keyword) 'latin-1)
(decode-coding-string
(imagetext-png-zTXt-inflate
(bindat-get-field struct 'method)
(bindat-get-field struct 'comptext))
'latin-1)) ret)))

((string-equal type "iTXt")
(let* ((struct (bindat-unpack
'((keyword eval (imagetext-bindat-nulterm))
(compflag u8)
(method u8)
(lang eval (imagetext-bindat-nulterm))
(lkeyword eval (imagetext-bindat-nulterm))
(comptext str (eval (- (length bindat-raw)
bindat-idx))))
data))
(text (bindat-get-field struct 'text)))
(if (= 1 (bindat-get-field struct 'compflag))
(setq text (imagetext-png-zTXt-inflate
(bindat-get-field struct 'method) text)))
(push (format "%%s %%s %%s: %%s\n"
(decode-coding-string
(bindat-get-field struct 'keyword) 'latin-1)
(decode-coding-string ;; supposed to be ascii
(bindat-get-field struct 'lang) 'undecided)
(decode-coding-string
(bindat-get-field struct 'lkeyword) 'utf-8)
(decode-coding-string text 'utf-8))
ret)))

((string-equal type "tIME")
(let* ((struct (bindat-unpack '((year u16)
(month u8)
(day u8)
(hour u8)
(minute u8)
(second u8)) data)))
(push (format "%%s: %%d-%%02d-%%02d %%02d:%%02d:%%02d\n"
type
(bindat-get-field struct 'year)
(bindat-get-field struct 'month)
(bindat-get-field struct 'day)
(bindat-get-field struct 'hour)
(bindat-get-field struct 'minute)
(bindat-get-field struct 'second))
ret))))))
(nreverse ret)))

;;-----------------------------------------------------------------------------
;; jpeg bits

(defun imagetext-jpeg-strings ()
"Extract text comments from a JPEG file in the current buffer.
The return is a list of strings describing the elements found.
The buffer should be unibyte, but the strings returned are
decoded into multibyte forms."

(let ((raw (buffer-substring-no-properties (point-min) (point-max)))
(pos 0)
ret)

(while (progn
;; skip to FF in case we're within ECS data; no attempt to
;; track when we're supposed or not supposed to be in ECS, just
;; skip
(while (and (< pos (length raw))
(/= #xFF (aref raw pos)))
(setq pos (1+ pos)))

(< pos (length raw)))

(let* ((struct (bindat-unpack
'((marker u16)
(union (eval last)
;; escapes within ECS treated as marker only
(#xFF00) (#xFFFF)
;; RST0 through RST7, marker only
(#xFFD0) (#xFFD1) (#xFFD2) (#xFFD3)
(#xFFD4) (#xFFD5) (#xFFD6) (#xFFD7)
;; SOI and EOI, marker-only
(#xFFD8) (#xFFD9)

(t (length u16)
(data str (eval (- last 2)))))
((eval (setq pos bindat-idx))))
raw pos))
(marker (bindat-get-field struct 'marker))
(data (bindat-get-field struct 'data)))

(if nil ;; diagnostic message, disabled
(push (format "%%x: %%s bytes\n" marker (length data)) ret))

(cond ((= #xFFD9 marker) ;; EOI
;; stop, in case garbage after
(setq pos (length raw)))

((= #xFFE0 marker) ;; APP0
(let* ((struct (bindat-unpack '((ident str 4)
(null u8)
(major-version u8)
(minor-version u8))
data)))

(push (format "%%s version %%d.%%02d\n"
(bindat-get-field struct 'ident)
(bindat-get-field struct 'major-version)
(bindat-get-field struct 'minor-version))
ret)))

((= #xFFFE marker) ;; COM comment
;; dunno what the text encoding should be, let emacs guess
(push (format "%%s\n"
(decode-coding-string data 'undecided))
ret)))))
(nreverse ret)))

;;-----------------------------------------------------------------------------
;; gif bits

(defun imagetext-gif-strings ()
"Extract text comments from a GIF file in the current buffer.
The return is a list of strings describing the elements found.
The buffer should be unibyte, but the strings returned are
decoded into multibyte forms."

(let* ((raw (buffer-substring-no-properties (point-min) (point-max)))
(pos 0)
ret)

;; header
(let* ((struct (bindat-unpack '((sig+ver str 6)
(width u16r)
(height u16r)
(flags u8)
(background u8)
(aspect-ratio u8)
((eval (setq pos bindat-idx))))
raw))
(flags (bindat-get-field struct 'flags))
(gct-flag (= #x80 (logand #x80 flags)))
(gct-size (logand #x07 flags)))

;; global colour table 3*2^(gctsize+1) bytes, when flag set
(if gct-flag
(setq pos (+ pos (* 3 (ash 2 gct-size)))))

(push (format "%%s\n" (bindat-get-field struct 'sig+ver))
ret))

(while (< pos (length raw))
(let* ((type (aref raw pos)))
(setq pos (1+ pos))

(cond ((= #x3B type) ;; trailer
)

((= #x2C type) ;; image descriptor
(let* ((struct (bindat-unpack '((left u16r)
(top u16r)
(width u16r)
(height u16r)
(flags u8)
((eval (setq pos bindat-idx))))
raw pos))
(flags (bindat-get-field struct 'flags))
(lct-flag (= #x80 (logand #x80 flags)))
(lct-size (logand #x07 flags)))
;; local colour table 3*2^(lctsize+1) bytes, when flag set
(if lct-flag
(setq pos (+ pos (* 3 (ash 2 lct-size)))))

;; table data
(setq pos (1+ pos)) ;; LZW minimum code size
;; data blocks, first byte is length, stop at 0 len
(while (let ((blocklen (aref raw pos)))
(setq pos (+ pos 1 blocklen))
(/= 0 blocklen)))))

((= #x21 type) ;; extension
(setq type (aref raw pos))
(setq pos (1+ pos))

(let ((data ""))
;; concat data blocks, first byte is length, stop at 0 len
(while (let ((blocklen (aref raw pos)))
(setq data (concat data
(substring raw (1+ pos)
(+ pos 1 blocklen))))
(setq pos (+ pos 1 blocklen))
(/= 0 blocklen)))

(cond ((= #xFE type) ;; comment
;; supposed to be 7-bit ascii, attempt a decode in case
(push (format "%%s\n"
(decode-coding-string data 'undecided))
ret))))))))
(nreverse ret)))

;;-----------------------------------------------------------------------------
;; image text insertions

(defun imagetext-strings (image)
"Extract text comments from an image file in the current buffer.
IMAGE is an image descriptor for the buffer.
The return is a list of strings describing the elements found."

;; image size for all images, then type specific
(let ((type (plist-get (cdr image) :type)))
(cons (imagetext-size-string image)
(condition-case err
(cond ((eq type 'gif) (imagetext-gif-strings))
((eq type 'jpeg) (imagetext-jpeg-strings))
((eq type 'png) (imagetext-png-strings)))
(error (list "Invalid or unrecognised image file contents\n"
err))))))

(defun imagetext-insert-after-image ()
"Insert text information for an image at point.
The image should be at point in the form of a display property on
the raw bytes. Text from the image is inserted immediately after
that."

(let ((image (get-text-property (point) 'display)) ;; image descriptor
(modified (buffer-modified-p))
(inhibit-read-only t)) ;; avoid read-only on image
(when image
(unwind-protect
(save-excursion
(save-restriction
;; the image data part
(narrow-to-region (point) (or (next-property-change (point))
(point-max)))

;; the following leaves the buffer alone and builds text parts
;; in a list, since obviously don't want to change the buffer
;; contents until everything picked out, and also switch back
;; to multibyte until the end
;;
(set-buffer-multibyte nil)
(let ((lst (imagetext-strings image)))

;; changing from unibyte to multibyte makes a mess of the
;; image property coverage, restore it
(let ((props (text-properties-at (point-min))))
(set-buffer-multibyte t)
(set-text-properties (point-min) (point-max) props))

;; now actually insert the text parts built
(goto-char (point-max))
(mapc 'insert lst))))

;; if an error occurs while making our insertions still consider
;; unmodified
(restore-buffer-modified-p modified)))))

;;-----------------------------------------------------------------------------
;; extending image-mode

(defvar imagetext-marker nil
"A marker for where the image ends and the extra text begins.")
(make-variable-buffer-local 'imagetext-marker)

(defun imagetext-show ()
"Show text fields from a PNG file.
This function adds the fields when `image-mode' is showing the image as an
image, or removes them if it's showing raw bytes."

(when (display-images-p) ;; image-mode does nothing if images not displayable
(let ((inhibit-read-only t)
(modified (buffer-modified-p))
(image (get-text-property (point-min) 'display)))

;; delete old bits, if any
(when imagetext-marker
(delete-region imagetext-marker (point-max))
(setq imagetext-marker nil))
(set-buffer-multibyte nil)

;; insert new bits, if displaying as image
(when image
(setq imagetext-marker (point-max-marker))
(goto-char (point-min))
(imagetext-insert-after-image)
(setq cursor-type t))

(set-buffer-modified-p modified))))

(defadvice image-toggle-display (after imagetext activate)
"Show text fields from PNG, JPEG and GIF files."
(imagetext-show))

;;-----------------------------------------------------------------------------
;; extending auto-image-file-mode

(defadvice insert-image-file (after imagetext
(file &optional visit beg end replace)
activate)
"Show text fields from PNG, JPEG and GIF files."
;; same condition as image-file.el tests
(when (and (or (null beg) (zerop beg)) (null end))
(imagetext-insert-after-image)))

(provide 'imagetext)

;;; imagetext.el ends here

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.6 (GNU/Linux)

iD8DBQBGTj6wLFMCIV9q3ToRAvUyAJ9wXRe0fuyU10VrRmNEYJ5iLLVpiwCgtV86
lj9dZNqVyi5vYM6G0nzG7fU=
=Si/+