image-diredの改善

(2023-08-08追記: Emacs 29.1に合わせてコードを修正しました)

皆さんはimage-dired使ってますか？　私は使っていませんでした。だって大量の画像を扱える専門のソフトがあるのにわざわざEmacsでやる必要なんて無いじゃないですか。Diredから外部ビューアを起動して後はそっちでやっていたのです。

しかし有名なビューアをいくつか使ってきましたが常にどこか不満を感じていました。似たようなソフトが沢山乱立している状況を見るに、それだけ皆を満足させるのは難しいということなのかもしれません。

やりたいことは、大量の画像(数千枚で似たような画像も沢山ある)の中から良さそうなものを選び出し、タグ付けしたりコメントを書いたりして整理する作業です。その後にその情報を使用してレポートを作ったりするわけです。単に画像が見られれば良いのではありません。もちろんそのような機能を持つビューアはあります。しかし自分に合ったキー操作で効率的にできるものはなかなか見つかりません。ほんの些細な機能が無くて不満を抱くケースも多いです。

自分で作れば良いのかもしれませんが(単に見るだけの特定の用途のためのものなら以前作りました)、編集機能を有するものを0から作るのもなかなか大変です。

色々な方法があるとは思いますが、今の私が一番気軽に扱えるのは結局Emacsなのでimage-diredを改良して少しは使いやすくなればと思い色々いじってみました。

Windowsでの設定
(dired内)サムネイルの幅を揃えて、右に空白を入れ、境界線を引く
(dired内)サムネイルを一括で表示/非表示する
(dired内)dired-details-rのレイアウトが乱れるのを直す
(dired内)ファイルの削除や移動でサムネイルが消えずに残るのを直す
(dired内)C-t iで開いたウィンドウを簡単に閉じる
(dired内)全画像ファイルをサムネイルバッファで表示する
(サムネイルバッファ内)Uでマークを全解除する
外部ツールで表示するときにw32-shell-executeを使う
(dired内)ファイルに対応するサムネイルバッファ内の位置へジャンプする
コードまとめ

Windowsでの設定

image-diredを使うにはImageMagickが必要です。WindowsではCygwinなりMSYS2なり公式ビルドなりwingetなり好きな方法でインストールすることが可能でしょう。私はデスクトップPCではCygwin、ノートではMSYS2のものを使っています。

ここで良くあるトラブルが間違ったconvertコマンドを参照してしまうということです。Windowsには c:/Windows/System32/convert.exe というコマンドがあるのでPATHの設定次第ではそちらが優先されてしまいます。

絶対パスで指定し直しても良いのですが、私は次のようにしてconvertコマンドの代わりにmagickコマンドを使うようにしてみました。

(when (eq system-type 'windows-nt)
  (with-eval-after-load "image-dired"
    (setq image-dired-cmd-create-thumbnail-program "magick"
          image-dired-cmd-create-temp-image-program "magick")
    (unless (equal (car image-dired-cmd-create-thumbnail-options) "convert")
      (push "convert" image-dired-cmd-create-thumbnail-options))
    (unless (equal (car image-dired-cmd-create-temp-image-options) "convert")
      (push "convert" image-dired-cmd-create-temp-image-options))))

magick convert と magick はImageMagickのv6構文とv7構文の違いらしくそこまで大きく変わらないらしいので単に～-programを magick にするだけでも大丈夫なのかもしれませんが、念のため～-optionsの頭に convert を追加しています。

それにしてもWindowsにせよImageMagickにせよconvertというコマンド名はなかなか酷いですね。コマンドラインなんてだいたいの処理は何かしら変換するものでしょうに。ちなみにWindowsのconvertコマンドはFATボリュームをNTFSにするんだそうです。私は一回も使ったことがありません。

(dired内)サムネイルの幅を揃えて、右に空白を入れ、境界線を引く

image-diredはdiredバッファの中に直接サムネイルを表示できます。画像ファイルの上で(または複数マークしてから)C-t C-tと押すとファイル名の直前にサムネイル画像が表示されます。

仕組みとしては、まずサムネイル画像を参照するオーバーレイをDiredバッファに挿入してから(黒い正方形の四角が表示される)、非同期でサムネイルを作成するプロセスを起動し、完了したらEmacsの画像キャッシュをフラッシュすることで正しいサムネイルが表示されるという流れになっています。サムネイルはデフォルトでは ~/.emacs.d/image-dired/ 以下に作られるようです。最初から既にサムネイルがある場合はすぐに表示されます。

やってみると分かるのですが、確かにサムネイルは表示されるのですがサムネイル画像の幅が揃っていません。また、その後に続くファイル名との間に空白が無く完全にくっついてしまっています。そして境界線が無いので、Emacs内の背景色と同じ色(私の場合黒)が主体の画像だと画像の輪郭が把握できません。

次のコードはそれを解決するものです。

(defun my-image-dired-dired-toggle-marked-thumbs (&optional arg)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  "Toggle thumbnails in front of file names in the Dired buffer.
If no marked file could be found, insert or hide thumbnails on the
current line.  ARG, if non-nil, specifies the files to use instead
of the marked files.  If ARG is an integer, use the next ARG (or
previous -ARG, if ARG<0) files."
  (interactive "P")
  (dired-map-over-marks
   (my-image-dired-dired-set-thumb-visibility 'toggle) ;;ファイル毎の処理を分離
   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))

(defun my-image-dired-dired-set-thumb-visibility (visibility)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((image-pos  (dired-move-to-filename))
        (image-file (dired-get-filename nil t)))
    (when (and image-file
               (string-match-p (image-file-name-regexp) image-file))
      (let* ((thumb-file
              ;; Emacs 28まで
              ;;(image-dired-get-thumbnail-image image-file)
              ;; Emacs 29から
              (create-image
               (image-dired--get-create-thumbnail-file image-file)))
             (thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
                                if (overlay-get ov 'thumb-file) return ov)))
        ;; 後述の改良のためにトグル以外もできるようにした
        (if thumb-ov
            (when (memq visibility '(nil toggle))
              (delete-overlay thumb-ov))
          (when (memq visibility '(t toggle))
            (my-image-dired-dired-create-thumbnail-overlay
             image-pos image-file thumb-file)))))))

(defun my-image-dired-dired-create-thumbnail-overlay (image-pos image-file thumb-file)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((overlay (put-image
                  ;; 枠線を付加
                  (append thumb-file (list :relief 1))
                  image-pos)))
    (overlay-put overlay 'image-file image-file)
    (overlay-put overlay 'thumb-file thumb-file)
    ;; 幅を揃える
    (my-image-dired-dired-update-thumbnail-overlay overlay thumb-file)
    overlay))

(defun my-image-dired-dired-update-thumbnail-overlay (ov image)
  (when-let ((image-file (plist-get (cdr image) :file)))
    (let* ((image-exists-p (file-exists-p image-file))
           (image-size (image-size image t)) ;;float?
           (space-w
            (if image-exists-p
                ;; Emacs 28まで
                ;;(- image-dired-thumb-width (car image-size))
                ;; Emacs 29から
                (- image-dired-thumb-size (car image-size))
              0))
           (space-left (ceiling (/ space-w 2)))
           (space-right (+ 10 ;;space after thumbnail
                           (- space-w space-left))))
      (overlay-put ov 'before-string
                   ;; 元々のbefore-stringの前後にマージン(スペース)を入れる
                   (concat
                    (propertize "_" 'display `(space :width (,space-left)))
                    (overlay-get ov 'before-string)
                    (propertize "_" 'display `(space :width (,space-right))))))))

(with-eval-after-load "dired"
  (define-key dired-mode-map [remap image-dired-dired-toggle-marked-thumbs] 'my-image-dired-dired-toggle-marked-thumbs))

元の image-dired-dired-toggle-marked-thumbs は、サムネイル画像の取得からオーバーレイの作成、削除までをすべてこの中だけで行ってしまいます。オーバーレイ作成部分だけを書き替えるのは難しいため、大人しく関数全体を独自のものに差し替えて解決することにしました。

(dired内)サムネイルを一括で表示/非表示する

C-t C-tは現在のポイントにあるファイルか、またはマークしたファイルをサムネイル表示します。全ての画像を一括で表示するにはいちいち全マークしなければなりません。それにこれはtoggle動作です。一部をすでにサムネイル表示した後に全画像をマークしてC-t C-tすると今表示されているものは消えてしまいます。単純に全画像ファイルのサムネイルを一括で表示したり消したりしたいです。

次のコードはそれを実現するための三つ(全表示、全消去、トグル)のコマンドを定義します。

(defun my-image-dired-dired-toggle-all-thumbs ()
  (interactive)
  (if (cl-loop for ov in (overlays-in (point-min) (point-max))
               when (overlay-get ov 'thumb-file) return t)
      (my-image-dired-dired-hide-all-thumbs)
    (my-image-dired-dired-show-all-thumbs)))

(defun my-image-dired-dired-hide-all-thumbs ()
  (interactive)
  (cl-loop for ov in (overlays-in (point-min) (point-max))
           when (overlay-get ov 'thumb-file)
           do (delete-overlay ov)))

(defun my-image-dired-dired-show-all-thumbs (&optional hide)
  (interactive "P")
  (if hide
      (my-image-dired-dired-hide-all-thumbs)
    (add-hook 'dired-after-readin-hook
              'image-dired-dired-after-readin-hook nil t)
    (if (my-image-dired-confirm-generate-thumbs (my-image-dired-dired-all-image-files))
        (save-excursion
          (goto-char (point-min))
          (while (< (point) (point-max))
            (my-image-dired-dired-set-thumb-visibility t)
            (forward-line 1)))
      (message "Canceled."))))

(defun my-image-dired-dired-all-image-files ()
  (when (derived-mode-p 'dired-mode)
    (save-excursion
      (goto-char (point-min))
      (let ((image-regexp (image-file-name-regexp))
            files)
        (while (< (point) (point-max))
          (let ((file (dired-get-filename nil t)))
            (when (and file
                       (string-match-p image-regexp file))
              (push file files)))
          (forward-line 1))
        (nreverse files)))))

(defun my-image-dired-confirm-generate-thumbs (files)
  (let* ((no-thumb-files (seq-filter (lambda (file)
                                       (not (file-exists-p
                                             (image-dired-thumb-name file))))
                                     files))
         (num-no-thumb-files (length no-thumb-files)))
    (or (<= num-no-thumb-files image-dired-show-all-from-dir-max-files)
        (y-or-n-p
         (format
          "Generate %s new thumbnails. Proceed? "
          num-no-thumb-files)))))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t C-a") 'my-image-dired-dired-toggle-all-thumbs))

実際には全表示用の一つのコマンドだけ C-t C-a に割り当てました。C-u プレフィックスを付けると全消去になります。

また、沢山のサムネイル生成が必要なときは警告を出して確認するようにしました。全ての画像が既にサムネイル化されている場合は何も聞かずに処理します。

(dired内)dired-details-rのレイアウトが乱れるのを直す

私はファイルの詳細情報(サイズやタイムスタンプ)をファイル名の右側に表示して使用していますが、サムネイルを表示させるとその分だけ詳細情報も含めた行全体が右にずれてしまいます。

これについては先日「dired-details-r.elの更新」として書きました。

(dired内)ファイルの削除や移動でサムネイルが消えずに残るのを直す

見た目的にはかなり露骨なバグです。こういうのが当たり前のように転がっているのがEmacsの世界です。

ただこれはdiredバッファに何かを追加するEmacs Lispで良くあることです。私がdired-details-rを作っている時にも経験しましたしall-the-icons-diredでもありました。

diredはファイルの削除や移動を外部から捕捉できるようにするフックを提供していないのでちゃんと実装するのが難しいのです。私が思いつく対処方法としては次の二つがあります。

行が消えるときに自動的に追加したものも一緒に消えるようにしておく(overlayのevaporateプロパティを使う等)
dired-remove-entry等の削除に関わる関数にadviceを追加する

最初はサムネイルのオーバーレイに1文字分の範囲を覆わせてevaporateプロパティをtにすることで自動的に消えるようにしようと思いました(今の実装はファイル名直前の空の範囲を覆わせてbefore-stringでサムネイルを表示しているので、そのままevaporateをtにすると即時消えてしまう)。しかしよく調べてみると、image-diredはバッファ全体の更新時(dired-after-readin-hookのタイミング)にバッファ内に存在するオーバーレイを正しい位置に再配置していました。つまり、消してから作り直すのでは無く、使い回す設計になっていました。どちらが速いのかは計測してみなければ分かりませんが今より遅くなっては困るのでその設計は尊重して、adviceを使ってdiredで削除したり移動したりするときだけ明示的にオーバーレイを削除するようにしてみました。

(defun my-image-dired-dired-remove-entry-around (orig-fun file &rest args)
  (save-excursion
    (when (dired-goto-file file)
      (cl-loop for ov in (overlays-in (line-beginning-position)
                                      (line-end-position))
               when (and (overlay-get ov 'put-image)
                         (overlay-get ov 'thumb-file))
               do (delete-overlay ov))))
  (apply orig-fun file args))

(advice-add #'dired-remove-entry :around
            #'my-image-dired-dired-remove-entry-around)

(dired内)C-t iで開いたウィンドウを簡単に閉じる

image-diredには C-t i で現在のポイントにある画像ファイルを別ウィンドウで表示してくれる機能があります。この機能の特筆すべき点は、ちゃんと適切なサイズに縮小した一時ファイルを作ってからEmacsで開いてくれるというところです。解像度の高い巨大な画像でも安心して開けるわけです。

それは良いのですが、開いたウィンドウを簡単に閉じることができません。もちろん C-x o q (バッファも削除したいならC-x o C-u q) で閉じられますが、もう一歩、別ウィンドウに移動しなくても閉じられるようにしたいところです。チラ見してすぐに閉じるような手軽さが欲しいわけです。

ひとまず次のようにしてDiredから C-t q で閉じるようにしてみました。

(defun my-image-dired-quit-display-window (&optional kill)
  (interactive "P")
  (when-let ((window (image-dired-display-window)))
    (quit-window kill window)))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t q") 'my-image-dired-quit-display-window))

さらにもう一歩進めるなら、 q でimage-diredのウィンドウを先にquitして、無ければdiredをquitするというのはどうでしょう。

(defun my-image-dired-dired-quit-window (&optional kill)
  (interactive "P")
  (if-let ((window (or (image-dired-display-window)
                       (image-dired-thumbnail-window))))
      (quit-window kill window)
    (quit-window kill)))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "q") 'my-image-dired-dired-quit-window))

(dired内)全画像ファイルをサムネイルバッファで表示する

image-diredにはサムネイルだけを専用のバッファで一覧表示する機能があります。あるというよりも、おそらくこちらが本来の使い方なのだと思います。

この方法は良くあるビューアに慣れていると最初はギョッとしますが、Diredの中に表示をさせたものと比較すると無駄な余白が少なく一度に多くのサムネイルとファイル情報を表示できるのが利点です(まぁ、実際の理由はDiredバッファ内にサムネイルを表示するのは今回対策しているように色々問題が多いからなのかもしれません)。

画像をサムネイル専用バッファで表示するには、C-t d、C-t .、C-t aあたりを使います。C-t dは現在またはマークした画像だけを表示し(ウィンドウ移動も含む)、C-t .は現在の画像だけを表示し(選択ウィンドウはそのまま)、C-t aは現在またはマークした画像を追加します(選択ウィンドウはそのまま)。これはこれで有用なケースはあると思いますが、とりあえず欲しいのは開いているディレクトリの全画像を一括でサムネイル専用バッファに表示するコマンドではないでしょうか。一応そのようなコマンドはあります。

特定のディレクトリ下にある画像を一括でサムネイル表示するには M-x image-dired とします。ディレクトリを尋ねられるのでそのままカレントディレクトリを指定すればOKです。50個以上の画像があると警告が表示されます。

しかしこれには次のような不満もあります。

Diredにキー割り当てがない
いちいちディレクトリを尋ねられる
Dired側で全ての画像ファイルがマークされる(マーク状態が変わってしまう)

その辺りを次のコードで解決しました。

(defun my-image-dired-dired-show-all-images ()
  ;; Derived from `image-dired-show-all-from-dir'
  (interactive)
  (unless (derived-mode-p 'dired-mode)
    (error "Not dired buffer"))
  (let* ((image-regexp (image-file-name-regexp))
         ;; カレントディレクトリにある全画像ファイルを求める
         (files (seq-filter (lambda (file) (string-match-p image-regexp file))
                            (directory-files "." t))))
    (if (my-image-dired-confirm-generate-thumbs files) ;;生成数が多いときは確認する
        ;; Emacs 28まで
        ;; (progn
        ;;   (my-image-dired-display-thumbs files (current-buffer))
        ;;   (image-dired-thumb-update-marks) ;;マークを同期する
        ;;   (pop-to-buffer image-dired-thumbnail-buffer))
        ;; Emacs 29から
        (progn
          (my-image-dired-display-thumbs files (current-buffer))
          (image-dired--thumb-update-marks) ;;マークを同期する
          (pop-to-buffer image-dired-thumbnail-buffer)
          (image-dired--update-header-line))
      (message "Canceled."))))

(defun my-image-dired-display-thumbs (files dired-buf
                                            &optional append do-not-pop)
  ;; Derived from `image-dired-display-thumbs'
  (setq image-dired--generate-thumbs-start  (current-time))
  (let ((buf (image-dired-create-thumbnail-buffer)))
    (with-current-buffer buf
      ;; Emacs 28まで
      ;; (let ((inhibit-read-only t))
      ;;   (if append (goto-char (point-max)) (erase-buffer))
      ;;   (dolist (curr-file files)
      ;;     (let ((thumb-name (image-dired-thumb-name curr-file)))
      ;;       (unless (file-exists-p thumb-name)
      ;;         (image-dired-create-thumb curr-file thumb-name))
      ;;       (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
      ;;   (if do-not-pop
      ;;       (display-buffer buf)
      ;;     (pop-to-buffer buf))
      ;;   (image-dired--line-up-with-method))
      ;; Emacs 29から
      (let ((inhibit-read-only t))
        (if (not append)
            (progn
              (setq image-dired--number-of-thumbnails 0)
              (erase-buffer))
          (goto-char (point-max)))
        (dolist (file files)
          (when (string-match-p (image-dired--file-name-regexp) file)
            (image-dired-insert-thumbnail
             (image-dired--get-create-thumbnail-file file) file dired-buf
             (cl-incf image-dired--number-of-thumbnails))))))))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t C-d") 'my-image-dired-dired-show-all-images))

my-image-dired-dired-show-all-images は image-dired-show-all-from-dir (image-diredコマンドはこれの別名) が元になっていますが、次の点が異なります。

diredから呼ばれることが前提
diredで開いているディレクトリが対象 (いちいち聞きません)
diredのマーク状態を一切変更せずに直接サムネイルバッファに追加する
diredでマークしている画像は始めからサムネイルバッファでもマークする
サムネイル化されていない画像が多い場合は警告する (画像の数では無く、新たに生成しなければならないサムネイルの数で判断します)

(サムネイルバッファ内)Uでマークを全解除する

(2023-08-08追記: Emacs 29.1からは標準で同等のコマンドがUに割り当てられているため不要です)

M-x image-diredを実行してみるとすぐに気がつくのがUで全てのマークを解除できないことではないでしょうか。M-x image-diredを実行するとdiredバッファ上で全ての画像ファイルがマークされてしまいます。慌ててUを押して全てのマークを解除しようとしても、サムネイルバッファの方に移動してしまっているので効きません。

サムネイルバッファ内ではmやuでマークしたり解除したりできますが、Uで全解除はできません。

次のコードはそれを出来るようにします。

;; Emacs 29.1からは不要。標準で image-dired-unmark-all-marks がある。
(defun my-image-dired-unmark-all ()
  (interactive)
  (when-let ((dired-buf (image-dired-associated-dired-buffer)))
    (with-current-buffer dired-buf
      (dired-unmark-all-marks))) ;;TODO: サムネイルバッファ内にあるファイルだけに限定すべき？
  ;; きちんとサムネイルバッファ内のマークも更新するのがポイント。
  (image-dired-thumb-update-marks))

(with-eval-after-load "image-dired"
  (define-key image-dired-thumbnail-mode-map "U" 'my-image-dired-unmark-all))

他にもdiredがサポートしている様々なマーク操作をサムネイルバッファ上でも行えるようになっていた方が良いかもしれません。特にマークのトグルは欲しいのですが(U tと押せば全マークできるので)、tキーがタグのために使われているので保留。

また、本来はサムネイルバッファ内にあるファイルだけマーク解除すべきかもしれません。その辺りはマークがちゃんと同期されていないという問題と一緒に考えた方がいいかもしれません。

外部ツールで表示するときにw32-shell-executeを使う

特定のツールを直接指定するのも良いのですが、Windowsなので関連付けされているアプリを呼び出すのが普通でしょう。そのためにはw32-shell-execute関数を使用します。

diredにはすでにそのような機能を自分で追加してあるのでimage-diredで対応する必要はあまりないのですが、一応対策しておきます。

(defun my-image-dired-thumbnail-display-external-w32 ()
  ;; Derived from `image-dired-thumbnail-display-external'
  (interactive)
  (let ((file (image-dired-original-file-name)))
    (if (not (image-dired-image-at-point-p))
        (message "No thumbnail at point")
      (if (not file)
          (message "No original file name found")
        ;; ここを変更
        (w32-shell-execute "open" file)))))

(defun my-image-dired-dired-display-external-w32 ()
  ;; Derived from `image-dired-dired-display-external'
  (interactive)
  (let ((file (dired-get-filename)))
    ;; ここを変更
    (w32-shell-execute "open" file)))

(with-eval-after-load "dired"
  (define-key dired-mode-map [remap image-dired-dired-display-external] 'my-image-dired-dired-display-external-w32))

(with-eval-after-load "image-dired"
  (define-key image-dired-thumbnail-mode-map [remap image-dired-thumbnail-display-external] 'my-image-dired-thumbnail-display-external-w32))

何か別のソフト、ビューアではなく編集ソフト等を指定するのもありかもしれません。ビューアが立ち上がればそこから編集ソフトも起動できるようにはしてあるのであまり必要性はありません。

(dired内)ファイルに対応するサムネイルバッファ内の位置へジャンプする

C-t jでサムネイルバッファへジャンプしますが、対応するファイルへはジャンプしません。サムネイルバッファからDiredバッファの対応するファイルへはTABでジャンプできるので、この逆バージョンが欲しい所です。C-t TABに割り当ててみました。

(defun my-image-dired-dired-jump-thumbnail-buffer ()
  (interactive)
  (let ((file (dired-get-filename)))
    ;; Display thumbnail buffer
    (if (image-dired-thumbnail-window)
        (image-dired-jump-thumbnail-buffer)
      (if (buffer-live-p (get-buffer image-dired-thumbnail-buffer))
          (pop-to-buffer image-dired-thumbnail-buffer)
        (message "No thumbnail buffer")))
    ;; Jump
    (my-image-dired-goto-file file)))

(defun my-image-dired-goto-file (file)
  (let ((pos (save-excursion
               (goto-char (point-min))
               (when-let ((match (text-property-search-forward 'original-file-name file t)))
                 (prop-match-beginning match)))))
    (when pos
      (goto-char pos))))

(with-eval-after-load "dired"
  (define-key dired-mode-map (kbd "C-t TAB") 'my-image-dired-dired-jump-thumbnail-buffer))

コードまとめ

沢山修正したのでひとまずこのあたりでまとめます。

(require 'cl-lib)
(require 'text-property-search)
(require 'image-dired)

;;;; image-dired-dired-toggle-marked-thumbsを分解する

(defun my-image-dired-dired-toggle-marked-thumbs (&optional arg)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  "Toggle thumbnails in front of file names in the Dired buffer.
If no marked file could be found, insert or hide thumbnails on the
current line.  ARG, if non-nil, specifies the files to use instead
of the marked files.  If ARG is an integer, use the next ARG (or
previous -ARG, if ARG<0) files."
  (interactive "P")
  (dired-map-over-marks
   (my-image-dired-dired-set-thumb-visibility 'toggle)
   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))

(defun my-image-dired-dired-set-thumb-visibility (visibility)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((image-pos  (dired-move-to-filename))
        (image-file (dired-get-filename nil t)))
    (when (and image-file
               (string-match-p (image-file-name-regexp) image-file))
      (let* ((thumb-file
              (thumb-file
               ;; Emacs 28まで
               ;;(image-dired-get-thumbnail-image image-file)
               ;; Emacs 29から
               (create-image
                (image-dired--get-create-thumbnail-file image-file))))
             (thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
                                if (overlay-get ov 'thumb-file) return ov)))
        (if thumb-ov
            (when (memq visibility '(nil toggle))
              (delete-overlay thumb-ov))
          (when (memq visibility '(t toggle))
            (my-image-dired-dired-create-thumbnail-overlay
             image-pos image-file thumb-file)))))))

;;;; Diredバッファ内でのサムネイルの表示を改善

(defun my-image-dired-dired-create-thumbnail-overlay (image-pos image-file thumb-file)
  ;; Derived from `image-dired-dired-toggle-marked-thumbs'
  (let ((overlay (put-image
                  ;; 枠線で囲む
                  (append thumb-file (list :relief 1))
                  image-pos)))
    (overlay-put overlay 'image-file image-file)
    (overlay-put overlay 'thumb-file thumb-file)
    (my-image-dired-dired-update-thumbnail-overlay overlay thumb-file)
    overlay))

(defun my-image-dired-dired-update-thumbnail-overlay (ov image)
  (when-let ((image-file (plist-get (cdr image) :file)))
    (let* ((image-exists-p (file-exists-p image-file))
           (image-size (image-size image t)) ;;float?
           (space-w
            (if image-exists-p
                ;; Emacs 28まで
                ;;(- image-dired-thumb-width (car image-size))
                ;; Emacs 29から
                (- image-dired-thumb-size (car image-size))
              0))
           (space-left (ceiling (/ space-w 2)))
           (space-right (+ 10 ;; サムネイルの後に空白を入れる
                           (- space-w space-left))))
      ;; 幅を揃える
      (overlay-put ov 'before-string
                   (concat
                    (propertize "_" 'display `(space :width (,space-left)))
                    (overlay-get ov 'before-string)
                    (propertize "_" 'display `(space :width (,space-right))))))))

;;;; Diredバッファ内にサムネイルを一括表示する

(defun my-image-dired-dired-toggle-all-thumbs ()
  (interactive)
  (if (cl-loop for ov in (overlays-in (point-min) (point-max))
               when (overlay-get ov 'thumb-file) return t)
      (my-image-dired-dired-hide-all-thumbs)
    (my-image-dired-dired-show-all-thumbs)))

(defun my-image-dired-dired-hide-all-thumbs ()
  (interactive)
  (cl-loop for ov in (overlays-in (point-min) (point-max))
           when (overlay-get ov 'thumb-file)
           do (delete-overlay ov)))

(defun my-image-dired-dired-show-all-thumbs (&optional hide)
  (interactive "P")
  (if hide
      (my-image-dired-dired-hide-all-thumbs)
    (add-hook 'dired-after-readin-hook
              'image-dired-dired-after-readin-hook nil t)
    (if (my-image-dired-confirm-generate-thumbs (my-image-dired-dired-all-image-files))
        (save-excursion
          (goto-char (point-min))
          (while (< (point) (point-max))
            (my-image-dired-dired-set-thumb-visibility t)
            (forward-line 1)))
      (message "Canceled."))))

(defun my-image-dired-dired-all-image-files ()
  (when (derived-mode-p 'dired-mode)
    (save-excursion
      (goto-char (point-min))
      (let ((image-regexp (image-file-name-regexp))
            files)
        (while (< (point) (point-max))
          (let ((file (dired-get-filename nil t)))
            (when (and file
                       (string-match-p image-regexp file))
              (push file files)))
          (forward-line 1))
        (nreverse files)))))

(defun my-image-dired-confirm-generate-thumbs (files)
  (let* ((no-thumb-files (seq-filter (lambda (file)
                                       (not (file-exists-p
                                             (image-dired-thumb-name file))))
                                     files))
         (num-no-thumb-files (length no-thumb-files)))
    (or (<= num-no-thumb-files image-dired-show-all-from-dir-max-files)
        (y-or-n-p
         (format
          "Generate %s new thumbnails. Proceed? "
          num-no-thumb-files)))))

;;;; ファイル削除時にサムネイルを削除

(defun my-image-dired-dired-remove-entry-around (orig-fun file &rest args)
  (save-excursion
    (when (dired-goto-file file)
      (cl-loop for ov in (overlays-in (line-beginning-position)
                                      (line-end-position))
               when (and (overlay-get ov 'put-image)
                         (overlay-get ov 'thumb-file))
               do (delete-overlay ov))))
  (apply orig-fun file args))

(advice-add #'dired-remove-entry :around
            #'my-image-dired-dired-remove-entry-around)

;;;; Diredバッファからimage-dired関連ウィンドウを閉じる

(defun my-image-dired-quit-display-window (&optional kill)
  (interactive "P")
  (when-let ((window (image-dired-display-window)))
    (quit-window kill window)))

(defun my-image-dired-dired-quit-window (&optional kill)
  (interactive "P")
  (if-let ((window (or (image-dired-display-window)
                       (image-dired-thumbnail-window))))
      (quit-window kill window)
    (quit-window kill)))

;;;; Diredバッファから全画像ファイルを一括でサムネイルバッファに表示する

(defun my-image-dired-dired-show-all-images ()
  ;; Derived from `image-dired-show-all-from-dir'
  (interactive)
  (unless (derived-mode-p 'dired-mode)
    (error "Not dired buffer"))
  (let* ((image-regexp (image-file-name-regexp))
         (files (seq-filter (lambda (file) (string-match-p image-regexp file))
                            (directory-files "." t))))
    (if (my-image-dired-confirm-generate-thumbs files)
        ;; Emacs 28まで
        ;; (progn
        ;;   (my-image-dired-display-thumbs files (current-buffer))
        ;;   (image-dired-thumb-update-marks) ;;マークを同期する
        ;;   (pop-to-buffer image-dired-thumbnail-buffer))
        ;; Emacs 29から
        (progn
          (my-image-dired-display-thumbs files (current-buffer))
          (image-dired--thumb-update-marks) ;;マークを同期する
          (pop-to-buffer image-dired-thumbnail-buffer)
          (image-dired--update-header-line))
      (message "Canceled."))))

(defun my-image-dired-display-thumbs (files dired-buf
                                            &optional append do-not-pop)
  ;; Derived from `image-dired-display-thumbs'
  (setq image-dired--generate-thumbs-start  (current-time))
  (let ((buf (image-dired-create-thumbnail-buffer)))
    (with-current-buffer buf
      ;; Emacs 28まで
      ;; (let ((inhibit-read-only t))
      ;;   (if append (goto-char (point-max)) (erase-buffer))
      ;;   (dolist (curr-file files)
      ;;     (let ((thumb-name (image-dired-thumb-name curr-file)))
      ;;       (unless (file-exists-p thumb-name)
      ;;         (image-dired-create-thumb curr-file thumb-name))
      ;;       (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
      ;;   (if do-not-pop
      ;;       (display-buffer buf)
      ;;     (pop-to-buffer buf))
      ;;   (image-dired--line-up-with-method))
      ;; Emacs 29から
      (let ((inhibit-read-only t))
        (if (not append)
            (progn
              (setq image-dired--number-of-thumbnails 0)
              (erase-buffer))
          (goto-char (point-max)))
        (dolist (file files)
          (when (string-match-p (image-dired--file-name-regexp) file)
            (image-dired-insert-thumbnail
             (image-dired--get-create-thumbnail-file file) file dired-buf
             (cl-incf image-dired--number-of-thumbnails))))))))

;;;; サムネイルバッファ内から全マークの解除

;; Emacs 29.1からは不要。標準で image-dired-unmark-all-marks がある。
(defun my-image-dired-unmark-all ()
  (interactive)
  (when-let ((dired-buf (image-dired-associated-dired-buffer)))
    (with-current-buffer dired-buf
      (dired-unmark-all-marks)))
  (image-dired-thumb-update-marks))

;;;; 外部ツールで表示

(defun my-image-dired-thumbnail-display-external-w32 ()
  ;; Derived from `image-dired-thumbnail-display-external'
  (interactive)
  (let ((file (image-dired-original-file-name)))
    (if (not (image-dired-image-at-point-p))
        (message "No thumbnail at point")
      (if (not file)
          (message "No original file name found")
        ;; Use shell execute!
        (w32-shell-execute "open" file)))))

(defun my-image-dired-dired-display-external-w32 ()
  ;; Derived from `image-dired-dired-display-external'
  (interactive)
  (let ((file (dired-get-filename)))
    ;; Use shell execute!
    (w32-shell-execute "open" file)))

;;;; Diredからサムネイルバッファの対応するファイルへジャンプ

(defun my-image-dired-dired-jump-thumbnail-buffer ()
  (interactive)
  (let ((file (dired-get-filename)))
    ;; Display thumbnail buffer
    (if (image-dired-thumbnail-window)
        (image-dired-jump-thumbnail-buffer)
      (if (buffer-live-p (get-buffer image-dired-thumbnail-buffer))
          (pop-to-buffer image-dired-thumbnail-buffer)
        (message "No thumbnail buffer")))
    ;; Jump
    (my-image-dired-goto-file file)))

(defun my-image-dired-goto-file (file)
  (let ((pos (save-excursion
               (goto-char (point-min))
               (when-let ((match (text-property-search-forward 'original-file-name file t)))
                 (prop-match-beginning match)))))
    (when pos
      (goto-char pos))))

;;;; 設定

(with-eval-after-load "image-dired"
  (when (eq system-type 'windows-nt)
    (setq image-dired-cmd-create-thumbnail-program "magick"
          image-dired-cmd-create-temp-image-program "magick")
    (unless (equal (car image-dired-cmd-create-thumbnail-options) "convert")
      (push "convert" image-dired-cmd-create-thumbnail-options))
    (unless (equal (car image-dired-cmd-create-temp-image-options) "convert")
      (push "convert" image-dired-cmd-create-temp-image-options))
    (define-key image-dired-thumbnail-mode-map [remap image-dired-thumbnail-display-external] 'my-image-dired-thumbnail-display-external-w32))
  ;; Emacs 29.1からは不要。標準で image-dired-unmark-all-marks がある。
  ;;(define-key image-dired-thumbnail-mode-map "U" 'my-image-dired-unmark-all)
  )

(with-eval-after-load "dired"
  (define-key dired-mode-map [remap image-dired-dired-toggle-marked-thumbs] 'my-image-dired-dired-toggle-marked-thumbs)
  (define-key dired-mode-map (kbd "C-t C-a") 'my-image-dired-dired-toggle-all-thumbs)
  (define-key dired-mode-map (kbd "q") 'my-image-dired-dired-quit-window)
  (define-key dired-mode-map (kbd "C-t q") 'my-image-dired-quit-display-window)
  (define-key dired-mode-map (kbd "C-t C-d") 'my-image-dired-dired-show-all-images)
  (define-key dired-mode-map (kbd "C-t TAB") 'my-image-dired-dired-jump-thumbnail-buffer)
  (when (eq system-type 'windows-nt)
    (define-key dired-mode-map [remap image-dired-dired-display-external] 'my-image-dired-dired-display-external-w32)))

その他の問題

サムネイル生成を中断する方法が無い
サムネイル生成の進行状況を確認する方法が無い
サムネイル生成が終わったのにサムネイルが更新されないことがある
サムネイル生成が終わった後にdired-details-rのレイアウトが崩れる
サムネイル生成の高速化
Diredバッファとサムネイルバッファの間のマークの同期が不完全
サムネイルバッファ内でのマーク操作が不足している(全トグル等)
サムネイル画像の量を調べたり削除したりする機能が無い

とりあえず

とりあえずすぐに目に付いたものを修正してみましたが、まだまだ直すべき所は沢山ありそうです。

image-diredは本家の方でも継続的に改良されているみたいなので(GitHubのEmacsミラーをチラ見した限り)、最新版はまた状況が異なるかもしれません。私は現在Emacs 28.2に同梱されているものを使用しています。(2023-08-08追記: Emacs 29.1にアップデートしました)

肝心のタグやコメントに関する機能をあまり使っていないので、今後はそれらを使ってみて効率よいワークフローが確立できるかを模索しようと思います。

目次