[mew-dist 27224] Re: 大きな写真

[Tetsuya Toda]

  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"))