« ココログプロで Google サイトマップインデックスを作る | トップページ | Mew でパスワード入力時 C-g を押しても止まってくれない »

2006年3月 4日 (土)

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

2006-03-04 06:44:26 (JST) in Cygwin, Emacs/Meadow | | コメント (2) | トラックバック (0)

Cygwin」カテゴリ内の最近の記事

Emacs/Meadow」カテゴリ内の最近の記事

批評や挨拶のためのネットコミュニティ

  • はてなブックマーク(って何?) このエントリーをはてなブックマークに追加 このエントリーを含むはてなブックマーク このエントリーを含むはてなブックマーク
  • Twitter (って何?)

トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/93568/8933386

トラックバックのポリシー

他サイトなどからこの記事に自薦された関連記事(トラックバック)はまだありません。
» JRF のソフトウェア Tips:Navi2ch でインラインに画像を表示する (Referer もつける) (この記事)

コメント

よろしくです。

投稿: ゆか | 2010-02-04 18:28:57 (JST)

heart01 更新:navi2ch-1.8.3 では少なくとも使えなくなっていたので、詳しいところはチェックしてないが、とりあえず動くよう修正した。他の人のところでは動いていたのだろうか?

投稿: JRF | 2010-07-01 10:12:41 (JST)

コメントを書く



(メールアドレス形式)


※匿名投稿を許可しています。ゆるめのコメント管理のポリシーを持っています。この記事にまったく関係のないコメントはこのリンク先で受け付けています。
※暗号化パスワードを設定すれば、後に「削除」、すなわち JavaScript で非表示に設定できます。暗号解読者を気にしないならメールアドレスでもかまいません。この設定は平文のメールで管理者に届きます。
※コメントを書くために<b>ボールド</b>、<pre>詩文やソースコード</pre>、<a href="">リンク</a>、その他のHTMLタグが使えます。また、漢字[かんじ]でルビが、[google: キーワード] で検索指定が使えます。


ランダムことわざ: 鶴は千年、亀は萬年。