image-diredのサムネイルを元の画像の場所が分かる形式にする

;;;; サムネイルファイル名のエンコード

(defun my-image-dired--encode-thumb-name (path)
  "PATHをファイルのベース名として使える文字列へエンコードします。"
  ;; url-hexify-stringは少し問題があるので使えない。
  (mapconcat (lambda (ch)
               ;; 変換元がファイル名なのでパス区切り文字以外は不要だと思
               ;; うが念のため色々エスケープしておく。
               ;; 拡張子を示す.もエスケープして完全にベース名として認識
               ;; されるようにする。
               (if (or (<= ch 32)
                       (memq ch '(?< ?> ?: ?\" ?/ ?\\ ?| ?? ?* ?. ?%))) ;;2023-08-13追記:?%が抜けていたのを修正
                   (format "%%%02x" ch)
                 (char-to-string ch)))
             path))

(defun my-image-dired--thumb-dir (original-file) ;;2023-08-17追記:追加
  "ORIGINAL-FILEに対するサムネイルを格納する場所を返します。"
  (expand-file-name
   ;; %エンコードする
   (my-image-dired--encode-thumb-name
    ;; 最後のスラッシュは含めてしまっていいかな。c:/とかあるし。
    (file-name-directory (expand-file-name original-file)))
   (image-dired-dir)))

(defun my-image-dired--thumb-file-name (original-file) ;;2023-08-17追記:追加
  "ORIGINAL-FILEに対応するサムネイルファイル名を返します。
ディレクトリは含まれません。"
  (concat
   ;; %エンコードする(ファイル名部分のみ・拡張子込み)
   (my-image-dired--encode-thumb-name
    (file-name-nondirectory original-file))
   ;; 拡張子を付ける
   ".jpg"))

(defun my-image-dired--thumb-file-path (original-file) ;;2023-08-17追記:追加
  "ORIGINAL-FILEに対応するサムネイルファイル名のフルパスを返します。"
  (file-name-concat (my-image-dired--thumb-dir original-file)
                    (my-image-dired--thumb-file-name original-file)))

;;;; サムネイルのファイル名を元の画像が分かるようなものにする

;; image-diredが生成するサムネイルのファイル名を、元画像の場所が分か
;; るような形式にする。

(defun my-image-dired-thumb-name (file)
  "`image-dired-thumb-name'を置き換えるための関数です。
画像ファイルFILEを格納するためのサムネイルファイルのパスを返します。
格納できるようにするために必要なディレクトリを作成する場合があります。"
  ;;2023-08-17追記:my-image-dired--thumb-dirとmy-image-dired--thumb-file-nameを使うようにしました。
  (let* ((thumb-dir (my-image-dired--thumb-dir file))
         (thumb-filename (my-image-dired--thumb-file-name file)))
    ;; ここでディレクトリを作ってしまうのはあまり良くないけど……
    (unless (file-directory-p thumb-dir)
      (with-file-modes #o700
        (make-directory thumb-dir t)))
    (file-name-concat thumb-dir thumb-filename)))

(defun my-image-dired-thumb-name-around (old-func file)
  "`image-dired-thumb-name'に対する:aroundアドバイスです。"
  (if (eq 'image-dired image-dired-thumbnail-storage)
      ;; image-dired-thumbnail-storageが'image-diredの時だけ
      ;; 独自のファイル名を生成する。
      (my-image-dired-thumb-name file)
    ;; その他は本来の関数を呼び出す。
    (funcall old-func file)))

(advice-add 'image-dired-thumb-name :around 'my-image-dired-thumb-name-around)