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

Tetsuya Toda toda at example.com
2006年 8月 16日 (水) 22:17:33 JST


From: Tetsuya Toda <toda at example.com>
Date: Wed, 16 Aug 2006 17:31:56 +0900 (JST)

>   今は x 方向しかサイズのチェックをしていないようですが,xy 両
> 方向でサイズがチェックされた方がよりうれしいと思います.

  quick hack してみました.

戸田哲也 =^^=
-------------- next part --------------
*** mew-gemacs.el.orig	Wed Aug 16 16:42:04 2006
--- mew-gemacs.el	Wed Aug 16 22:12:23 2006
***************
*** 171,176 ****
--- 171,209 ----
  	    (throw 'loop nil))))))
      width))
  
+ (defun mew-jpeg-height ()
+   (let (c size height)
+     (save-excursion
+       (catch 'loop
+ 	(while t
+ 	  (setq c (char-after))
+ 	  (forward-char)
+ 	  (unless (eq c #xff)
+ 	    (throw 'loop nil))
+ 	  (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 3)
+ 	    (setq height (char-after))
+ 	    (forward-char)
+ 	    (setq height (+ (* height 256) (char-after)))
+ 	    (throw 'loop nil))
+ 	   (t
+ 	    (throw 'loop nil))))))
+     height))
+ 
  (defun mew-png-width ()
    (let (width)
      (save-excursion
***************
*** 182,192 ****
        (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))
--- 215,237 ----
        (setq width (+ (* width 256) (char-after)))
        width)))
  
+ (defun mew-png-height ()
+   (let (height)
+     (save-excursion
+       (forward-char 14)
+       ;; length is four bytes
+       ;; but we takes lower two bytes
+       (setq height (char-after))
+       (forward-char)
+       (setq height (+ (* height 256) (char-after)))
+       height)))
+ 
  (defvar mew-image-width-margin 45)
+ (defvar mew-image-height-margin 200)
  
  (defvar mew-image-alist
!   '((jpeg "jpegtopnm" mew-jpeg-width mew-jpeg-height)
!     (png  "pngtopnm"  mew-png-width mew-png-height)))
  
  (defun mew-image-format-ent (format)
    (assoc format mew-image-alist))
***************
*** 197,216 ****
  (defun mew-image-get-func (ent)
    (nth 2 ent))
  
  (defun mew-mime-image (cache begin end format)
    (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)
--- 242,269 ----
  (defun mew-image-get-func (ent)
    (nth 2 ent))
  
+ (defun mew-image-get-func-height (ent)
+   (nth 3 ent))
+ 
  (defun mew-mime-image (cache begin end format)
    (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 (mew-image-get-func ent))
+ 	 (func-height (mew-image-get-func-height ent))
  	 image-width image)
!     (when (or (and func (fboundp func)) (and func-height (fboundp func-height)))
        (save-excursion
  	(set-buffer cache)
  	(goto-char begin)
+         (setq image-height (funcall func-height))
  	(setq image-width (funcall func))))
!     (if (and image-width image-height
! 	     (or (< width image-width) (< height image-height))
! 	     (mew-which-exec prog))
  	(with-temp-buffer
  	  (message "Resizing image...")
  	  (insert-buffer-substring cache begin end)
***************
*** 219,225 ****
  			       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"))
--- 272,280 ----
  			       t '(t nil) nil)
  	  (call-process-region (point-min) (point-max) "pnmscale"
  			       t '(t nil) nil
! 			       "-xysize"
! 				(format "%d" width)
! 				(format "%d" height))
  	  (setq format 'pbm)
  	  (setq image (mew-buffer-substring (point-min) (point-max)))
  	  (message "Resizing image...done"))


Mew-dist メーリングリストの案内