Navi2ch でインラインに画像を表示する (Referer もつける)

最近の Emacs は画像をインラインに表示できるが、Navi2ch そのものは掲示板の画像をインラインで見ることができない。しかし、《2chログ：Navi2ch for Emacs （Part 11）》の 888 の記事にインライン表示をする elisp とそれ用のシェルスクリプトが書いてあった。

それを Meadow と Cygwin の bash を使って走らせることにする。Cygwin の ImageMagickも使えるようにしておかねばならない。

まず、シェルスクリプトは次のようなものを navi2ch.makethumb という名前で作り実行ビットを立てておく。

#!/bin/sh #### 引数で与えられた画像をダウンロードし縮小したファイル名を返す #### #### $2 には referer が入る。 tmp=${TMPDIR:-/tmp}/navi2ch-thumbnails errimage=/cygdrive/c/WINDOWS/pchealth/helpctr/System/images/error.gif thumbsize="300x150" origfile="$tmp/${1#*tp://}" thumbfile="$origfile.jpg" # すでにテンポラリにあるイメージは再利用する。 if [ ! -f $origfile ]; then if [ -z "$2" ]; then /usr/bin/wget "$1" -q -N -x -P $tmp else /usr/bin/wget --referer="$2" "$1" -q -N -x -P $tmp fi fi if [ ! -f $origfile ]; then echo -n "$errimage" exit fi # アニメ Gif は scene 0 だけ取り出す。 scene=`identify -format "%n" "$origfile"` if [ ! -s $thumbfile -o $thumbfile -ot $origfile ]; then if [ $scene -gt 1 ]; then convert -scene 0 -sample $thumbsize "$origfile" "$origfile-%d.jpg" > /dev/null 2>&1 mv "$origfile-0.jpg" $thumbfile > /dev/null 2>&1 else convert -sample $thumbsize "$origfile" "$origfile.jpg" > /dev/null 2>&1 fi fi echo -n "$thumbfile"

次に .emacs や ~/.navi2ch/init.el とかに次を書き足す。

(eval-after-load "navi2ch" '(progn (defvar my-navi2ch-show-image-queue nil) (defvar my-navi2ch-check-host t "t なら同じホストの場合のみ連続読み込み時にイメージも読み込む。") (make-variable-buffer-local 'my-navi2ch-show-image-queue) (defun my-navi2ch-article-insert-image (proc file) "FILE で渡された画像をスレに挿入する．PROC が終了すると呼ばれる．" (let ((buf (buffer-name (process-buffer proc)))) (set-process-buffer proc nil) (unless (file-exists-p file) (setq my-navi2ch-show-image-queue nil) (message "画像の取得または作成に失敗しました。")) (when (and buf (file-exists-p file)) (with-current-buffer buf (save-excursion (let ((buffer-read-only nil) (orig (file-name-sans-extension file))) (goto-char (process-mark proc)) (forward-line) (insert-image (create-image file)) (add-text-properties (1- (point)) (point) (if (string< navi2ch-version "1.8.0") (list 'link t 'link-head t 'url orig 'help-echo orig) (list 'navi2ch-link-type 'url 'navi2ch-link orig 'help-echo orig))) (insert "\n") (when my-navi2ch-show-image-queue (let ((fun (car my-navi2ch-show-image-queue))) (setq my-navi2ch-show-image-queue (cdr my-navi2ch-show-image-queue)) (apply (car fun) (cdr fun)))))))))) (defun my-navi2ch-article-show-image () "非同期で画像を縮小しインラインに表示する．" (interactive) (let* ((point (point)) (board (cdr (assq 'uri navi2ch-article-current-board))) (url (if (string< navi2ch-version "1.8.0") (get-text-property point 'url) (get-text-property point 'navi2ch-link))) (ext (when url (file-name-extension url))) (proc (get-buffer-process (current-buffer))) (stat (and proc (process-status proc)))) (when (and stat (eq stat 'run)) (message "以前のプロセスがまだ動いています。")) (when (and ext (not (and stat (eq stat 'run))) (member (downcase ext) navi2ch-browse-url-image-extentions)) ;; Cygwin を使う場合はあったほうがいいのでは？ (setenv "BASH_ENV" "~/.bash_profile") (setq proc (start-process "navi2ch.thumb" (current-buffer) "c:\\cygwin\\bin\\bash.exe" "-c" (concat "navi2ch.makethumb " url " " board))) (set-process-filter proc 'my-navi2ch-article-insert-image) (set-marker (process-mark proc) point)))) (defun my-navi2ch-article-add-property-and-next-image (beg end force) (add-text-properties beg end '(my-navi2ch "shown")) (my-navi2ch-article-show-next-images force)) (defun my-navi2ch-article-show-next-images (&optional force) "カーソル以下のイメージを連続的に読み込む。" (interactive "P") (save-excursion (let* ((num (navi2ch-article-get-current-number)) (board (cdr (assq 'uri navi2ch-article-current-board)))) (if (re-search-forward (concat "h?ttp://\\([^ \t\n\r]+\\.\\(" (mapconcat (lambda (s) s) navi2ch-browse-url-image-extentions "\\|") "\\)\\)") nil t) (let ((url (concat "http://" (match-string 1))) (beg (match-beginning 0)) (end (match-end 0)) (func 'my-navi2ch-article-add-property-and-next-image) (prop (get-text-property (match-beginning 1) 'my-navi2ch))) (when (and (or force (not my-navi2ch-check-host) (string= (navi2ch-url-to-host url) (navi2ch-url-to-host board))) (not (string= prop "shown"))) (goto-char beg) (my-navi2ch-article-show-image) (setq my-navi2ch-show-image-queue (append my-navi2ch-show-image-queue (list (list func beg end force)))))))))) ;; スレを読みにいったときに自動的にイメージを挿入するようにして ;; おく。my-navi2ch-check-host を t にしておけば安心。 (add-hook 'navi2ch-article-mode-hook 'my-navi2ch-article-show-next-images) ;; "T" でその URL だけ強制的に表示。 (define-key navi2ch-article-mode-map "T" 'my-navi2ch-article-show-image) ;; 通常はそのホストのイメージは読み込んでるはずだから、"I" で連 ;; 続読みをするときは強制的に全部読む。 (define-key navi2ch-article-mode-map "I" (lambda () (interactive) (my-navi2ch-article-show-next-images t))) ))

ちなみに、どの掲示板見てるかバレそうだけど、次のようにするとダーティだけど HTTP ヘッダに付けるリファラが設定できたりする。

(eval-after-load "navi2ch" '(progn ;; 一部リファラがないとアクセスできない掲示板に対応。 (defadvice navi2ch-net-make-request-header (around navi2ch-net-make-request-header-with-referer (header-alist) activate) (let ((header ad-do-it) (board (or navi2ch-article-current-board navi2ch-board-current-board))) (unless (assoc "Referer" header-alist) (if board (setq header (concat header "Referer: " (cdr (assq 'uri board)) "\r\n")))) (setq ad-return-value header))) ;; document.write だけしかしない javascript なら対応できる。 (setq navi2ch-article-filter-list (cons (lambda () (goto-char (point-min)) (while (re-search-forward "document\\.write('\\([^']*\\)');" nil t) (replace-match "\\1"))) navi2ch-article-filter-list)) ;; <br /> に対応。 (setq navi2ch-replace-html-tag-alist (append navi2ch-replace-html-tag-alist '(("<br />" . "\n")))) (navi2ch-update-html-tag-regexp) ))

おっと、ただし、これらは cygwin-mount.el （説明ページ） が必須です。.emacs に次の行があるのをご確認を。動作の軽い cygwin-mount-mw32.el （説明ページ） というものもあります。

(require 'cygwin-mount) (cygwin-mount-activate)

■	追記 (2010-07-01)

どうも navi2ch のバージョンアップにより、get-text-property で得る値が変わっているらしい。行儀が悪いが、とりあえずの弥縫策[びほうさく]を反映した。また私が行っているサイトでは <br /> が使われているので、それに対応した。

更新：	06/03/04,2010-07-01
初公開：	2006年03月04日 06:44:27
最新版：	2010年07月01日 20:21:58