#contents * image-diredで,ディレクトリやアーカイブファイルの表紙を表示する [#c32a19a7] ** 準備 [#a6c01fe6] (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 [#w4ccbf4b] (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 [#t300d3e6] (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) ))