大きい画像を分割して表示

wanderlust(semi)でメールを見てるときに画面より大きい画像が添付されてると全部表示する事ができない。
それに対処する為に無理矢理画像を分割してスクロールできるようにしてみた。
line-spacing が 0 だと綺麗になるけど、そうじゃないときに少し隙間が空くのはしょうがないかな。

本当は mime-display-image を書き換えないで、別関数にしてユーザに選択させるのがいいんだけど、面倒だからやってない。
body-presentation-method を選択するコマンドを作って、選択した situation を mime-preview-situation-example-list に追加とかにすれば semi にパッチ当てなくても多分大丈夫な気はしてる。

(require 'mime-image)

(defvar mime-image-convert-program
  "c:/program files/ImageMagick-6.2.4-Q16/convert.exe"
  "ImageMagick の convert の場所。")
(defvar mime-image-split-height 240
  "分割する各画像の高さ")

(defun mime-image-split-and-create (file-or-data format data-p)
  "FILE-OR-DATA で指定される画像を分割した list で返す。
分割する高さは `mime-image-split-height' で指定する。"
  (let ((dir (make-temp-file "mime-image-split" t)))
    (unwind-protect
        (progn
          (as-binary-output-file
           (with-temp-file (expand-file-name "image" dir)
             (set-buffer-multibyte nil)
             (if data-p
                 (insert file-or-data)
               (insert-file-contents-as-binary file-or-data))))
          (call-process mime-image-convert-program nil t nil
                        (expand-file-name "image" dir)
                        "-crop" (format "0x%d" mime-image-split-height)
                        (expand-file-name "split_%02d" dir))
          (mapcar
           (lambda (file)
             (mime-image-create
              (with-temp-buffer
                (set-buffer-multibyte nil)
                (insert-file-contents-as-binary (expand-file-name file dir))
                (buffer-string))
              format 'data))
           (directory-files dir nil "^split")))
      (dolist (file (directory-files dir))
        (unless (or (string= file ".")
                    (string= file ".."))
          (delete-file (expand-file-name file dir))))
      (delete-directory dir))))

(defadvice mime-display-image (around split-image activate)
  "画像を分割して表示。
元の `mime-display-image' を完全に差し替え。"
  (setq
   ad-return-value
   (let ((entity (ad-get-arg 0))
         (situation (ad-get-arg 1)))
     (message "Decoding image...")
     (condition-case err
         (let ((format (cdr (assq 'image-format situation))))
           (save-excursion
             (dolist (image (mime-image-split-and-create
                             (mime-entity-content entity)
                             format 'data))
               (mime-image-insert image)
               (insert "\n")))
           (message "Decoding image...done"))
       (error nil err)))))