Wanderlust(SEMI)で写真を小さく表示する

最近、メールに添付される画像のサイズが大きくなってくる傾向がある。

現在のWanderlustなどのSEMIを使って大きな画像付きのメールを表示すると、画像が枠内からはみ出てしまってとても見づらい。スクロール出来ないだけでなく、正常にカーソールが動かない。今時こんなメールアプリを使っていては恥ずかしい。（他にもいろいろ使っていて恥ずかしいポイントはたくさんあるのだけども。。。）

原因はSEMIが画像を縮小してくれないこと。画像の縮小は最近よくやってるので、非同期で縮小してやろうと考えた。

調べてみると、mime-display-imageという関数で画像を入れていた。これをadviceどころではなくて上書きして非同期で表示するようにしてみた。例によって、 ImageMagick, concurrent.el, deferred.el が必要。

;; SEMI override

(eval-after-load "mime-image"
  '(progn
     (let ((rule '(image jpg jpeg)))
       (ctree-set-calist-strictly
        'mime-preview-condition
        (list (cons 'type (car rule))(cons 'subtype (nth 1 rule))
              '(body . visible)
              (cons 'body-presentation-method #'mime-display-image)
              (cons 'image-format (nth 2 rule)))))

     (require 'concurrent)

     (defvar mime-display-image-semaphore (cc:semaphore-create 1))
     (defvar mime-display-image-orgfile "/tmp/_mime_org.")
     (defvar mime-display-image-tmpfile "/tmp/_mime_image.jpg")
     (defvar mime-display-image-size '(600 . 400))
     
     (defun mime-display-image-winsize ()
       (let* ((win (selected-window))
              (ww (* (window-width win) (frame-char-width)))
              (wh (* (- (window-height win) 2) (frame-char-height))))
         (cons ww wh)))

     (defun mime-display-image-save-rawdata (d rawdata filename)
       (lexical-let ((rawdata rawdata) (filename filename))
         (deferred:nextc d
           (lambda (x) 
             (with-temp-buffer
               (let ((save-buffer-coding-system 'raw-text)
                     (buffer-file-coding-system 'raw-text)
                     (coding-system-for-read 'raw-text))
                 (insert rawdata)
                 (write-region nil nil filename)))))))

     (defun mime-display-image-convert (d filename dim)
       (lexical-let ((filename filename)
                     (dim mime-display-image-size))
         (deferred:$
           (deferred:nextc d
             (lambda (x) 
               (when (file-exists-p mime-display-image-tmpfile)
                 (delete-file mime-display-image-tmpfile))))
           (deferred:processc it "convert" "-resize" 
             (format "%sx%s" (car dim) (cdr dim))
             filename mime-display-image-tmpfile)
           (deferred:nextc it
             (lambda (x) 
               (unless (file-exists-p mime-display-image-tmpfile)
                 (error "Could not convert image : %s" filename)))))))

     (defun mime-display-image-load (filename)
       (let ((buf (find-file-noselect filename t t)))
         (prog1 (with-current-buffer buf (buffer-string))
           (kill-buffer buf))))

     (defun mime-display-image-show (d img-buf img-pos)
       (lexical-let ((img-buf img-buf) (img-pos img-pos))
         (deferred:nextc d
           (lambda (x) 
             (clear-image-cache)
             (let* ((raw (mime-display-image-load mime-display-image-tmpfile))
                    (image (mime-image-create raw 'jpeg 'data)))
               (with-current-buffer img-buf
                 (let ((flg buffer-read-only))
                   (setq buffer-read-only nil)
                   (put-text-property img-pos (1+ img-pos) 'display image)
                   (setq buffer-read-only flg)))
               (message "IMAGE : [%s]" (cons img-buf img-pos)))))))

     (defun mime-display-image-clean (d filename)
       (lexical-let ((filename filename))
         (deferred:nextc d
           (lambda (x) 
             (when (file-exists-p mime-display-image-tmpfile)
               (delete-file mime-display-image-tmpfile))
             (when (file-exists-p filename)
               (delete-file filename))))))
         
     (defun mime-display-image (entity situation)
       (message "Decoding image...")
       (lexical-let* ((format (cdr (assq 'image-format situation))) 
                      (rawdata (mime-entity-content entity))
                      (org-filename (or (cdr (assq 'filename situation))
                                        (cdr (assoc "name" situation))))
                      (filename (concat 
                                 mime-display-image-orgfile
                                 (file-name-extension org-filename)))
                      (img-buf (current-buffer))
                      (img-pos (point))
                      (dim (mime-display-image-winsize)))
         (insert (substring-no-properties " \n"))
         (deferred:$
           (cc:semaphore-acquire mime-display-image-semaphore)
           (mime-display-image-save-rawdata it rawdata filename)
           (mime-display-image-convert it filename dim)
           (mime-display-image-show it img-buf img-pos)
           (mime-display-image-clean it filename)
           (deferred:error it
             (lambda (err) (message "Image Error : %s" err)))
           (deferred:nextc it
             (lambda (x)
               (cc:semaphore-release mime-display-image-semaphore)
               (message "Image Done : %s" org-filename))))))

     ;; (cc:semaphore-release-all mime-display-image-semaphore)

     ))

もともと同期的なコードなので、非同期にする際に画像データの保存や画像を入れるべき場所をどうするかで迷った。結局、クロージャで保持することにした。

画像サイズはウインドウサイズから調整しようと考えたのだけども、固定の方が見やすいことに気がついたので固定で入れている。

あとは、挿入先のバッファが無くなったことのことなどをもうちょっと考える必要があるかも。

SEMIのコードは歴代のEmacsの歴史や、昔の人の苦労がたくさん詰まっていて、なかなか興味深い。このあたりのコードは最近のEmacsのバージョンを仮定すると1/4ぐらいになるのではないかと思った。

今、Wanderlust、SEMI、FLIMのコードを少しずつ読んでいる。いつか各動作を非同期化したり、gmailのように検索による自動分類で整理できるような改造を行いたいなと思っている。