[mew-dist 27224] Re: 大きな写真
Tetsuya Toda
toda at example.com
2006年 8月 19日 (土) 00:59:27 JST
jpeg, png, gif, tiff に対応しました.
また,resize するしない,高さをみるみないを変数で変更
出来るようにしました.(とりあえず変数は mew-gemas.el に
入れています)
戸田哲也 =^^=
-------------- next part --------------
Index: mew-gemacs.el
===================================================================
RCS file: /cvsmew/mew/mew-gemacs.el,v
retrieving revision 1.39
diff -c -r1.39 mew-gemacs.el
*** mew-gemacs.el 14 Aug 2006 12:48:28 -0000 1.39
--- mew-gemacs.el 18 Aug 2006 15:50:48 -0000
***************
*** 134,145 ****
;;; Image
;;;
(defun mew-image-inline-p (format)
;; display-graphic-p
(and window-system (image-type-available-p format)))
! (defun mew-jpeg-width ()
! (let (c size width)
(save-excursion
(catch 'loop
(while t
--- 134,175 ----
;;; Image
;;;
+ (defcustom mew-image-display-resize t
+ "*If non-nil, image will be displayed with fitting to frame size"
+ :type 'boolean)
+ (defcustom mew-image-display-resize-care-height t
+ "*If nil, image will be displayed with fitting to only frame width"
+ :type 'boolean)
+ (defcustom mew-image-width-margin 45
+ "*A value for width margin to display image when resizing"
+ :type 'integer)
+ (defcustom mew-image-height-margin 200
+ "A value for height margin to display image when resizing"
+ :type 'integer)
+ ;;
+ (defvar l-endian #x49)
+ (defvar b-endian #x4d)
+ ;;
+
(defun mew-image-inline-p (format)
;; display-graphic-p
(and window-system (image-type-available-p format)))
! (defun mew-img-get-n (op len)
! (let* ((n 0) (size 0))
! (if (eq op #x49) ; I(#x49) or M(#x4d)
! (while (< n len)
! (setq size (+ size (* (char-after) (expt #x100 n))))
! (forward-char)
! (setq n (+ n 1)))
! (while (< 0 len)
! (setq len (- len 1))
! (setq size (+ size (* (char-after) (expt #x100 len))))
! (forward-char)))
! size))
!
! (defun mew-jpeg-size ()
! (let (c size width height)
(save-excursion
(catch 'loop
(while t
***************
*** 150,192 ****
(setq c (char-after))
(forward-char)
(cond
! ((eq c #xd8)
)
- ((eq c #xe0)
- (forward-char 16))
- ((or (eq c #xdb) (eq c #xc4)
- (and (>= c #xe0) (<= c #xed)))
- (setq size (char-after))
- (forward-char)
- (setq size (+ (* size 256) (char-after)))
- (forward-char)
- (forward-char (- size 2)))
((eq c #xc0)
! (forward-char 5)
! (setq width (char-after))
! (forward-char)
! (setq width (+ (* width 256) (char-after)))
(throw 'loop nil))
(t
(throw 'loop nil))))))
! width))
! (defun mew-png-width ()
! (let (width)
(save-excursion
(forward-char 18)
;; length is four bytes
;; but we takes lower two bytes
! (setq width (char-after))
! (forward-char)
! (setq width (+ (* width 256) (char-after)))
! width)))
! (defvar mew-image-width-margin 45)
(defvar mew-image-alist
! '((jpeg "jpegtopnm" mew-jpeg-width)
! (png "pngtopnm" mew-png-width)))
(defun mew-image-format-ent (format)
(assoc format mew-image-alist))
--- 180,254 ----
(setq c (char-after))
(forward-char)
(cond
! ((or (eq c #xd8) ;SOI
! (eq c #xd9) ;EOI
! (and (>= c #xd0) (<= c #xd7))) ;RSTm
)
((eq c #xc0)
! (forward-char 3)
! (setq height (mew-img-get-n b-endian 2))
! (setq width (mew-img-get-n b-endian 2))
! (backward-char)
(throw 'loop nil))
+ ((and (>= c #xc1) (<= c #xfe))
+ (setq size (mew-img-get-n b-endian 2))
+ (forward-char (- size 2)))
(t
(throw 'loop nil))))))
! (cons width height)))
! (defun mew-png-size ()
! (let (width height)
(save-excursion
(forward-char 18)
;; length is four bytes
;; but we takes lower two bytes
! (setq width (mew-img-get-n b-endian 2))
! (forward-char 2)
! (setq height (mew-img-get-n b-endian 2))
! (cons width height))))
! (defun mew-gif-size ()
! (let (width height)
! (save-excursion
! (forward-char 6)
! (setq width (mew-img-get-n l-endian 2))
! (setq height (mew-img-get-n l-endian 2))
! (cons width height))))
!
! (defun mew-tiff-size ()
! (let (c endian size entry tag width height)
! (save-excursion
! (setq endian (char-after))
! (forward-char 4)
! (setq size (mew-img-get-n endian 4))
! (forward-char (- size 8)) ;jump to IFD
! ; IFD
! (setq entry (mew-img-get-n endian 2))
! (catch 'loop
! (while t
! (setq entry (- entry 1))
! (setq tag (mew-img-get-n endian 2))
! (cond
! ((eq tag #x100)
! (forward-char 6)
! (setq width (mew-img-get-n endian 2))
! (forward-char 2))
! ((eq tag #x101)
! (forward-char 6)
! (setq height (mew-img-get-n endian 2))
! (forward-char 2))
! (t
! (forward-char 10)))
! (unless (< 1 entry)
! (throw 'loop nil)))))
! (cons width height)))
(defvar mew-image-alist
! '((jpeg "jpegtopnm" mew-jpeg-size)
! (png "pngtopnm" mew-png-size)
! (gif "giftopnm" mew-gif-size)
! (tiff "tifftopnm" mew-tiff-size)))
(defun mew-image-format-ent (format)
(assoc format mew-image-alist))
***************
*** 201,225 ****
(message "Loading image...")
(set-buffer (mew-buffer-message))
(let* ((width (- (frame-pixel-width (selected-frame)) mew-image-width-margin))
(ent (mew-image-format-ent format))
(prog (mew-image-get-prog ent))
! (func (mew-image-get-func ent))
! image-width image)
! (when (and func (fboundp func))
(save-excursion
(set-buffer cache)
(goto-char begin)
! (setq image-width (funcall func))))
! (if (and image-width (< width image-width) (mew-which-exec prog))
(with-temp-buffer
(message "Resizing image...")
(insert-buffer-substring cache begin end)
(mew-set-buffer-multibyte nil)
(call-process-region (point-min) (point-max) prog
t '(t nil) nil)
! (call-process-region (point-min) (point-max) "pnmscale"
t '(t nil) nil
! "-xsize" (format "%d" width))
(setq format 'pbm)
(setq image (mew-buffer-substring (point-min) (point-max)))
(message "Resizing image...done"))
--- 263,298 ----
(message "Loading image...")
(set-buffer (mew-buffer-message))
(let* ((width (- (frame-pixel-width (selected-frame)) mew-image-width-margin))
+ (height (- (frame-pixel-height (selected-frame)) mew-image-height-margin))
(ent (mew-image-format-ent format))
(prog (mew-image-get-prog ent))
! (func-size (mew-image-get-func ent))
! image-width image-height image)
! (when (and mew-image-display-resize func-size (fboundp func-size))
(save-excursion
(set-buffer cache)
(goto-char begin)
! (setq image-width (car (funcall func-size)))
! (setq image-height (cdr (funcall func-size)))))
! (if (and image-width image-height
! (or (< width image-width)
! (and mew-image-display-resize-care-height (< height image-height)))
! (mew-which-exec prog))
(with-temp-buffer
(message "Resizing image...")
(insert-buffer-substring cache begin end)
(mew-set-buffer-multibyte nil)
(call-process-region (point-min) (point-max) prog
t '(t nil) nil)
! (if mew-image-display-resize-care-height
! (call-process-region (point-min) (point-max) "pnmscale"
! t '(t nil) nil
! "-xysize"
! (format "%d" width)
! (format "%d" height))
! (call-process-region (point-min) (point-max) "pnmscale"
t '(t nil) nil
! "-xsize" (format "%d" width)))
(setq format 'pbm)
(setq image (mew-buffer-substring (point-min) (point-max)))
(message "Resizing image...done"))
Mew-dist メーリングリストの案内