* image-mode showing text title/description/etc
@ 2007-05-23 22:40 Kevin Ryde
2007-05-24 8:28 ` Mathias Dahl
0 siblings, 1 reply; 4+ messages in thread
From: Kevin Ryde @ 2007-05-23 22:40 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 1497 bytes --]
This is my idea to have image-mode display text from an image.
The motivation is that showing an image title is clearly a good thing,
and then showing author, long description, and copyright info are all
pretty useful. But I'm not inclined to go into great detail about image
characteristics, there's tools for doing that already, just stick to the
text bits.
The crunching is in lisp (at least initially) because it's more flexible
than working up an interface to the various C libraries and then
worrying what they can or can't give (libpng 1.2 for instance doesn't
have iTXt enabled by default). Oh and lisp of course can't have any
security problems, for those who worry about the doubtful record of some
of the libraries on that.
The zlib decompression is a nasty hack via gzip, but zlib.c below is an
idea for a primitive. It works, but perhaps I've made some horrible
mistake through ignorance.
I also used a bindat null terminated string parse (ie. go up to the next
\0 however far that is). It'd be a nice feature for bindat to have
builtin, but I couldn't think of a good name, or a good flag for the
existing strz (which is nulterm but only in a fixed length field).
2007-05-24 Kevin Ryde <user42@zip.com.au>
* image-mode.el: Display text comments in image files. Let the mode
work on a tty so text can be seen there too. Don't hide the cursor,
need it on the text. Don't truncate-lines, prefer to wrap the text.
Diff and whole file, whichever is easier to review:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: image-mode.el.diff --]
[-- Type: text/x-diff, Size: 30228 bytes --]
*** /down/emacs/lisp/image-mode.el 2007-05-24 07:44:47.000000000 +1000
--- image-mode.el 2007-05-24 08:02:16.000000000 +1000
***************
*** 35,40 ****
--- 35,41 ----
;;; Code:
(require 'image)
+ (require 'bindat)
;;;###autoload (push '("\\.jpe?g\\'" . image-mode) auto-mode-alist)
;;;###autoload (push '("\\.png\\'" . image-mode) auto-mode-alist)
***************
*** 43,48 ****
--- 44,532 ----
;;;###autoload (push '("\\.p[bpgn]m\\'" . image-mode) auto-mode-alist)
;;;###autoload (push '("\\.x[bp]m\\'" . image-mode-maybe) auto-mode-alist)
+
+ \f
+ ;; image strings
+
+ ;; The concept here, as of now, is just to pick out interesting text parts
+ ;; of an image file, like title, author, copyright information etc.
+ ;;
+ ;; The pieces are shown in the order they're found in the file. PNG and GIF
+ ;; allow text in any order, so perhaps there'll be some significance to it.
+ ;; But TIFF (including JPEG EXIF) is supposed to be sorted by tag code, so
+ ;; there's not particular about the order there.
+ ;;
+ ;; There's lots more information which could be shown, things like colour
+ ;; spectrum, compression, scan directions, but that starts to get very
+ ;; technical. Perhaps some of that could be second-tier priority, shown
+ ;; after main info. But for now leave it to the heavy duty programs like
+ ;; imagemagick, exiftool, image-metadata-jpeg, etc, to go into details.
+ ;;
+ ;; Crunching image formats in lisp might look a bit like hard work, but it's
+ ;; also much more flexible than creating a mechanism and formats for getting
+ ;; stuff up from the C code image libraries. If there was any editing of
+ ;; the info in the future it'd be different, you'd probably want the image
+ ;; libraries to do that.
+
+ (defun imagetext-strings (image raw)
+ "Extract text comments from an image.
+ IMAGE is the image descriptor, or a warning string if not displayable.
+ RAW is a unibyte string of image data.
+ The return is a list of strings describing the things found."
+
+ ;; imagetext-png-strings and imagetext-gif-strings do the image size
+ ;; themselves (an in particular let that info come out on a tty)
+ (let ((type (image-type raw nil t)))
+ (condition-case err
+ (cond ((eq type 'png) (imagetext-png-strings raw))
+ ((eq type 'gif) (imagetext-gif-strings raw))
+ ((eq type 'jpeg) (append (imagetext-size-strings image)
+ (imagetext-jpeg-strings raw)))
+ ((eq type 'tiff) (append (imagetext-size-strings image)
+ (imagetext-tiff-strings raw)))
+ (t (imagetext-size-strings image)))
+ (error (list "Invalid or unrecognised image file contents\n"
+ (error-message-string err))))))
+
+ (defun imagetext-size-strings (image)
+ "Return a list of strings representing the size of IMAGE.
+ IMAGE is an image descriptor, or a warning string if not displayable."
+
+ ;; `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 ((size (condition-case nil (image-size image t) (error nil))))
+ (and size
+ (list (format "Size %dx%d\n" (car size) (cdr size))))))
+
+ (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."
+
+ ;; this implementation only for strings
+ (let ((zpos (or (string-match "\000" bindat-raw bindat-idx)
+ (error "No null terminator"))))
+ (prog1 (substring bindat-raw bindat-idx zpos)
+ (setq bindat-idx (1+ zpos)))))
+
+ \f
+ ;; png strings
+
+ (defun imagetext-png-strings (raw)
+ "Extract text comments from PNG image data.
+ RAW in the image data as a unibyte string, the return is a list
+ of text strings found (multibyte strings)."
+
+ (let ((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 "IHDR")
+ (let* ((struct (bindat-unpack '((:width u32)
+ (:height u32)) data)))
+ (push (format "Size %dx%d\n"
+ (bindat-get-field struct :width)
+ (bindat-get-field struct :height))
+ ret)))
+
+ ((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))
+ (:text 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)))
+
+ (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 "<unknown compression method %s>" method))))
+
+ (defun imagetext-inflate (str)
+ "Inflate Zlib format (RFC 1950) 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)
+ "<Zlib FDICT pre-defined dictionary not supported>"
+
+ (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 "<gzip: %s>" status))))
+ (buffer-string)))))
+
+ \f
+ ;; jpeg strings
+
+ (defun imagetext-jpeg-strings (raw)
+ "Extract text comments from JPEG image data.
+ RAW in the image data as a unibyte string, the return is a list
+ of text strings found (multibyte strings)."
+
+ (let ((pos 0)
+ ret)
+
+ ;; skip to FF each time, to pass over ECS data
+ (while (setq pos (string-match "\377" raw pos))
+
+ (let* ((struct (bindat-unpack
+ '((:marker u16)
+ (union (eval last)
+ ;; escapes in 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)
+ ;; otherwise length and data
+ (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
+ (if (or (eq t (compare-strings data 0 4 "JFIF" 0 4))
+ (eq t (compare-strings data 0 4 "JFXX" 0 4)))
+ (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))))
+
+ ((= #xFFE1 marker) ;; APP1
+ (if (eq t (compare-strings data 0 6 "Exif\000\000" 0 6))
+ ;; exif is a segment of tiff data, including the usual
+ ;; tiff header
+ (setq ret (nconc (nreverse (imagetext-tiff-strings
+ (substring data 6)))
+ 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)))
+
+ \f
+ ;; tiff strings (including EXIF within a JPEG)
+
+ (defun imagetext-tiff-strings (raw)
+ "Extract text comments from TIFF image data.
+ RAW in the image data as a unibyte string, the return is a list
+ of text strings found (multibyte strings)."
+
+ (let* (ret ifdpos X-u16 X-u32)
+
+ ;; 8-byte header
+ ;; X-u16 setup as either 'u16 or 'u16r, according to the endianess, and
+ ;; likewise X-u32
+ (let* ((struct (bindat-unpack '((:endian str 2)
+ ((eval (cond ((string-equal "MM" last)
+ (setq X-u16 'u16)
+ (setq X-u32 'u32))
+ ((string-equal "II" last)
+ (setq X-u16 'u16r)
+ (setq X-u32 'u32r)))))
+ (:mark42 (eval X-u16))
+ (:ifdpos (eval X-u32)))
+ raw)))
+ (setq ifdpos (bindat-get-field struct :ifdpos)))
+
+ ;; loop looking at all IFDs in the file
+ ;; the second and subsequent are supposed to be about sub-images or
+ ;; something, so maybe ought to identify that somehow
+ (while (/= 0 ifdpos)
+
+ ;; The count field is followed by 4 bytes which are either the field
+ ;; data there inline, or a 32-bit file position of the data. Inline
+ ;; is used when there's <= 4 bytes in the field. We test only
+ ;; count<=4 because that's enough for the ascii (count is bytes)
+ ;; fields we're interested in. (And we're safe if ever u32 decode got
+ ;; some overflow checking, because we err in treating some remotes as
+ ;; inline; any u32 decode is certainly a file offset.)
+
+ (let* ((entry-spec '((:tag (eval X-u16))
+ (:type (eval X-u16))
+ (:count (eval X-u32))
+ (union (eval last)
+ ((eval (<= tag 4))
+ (:datapos eval bindat-idx) ;; inline
+ ( fill 4))
+ (t
+ (:datapos (eval X-u32)))))) ;; remote
+ (struct (bindat-unpack '((:numentries (eval X-u16))
+ (:entries repeat (:numentries)
+ (struct entry-spec))
+ (:nextifd (eval X-u32)))
+ raw ifdpos)))
+
+ ;; The alist is the tags to actually show, and only ascii ones
+ ;; supported.
+ ;; - #x13C "HostComputer" is not shown because that seems very
+ ;; irrelevant.
+ ;; - #x131 "Software" is shown; it's of doubtful interest, but in
+ ;; formats like PNG that kind of info shows up, so have it here
+ ;; for consistency.
+ ;; - #x10F "Make" and #x110 "Model" for the camera are
+ ;; possibilities, but would seem of very limited interest
+ ;;
+ (dolist (entry (bindat-get-field struct :entries))
+ (let* ((tag (bindat-get-field entry :tag))
+ (tagname (cdr (assoc tag
+ '((#x10D . "DocumentName")
+ (#x10E . "ImageDescription")
+ (#x11D . "PageName")
+ (#x131 . "Software")
+ (#x132 . "DateTime")
+ (#x13B . "Artist")
+ (#x8298 . "Copyright"))))))
+
+ (if nil ;; diagnostic message, disabled
+ (push (format "tag %x\n" tag) ret))
+
+ (when (and tagname
+ (= 2 (bindat-get-field entry :type))) ;; ASCII
+
+ ;; The value offset field is a 32-bit file position, except if
+ ;; the field is <= 4 bytes, in which case the bytes are inline
+ ;; there directly. The size of each count element varies
+ ;; according to the type, so we don't know how many bytes
+ ;; until identifying the type field, in this case ASCII data
+ ;; which means simply count bytes. (Want to avoid attempting
+ ;; a u32 decode until being sure it's really an offset, in
+ ;; case it's some strange bytes overflowing the conversion.)
+ ;;
+ (let* ((count (bindat-get-field entry :count))
+ (datapos (bindat-get-field entry :datapos))
+ (data (substring raw datapos (+ datapos count))))
+
+ ;; There's always a trailing \0, then any \0's in the middle
+ ;; separate multiple values such as multiple copyright
+ ;; holders in a #x8298 field. Ascii fields are supposed to
+ ;; be ascii, but let's decode as 'undecided just in case
+ ;; there's something zany.
+ ;;
+ (setq data (replace-regexp-in-string "\000\\'" "" data t t))
+ (setq data (decode-coding-string data 'undecided))
+ (dolist (str (split-string data "\000"))
+ (push (format "%s: %s\n" tagname str) ret))))))
+
+ (setq ifdpos (bindat-get-field struct :nextifd))
+ (if (/= 0 ifdpos)
+ (push "\nSubfile:\n" ret))))
+
+ ret))
+
+ \f
+ ;; gif strings
+
+ (defun imagetext-gif-strings (raw)
+ "Extract text comments from GIF image data.
+ RAW is the image data as a unibyte string, the return is a list
+ of text strings found (multibyte strings)."
+
+ (let* ((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, size %dx%d\n"
+ (bindat-get-field struct :sig+ver)
+ (bindat-get-field struct :width)
+ (bindat-get-field struct :height))
+ 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)))
+
+ \f
+
(defvar image-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'image-toggle-display)
***************
*** 60,78 ****
(setq major-mode 'image-mode)
(use-local-map image-mode-map)
(add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
! (if (and (display-images-p)
! (not (get-text-property (point-min) 'display)))
(image-toggle-display)
;; Set next vars when image is already displayed but local
;; variables were cleared by kill-all-local-variables
(setq cursor-type nil truncate-lines t))
(run-mode-hooks 'image-mode-hook)
! (if (display-images-p)
! (message "%s" (concat
! (substitute-command-keys
! "Type \\[image-toggle-display] to view as ")
! (if (get-text-property (point-min) 'display)
! "text" "an image") "."))))
;;;###autoload
(define-minor-mode image-minor-mode
--- 544,560 ----
(setq major-mode 'image-mode)
(use-local-map image-mode-map)
(add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
! (if (not (get-text-property (point-min) 'display))
(image-toggle-display)
;; Set next vars when image is already displayed but local
;; variables were cleared by kill-all-local-variables
(setq cursor-type nil truncate-lines t))
(run-mode-hooks 'image-mode-hook)
! (message "%s" (concat
! (substitute-command-keys
! "Type \\[image-toggle-display] to view as ")
! (if (get-text-property (point-min) 'display)
! "text" "an image") ".")))
;;;###autoload
(define-minor-mode image-minor-mode
***************
*** 125,130 ****
--- 607,617 ----
(defvar archive-superior-buffer)
(defvar tar-superior-buffer)
+ (defvar image-mode-original-multibyte nil)
+ (make-variable-buffer-local 'image-mode-original-multibyte)
+ (defvar image-mode-text-marker nil)
+ (make-variable-buffer-local 'image-mode-text-marker)
+
(defun image-toggle-display ()
"Start or stop displaying an image file as the actual image.
This command toggles between showing the text of the image file
***************
*** 137,150 ****
(remove-list-of-text-properties (point-min) (point-max)
'(display intangible read-nonsticky
read-only front-sticky))
(set-buffer-modified-p modified)
! (kill-local-variable 'cursor-type)
! (kill-local-variable 'truncate-lines)
(if (called-interactively-p)
(message "Repeat this command to go back to displaying the image")))
;; Turn the image data into a real image, but only if the whole file
;; was inserted
(let* ((filename (buffer-file-name))
(image
(if (and filename
(file-readable-p filename)
--- 624,643 ----
(remove-list-of-text-properties (point-min) (point-max)
'(display intangible read-nonsticky
read-only front-sticky))
+ (delete-region image-mode-text-marker (point-max))
+ (set-buffer-multibyte image-mode-original-multibyte)
(set-buffer-modified-p modified)
! (kill-local-variable 'image-mode-text-marker)
! (kill-local-variable 'image-mode-original-multibyte)
! ;; (kill-local-variable 'cursor-type)
! ;; (kill-local-variable 'truncate-lines)
(if (called-interactively-p)
(message "Repeat this command to go back to displaying the image")))
;; Turn the image data into a real image, but only if the whole file
;; was inserted
(let* ((filename (buffer-file-name))
+ (raw (string-make-unibyte
+ (buffer-substring-no-properties (point-min) (point-max))))
(image
(if (and filename
(file-readable-p filename)
***************
*** 155,184 ****
(not (and (boundp 'tar-superior-buffer)
tar-superior-buffer)))
(create-image filename)
! (create-image
! (string-make-unibyte
! (buffer-substring-no-properties (point-min) (point-max)))
! nil t)))
(props
! `(display ,image
! intangible ,image
rear-nonsticky (display intangible)
;; This a cheap attempt to make the whole buffer
;; read-only when we're visiting the file (as
;; opposed to just inserting it).
read-only t front-sticky (read-only)))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p)))
(image-refresh image)
(add-text-properties (point-min) (point-max) props)
(set-buffer-modified-p modified)
! ;; Inhibit the cursor when the buffer contains only an image,
! ;; because cursors look very strange on top of images.
! (setq cursor-type nil)
;; This just makes the arrow displayed in the right fringe
;; area look correct when the image is wider than the window.
! (setq truncate-lines t)
(if (called-interactively-p)
(message "Repeat this command to go back to displaying the file as text")))))
--- 648,690 ----
(not (and (boundp 'tar-superior-buffer)
tar-superior-buffer)))
(create-image filename)
! (create-image raw nil t)))
! (imagedisp (if (display-images-p)
! image
! "[Image not displayable]"))
(props
! `(display ,imagedisp
! intangible ,imagedisp
rear-nonsticky (display intangible)
;; This a cheap attempt to make the whole buffer
;; read-only when we're visiting the file (as
;; opposed to just inserting it).
read-only t front-sticky (read-only)))
+ (textlst (imagetext-strings image raw))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p)))
+
(image-refresh image)
+ (setq image-mode-original-multibyte enable-multibyte-characters)
+ (set-buffer-multibyte t)
(add-text-properties (point-min) (point-max) props)
+ (goto-char (point-max))
+ (setq image-mode-text-marker (point-marker))
+ (insert "\n\n")
+ (mapc 'insert textlst)
+ (goto-char (point-min))
+
(set-buffer-modified-p modified)
!
! ;; Used to inhibit the cursor here because it looks strange on an image,
! ;; but now there's text we need it to navigate.
!
;; This just makes the arrow displayed in the right fringe
;; area look correct when the image is wider than the window.
! ;; But it's not good for text that goes past the window.
! ;; (setq truncate-lines t)
!
(if (called-interactively-p)
(message "Repeat this command to go back to displaying the file as text")))))
[-- Attachment #3: image-mode.el --]
[-- Type: application/emacs-lisp, Size: 30647 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: zlib.c --]
[-- Type: text/x-csrc, Size: 2232 bytes --]
#include <zlib.h>
/* z.msg can be NULL if there's no message, in particular for zero length
input inflate() returns Z_BUF_ERROR with z.msg==NULL */
Lisp_Object
make_z_stream_msg (z_stream *zp, int ret)
{
if (zp->msg != NULL)
return build_string (zp->msg);
else
return concat2 (build_string ("Zlib error code "),
Fnumber_to_string (make_number (ret)));
}
DEFUN ("zlib-inflate-string", Fzlib_inflate_string, Szlib_inflate_string, 1, 1, 0,
doc: /* Inflate Zlib or Gzip format compressed data.
STR is a unibyte string of compressed data in either Zlib (RFC 1950)
or Gzip (RFC 1952) format. The return is a unibyte string of the
decompressed result. An error is thrown for invalid contents. */)
(str)
Lisp_Object str;
{
z_stream z;
int ret;
char buf[4096];
Lisp_Object lst = Qnil;
CHECK_STRING (str);
z.zalloc = Z_NULL;
z.zfree = Z_NULL;
z.opaque = Z_NULL;
z.next_in = (Bytef *) SDATA (str);
z.avail_in = SBYTES (str);
z.next_out = (Bytef *) buf;
z.avail_out = sizeof (buf);
/* ask to accept either gzip or zlib header formats */
ret = inflateInit2 (&z, 32 + 15);
if (ret != Z_OK)
xsignal1 (Qerror, concat2 (build_string ("Zlib inflateInit2: "),
make_z_stream_msg (&z, ret)));
for (;;)
{
ret = inflate (&z, Z_NO_FLUSH);
if (ret != Z_OK && ret != Z_STREAM_END)
{
Lisp_Object msg = make_z_stream_msg (&z, ret);
inflateEnd (&z);
xsignal1 (Qerror, concat2 (build_string ("Zlib inflate: "), msg));
}
if (z.avail_out == 0 || ret == Z_STREAM_END)
{
lst = Fcons (make_unibyte_string (buf, sizeof (buf) - z.avail_out),
lst);
z.next_out = (Bytef *) buf;
z.avail_out = sizeof (buf);
}
if (ret == Z_STREAM_END)
break;
}
if (z.avail_in != 0)
{
ret = inflateEnd (&z);
error ("Garbage after compressed data");
}
ret = inflateEnd (&z);
if (ret != Z_OK)
xsignal1 (Qerror, concat2 (build_string ("Zlib inflateEnd: "),
make_z_stream_msg (&z, ret)));
return apply1 (intern ("concat"), Fnreverse (lst));
}
[-- Attachment #5: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: image-mode showing text title/description/etc
2007-05-23 22:40 image-mode showing text title/description/etc Kevin Ryde
@ 2007-05-24 8:28 ` Mathias Dahl
2007-05-26 0:51 ` Kevin Ryde
0 siblings, 1 reply; 4+ messages in thread
From: Mathias Dahl @ 2007-05-24 8:28 UTC (permalink / raw)
To: Kevin Ryde; +Cc: emacs-devel
> This is my idea to have image-mode display text from an image.
>
> The motivation is that showing an image title is clearly a good thing,
> and then showing author, long description, and copyright info are all
> pretty useful. But I'm not inclined to go into great detail about image
> characteristics, there's tools for doing that already, just stick to the
> text bits.
Just in case you did not know this, image-dired.el has "tagging"
capabilities (think of them as categories or keywords if you want),
and one could imagine your hack showing these tags as well as the
other information you are talking about. image-dired.el has a lot of
functions for handling these tags, writing them, listing them etc.
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: image-mode showing text title/description/etc
2007-05-24 8:28 ` Mathias Dahl
@ 2007-05-26 0:51 ` Kevin Ryde
2007-05-26 12:41 ` Mathias Dahl
0 siblings, 1 reply; 4+ messages in thread
From: Kevin Ryde @ 2007-05-26 0:51 UTC (permalink / raw)
To: Mathias Dahl; +Cc: emacs-devel
"Mathias Dahl" <mathias.dahl@gmail.com> writes:
>
> Just in case you did not know this, image-dired.el has "tagging"
> capabilities (think of them as categories or keywords if you want),
I saw the exiftool calls, but not the user annotations bit. Those
comments should be shown as the first thing after the image.
(Is there another per-file notes/annotations/whatever system somewhere,
or am I thinking of something else, mail message notes or something?)
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: image-mode showing text title/description/etc
2007-05-26 0:51 ` Kevin Ryde
@ 2007-05-26 12:41 ` Mathias Dahl
0 siblings, 0 replies; 4+ messages in thread
From: Mathias Dahl @ 2007-05-26 12:41 UTC (permalink / raw)
To: Kevin Ryde; +Cc: emacs-devel
> (Is there another per-file notes/annotations/whatever system somewhere,
> or am I thinking of something else, mail message notes or something?)
I know of a couple:
http://www.lisperati.com/tagging.html
and my own:
http://www.emacswiki.org/cgi-bin/wiki/FileProps
A while back, my long term plan for Tumme (now image-dired.el) was for
it to use file-props.el for the tagging stuff. We'll see what happens
later on with that...
/Mathias
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2007-05-26 12:41 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2007-05-23 22:40 image-mode showing text title/description/etc Kevin Ryde
2007-05-24 8:28 ` Mathias Dahl
2007-05-26 0:51 ` Kevin Ryde
2007-05-26 12:41 ` Mathias Dahl
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).