image-diredで，ディレクトリやアーカイブファイルの表紙を表示する †
準備 †
(require 'image-dired)
(call-process "mkdir" nil nil nil "-p" "/dev/shm/image-dired/temp")
(custom-set-variables '(image-dired-dir "/dev/shm/image-dired"))
(setq image-dired-archive-file-pattern "\\.\\(zip\\|ZIP\\)$")
image-dired-dired-toggle-marked-thumbs †
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
;; argがnon-nil の場合は，マークされたファイルのかわりに
;; 指定されたファイルを対象にします．
(interactive "P")
(dired-map-over-marks
;; それぞれのマークされた行について
;; body(第一引数)を評価して，結果のリストを返します．
(let* ((image-pos (dired-move-to-filename))
;; 画像を挿入する位置
(image-file (dired-get-filename nil t))
;; 画像ファイル名
thumb-file
;; サムネイルファイル(?)
overlay)
;; オーバーレイ(?)
(when (and image-file
(or (file-directory-p image-file)
(string-match-p image-dired-archive-file-pattern image-file)
(string-match-p (image-file-name-regexp) image-file)))
;; 画像ファイル名が non-nilで，かつ
;; ファイル名が image-file-name-regexp(\\.BMPとか)
;; に一致するとき
;; 式1
(setq thumb-file (image-dired-get-thumbnail-image image-file))
;; 式2
;; If image is not already added, then add it.
(let* ((cur-ovs (overlays-in (point) (1+ (point))))
(thumb-ov (car (cl-remove-if-not
(lambda (ov) (overlay-get ov 'thumb-file))
cur-ovs))))
(if thumb-ov
(delete-overlay thumb-ov)
(put-image thumb-file image-pos)
(setq overlay
(cl-loop for o in (overlays-in (point) (1+ (point)))
when (overlay-get o 'put-image) collect o into ov
finally return (car ov)))
(overlay-put overlay 'image-file image-file)
(overlay-put overlay 'thumb-file thumb-file)))))
arg ; Show or hide image on ARG next files.
'show-progress) ; Update dired display after each image is updated.
(add-hook 'dired-after-readin-hook
'image-dired-dired-after-readin-hook nil t))
image-dired-get-thumbnail-image †
(defun image-dired-get-thumbnail-image (file)
"Return the image descriptor for a thumbnail of image file FILE."
;; サムネイル画像のディスクリプタ(FILE)をかえす．
(message "image-dired-get-thumbnail-image")
(unless
(or (string-match (image-file-name-regexp) file)
(string-match image-dired-archive-file-pattern file)
(file-directory-p file))
(error "%s is not a valid image file" file))
;; 引数が image-file-name-regexp にマッチしないときは
;; エラーをかえす．
(let ((thumb-file (image-dired-thumb-name file)))
;; file に， ディレクトリのハッシュ値をつけた絶対パス(文字列)
(unless (and (file-exists-p thumb-file)
;; サムネイルファイルがナイこと，かつ
(<= (float-time (nth 5 (file-attributes file)))
(float-time (nth 5 (file-attributes thumb-file)))))
;; サムネイルファイルが，元のファイルより古い場合
;; アーカイブファイルの場合:
;; 1. file(zipファイル名)から，表紙画像をとりだして
;; (image-dired-dir)に展開する
;; 2. file を，1.でつくったファイル名で上書きする
(if (string-match image-dired-archive-file-pattern file)
(progn
(setq file
(shell-command-to-string
(concat "archiveImageThumb.rb " file)))
(message "archivefile's thumb: %s" file)))
;; file がディレクトリのときは，ディレクトリ内の表紙ファイルに
;; 置換する->対象ディレクトリ内のファイルを数字順にソート
;; TODO: 画像以外のファイルがある場合(Thumbs.dbとか)，コケる．
(if (file-directory-p file)
(progn
(setq file (concat file "/"
(shell-command-to-string
(concat "find " file " -type f | "
"sed 's!^.*/!!' | "
"sort -n | "
"head -1 | "
"tr -d '\\n' " ))))
(message file)))
(image-dired-create-thumb file thumb-file))
;; サムネイルを生成しておく
(message "creating image thumb...")
(create-image thumb-file)
;; (list 'image :type 'jpeg
;; :file thumb-file
;; :relief image-dired-thumb-relief :margin image-dired-thumb-margin)
))
