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

(defun my-image-dired--decode-thumb-name (str)
  "STR内の%xx表記を元の文字に戻します。"
  (replace-regexp-in-string
   "%[0-9A-Fa-f][0-9A-Fa-f]"
   (lambda (entity) (char-to-string (string-to-number (substring entity 1) 16)))
   str t t))

(defun my-image-dired-thumb-original-file-name (thumb-path)
  "サムネイル画像THUMB-PATHの元画像ファイルのファイル名(ディレクトリ
部分を含まない)を返します。"
  (my-image-dired--decode-thumb-name (file-name-sans-extension ;;jpgを取り除く
                                      (file-name-nondirectory thumb-path))))

(defun my-image-dired-thumb-original-dir (thumb-path)
  "サムネイル画像THUMB-PATHの元画像ファイルがあるディレクトリを返します。"
  (setq thumb-path (expand-file-name thumb-path))
  (unless (string-prefix-p (expand-file-name (image-dired-dir))
                           thumb-path)
    (error "THUMB-PATH is not in the `image-dired-dir'"))
  (my-image-dired--decode-thumb-name
   (file-name-nondirectory
    (directory-file-name
     (file-name-directory thumb-path)))))

(defun my-image-dired-thumb-original-path (thumb-path)
  "サムネイル画像THUMB-PATHの元画像ファイルへのパスを返します。
元画像ファイルは存在しているとは限りません。"
  (file-name-concat (my-image-dired-thumb-original-dir thumb-path)
                    (my-image-dired-thumb-original-file-name thumb-path)))

;;;; サムネイルの掃除
(defvar my-image-dired-clean-verbose nil)

(defun my-image-dired-clean-thumbs-dir (thumbs-dir &optional forced-delete-p)
  "サムネイルが格納されているディレクトリTHUMBS-DIR内を掃除します。

THUMBS-DIRは`my-image-dired--thumb-dir'で作成されたような、元のディ
レクトリが%エンコードされているパスです。その下にあるファイルは
`my-image-dired--thumb-file-name'でエンコードされている必要があり
ます。

FORCED-DELETE-Pがnon-nilの時は、元画像がまだあるサムネイルも含め
て全てのサムネイルが削除されます。"
  (let ((original-dir (my-image-dired-thumb-original-dir
                       (file-name-as-directory thumbs-dir)))
        (valid-count 0)
        (deleted-count 0)
        (error-count 0))
    (dolist (thumb-path (directory-files thumbs-dir t "\\.jpg\\'"))
      (let* ((original-filename (my-image-dired-thumb-original-file-name
                                 thumb-path))
             (original-path (file-name-concat original-dir original-filename)))
        (if (and (not forced-delete-p)
                 (file-exists-p original-path))
            ;; 有効なサムネイルが存在した。
            (cl-incf valid-count)
          ;; 無効なサムネイルを消す。
          (when my-image-dired-clean-verbose
            (message "Delete thumb %s (Original:%s)" thumb-path original-path))
          (condition-case err
              (progn
                (delete-file thumb-path)
                (cl-incf deleted-count))
            (error
             (when my-image-dired-clean-verbose
               (message "Failed to delete thumb %s (Original:%s) err=%s" thumb-path original-path err))
             (cl-incf error-count))))))

    ;; 有効なサムネイルが存在しないならディレクトリの削除を試みる。
    (when (= valid-count 0)
      (when my-image-dired-clean-verbose
        (message "Delete thumbs dir %s" thumbs-dir))
      (ignore-errors (delete-directory thumbs-dir)))

    ;; 結果を返す。
    (my-image-dired-clean-count-make deleted-count error-count valid-count)))

;; 処理結果の意味

(defun my-image-dired-clean-count-make (&optional deleted error valid)
  (list (or deleted 0) (or error 0) (or valid 0)))
(defun my-image-dired-clean-count-inc (dst src)
  (cl-loop for dst-cell on dst
           for src-value in src
           do (setcar dst-cell (+ (car dst-cell) src-value))))
(defun my-image-dired-clean-count-deleted (count) (nth 0 count))
(defun my-image-dired-clean-count-error (count) (nth 1 count))
(defun my-image-dired-clean-count-valid (count) (nth 2 count))

(defun my-image-dired-clean-report (count show-msg)
  (when show-msg
    (message "Deleted %s, Error %s, Valid %s"
             (my-image-dired-clean-count-deleted count)
             (my-image-dired-clean-count-error count)
             (my-image-dired-clean-count-valid count)))
  count)

(defun my-image-dired-clean-thumbs (&optional forced-delete-p)
  "既に存在しない画像に対するサムネイルを削除します。"
  (interactive)
  ;; `image-dired-dir'下の全てのディレクトリについて
  ;; `my-image-dired-clean-thumbs-dir'を呼び出す。
  (let ((thumbs-root-dir (image-dired-dir))
        (count (my-image-dired-clean-count-make)))
    (dolist (file (directory-files thumbs-root-dir))
      (when (not (member file '("." "..")))
        (let ((thumbs-dir (expand-file-name file thumbs-root-dir)))
          (when (file-directory-p thumbs-dir)
            (my-image-dired-clean-count-inc
             count
             (my-image-dired-clean-thumbs-dir thumbs-dir forced-delete-p))))))
    (my-image-dired-clean-report count (called-interactively-p 'interactive))
    count))

(defun my-image-dired-clean-thumbs-under (original-dir &optional subdirs-p
                                                       forced-delete-p)
  "ORIGINAL-DIR下の画像に対するサムネイルのうち不要になったものを削除します。

SUBDIRS-Pがnon-nilの場合、ORIGINAL-DIR以下にあった子孫ディレクト
リも処理に含めます。

インタラクティブに実行した場合は、現在のディレクトリが
original-dirになり、コマンドのプレフィックス引数がsubdirs-pになり
ます。"
  (interactive
   (list
    (if (derived-mode-p 'dired-mode 'wdired-mode)
        (dired-current-directory) ;;複数のディレクトリを表示している場合に備えて
      default-directory)
    current-prefix-arg))

  (let ((thumbs-dir (my-image-dired--thumb-dir
                     (file-name-as-directory original-dir)))
        (count (my-image-dired-clean-count-make)))
    (if subdirs-p
        ;; 子孫ディレクトリを含める。
        ;; エンコードしたディレクトリパスと先頭がマッチする
        ;; サムネイルディレクトリを全て対象にする。
        ;; 既に削除されているディレクトリも列挙できる。
        (dolist (thumbs-dir (directory-files
                             (image-dired-dir)
                             t
                             (concat "\\`"
                                     (regexp-quote
                                      (file-name-nondirectory thumbs-dir)))))
          (my-image-dired-clean-count-inc
           count
           (my-image-dired-clean-thumbs-dir thumbs-dir forced-delete-p)))
      ;; 指定ディレクトリ下のみ。
      (when (file-directory-p thumbs-dir)
        (setq count
              (my-image-dired-clean-thumbs-dir thumbs-dir forced-delete-p))))
    (my-image-dired-clean-report count (called-interactively-p 'interactive))
    count))

(defun my-image-dired-delete-thumbs ()
  "全てのサムネイルを削除します。"
  (interactive
   (unless (yes-or-no-p "Delete all thumbnails? ")
     (keyboard-quit)))
  (my-image-dired-clean-report
   (my-image-dired-clean-thumbs t)
   (called-interactively-p 'interactive)))


(defun my-image-dired-delete-thumbs-under (original-dir &optional subdirs-p)
  "ORIGINAL-DIR下の画像に対するサムネイルを全て削除します。

SUBDIRS-Pがnon-nilの場合、ORIGINAL-DIR以下にあった子孫ディレクト
リも処理に含めます。

インタラクティブに実行した場合は、現在のディレクトリが
original-dirになり、コマンドのプレフィックス引数がsubdirs-pになり
ます。"
  (interactive
   (list
    (if (derived-mode-p 'dired-mode 'wdired-mode)
        (dired-current-directory) ;;複数のディレクトリを表示している場合に備えて
      default-directory)
    current-prefix-arg))

  (my-image-dired-clean-report
   (my-image-dired-clean-thumbs-under original-dir subdirs-p t)
   (called-interactively-p 'interactive)))

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

(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)

magick convert video.mp4 jpg:image.jpg

magick convert video.mp4[0] jpg:image.jpg

;; image-converterがImageMagickで動画ファイルを変換するときに長時間
;; 固まるのを避ける。
;; 全フレーム読み込もうとしてしまうのだとか！
(defun my-image-converter--convert-magick (old-fun type source image-format)
  ;; ファイル名の後に[0]をつける。data形式の場合は未対応。
  (unless image-format
    (setq source (concat source "[0]")))
  (funcall old-fun type source image-format))

(advice-add 'image-converter--convert-magick :around
            'my-image-converter--convert-magick)

;; image-mode等で表示する方法

(defun my-image-convert-ffmpeg (source format)
  (image-converter--convert 'ffmpeg source format))

(image-converter-add-handler "mp3" #'my-image-convert-ffmpeg)
(image-converter-add-handler "m4a" #'my-image-convert-ffmpeg)

;; image-diredでサムネイルを表示する方法

(defun my-image-dired-create-thumb-1-around (orig-func
                                             original-file thumbnail-file)
  (if (member (file-name-extension original-file) '("mp3" "m4a"))

      ;; ffmpegを使うように一時的に変数を書き替えてから実行
      (let ((image-dired-cmd-create-thumbnail-program "ffmpeg")
            (image-dired-cmd-create-thumbnail-options
             '("-i" "%f"
               "-vf" "scale=%w:%h:force_original_aspect_ratio=decrease"
               "%t")))
        (funcall orig-func original-file thumbnail-file))

    ;; 通常通りに実行
    (funcall orig-func original-file thumbnail-file)))

(advice-add 'image-dired-create-thumb-1 :around #'my-image-dired-create-thumb-1-around)

;; (Emacs 29.1で確認)

;; 画像のコンバーターとしてImageMagickを使う。
;; GraphicsMagickは対応形式が少なくmp4やpsdに対応していない。
;; FFmpegは動画中心で色々足りない。
;; see: https://misohena.jp/blog/2023-08-09-imagemagick-vs-graphicsmagick-vs-ffmpeg-for-emacs.html
(setq image-converter 'imagemagick) ;; 注意: 変更時は下の拡張子を修正すること。

;; 変換対象の画像形式を登録する。
(let ((target-extensions
       '(;; ImageMagickが対応する形式のうち問題が無さそうなものを適当に残した。
         ;; セキュリティ的にはもっと絞った方が良いというのはある。
         ;; 他人が作ったファイルを不用意に開くべからず。
         ;; 一覧は (image-converter--probe 'imagemagick) で得られる。
         "3g2" "3gp" "ai" "apng" "art" "avi" "avif"
         "bmp" "cr2" "cr3" "cur" "dcm"
         "dcr" "dds" "dng" "dpx" "dxt1" "dxt5"
         "epdf" "epi" "eps" "epsf" "epsi" "ept" "ept2" "ept3" "erf"
         "fits" "fl32" "flif" "flv"
         "fts" "gif"
         "hdr" "heic" "heif" "hrz"
         "icb" "ico" "icon" "iiq" "ipl" "j2c" "j2k" "jbg" "jbig"
         "jng" "jnx" "jp2" "jpc" "jpe" "jpeg" "jpg" "jpm" "jps" "jpt" "k25"
         "kdc" "m2v" "m4v" "mef" "miff"
         "mkv" "mng" "mono" "mov" "mp4" "mpc" "mpeg" "mpg" "mpo" "mrw"
         "mtv" "mvg" "nef" "nrw" "orf" "otb" "otf"
         "pam" "pbm" "pcd" "pcds" "pcl"
         "pct" "pcx" "pdf" "pdfa" "pef" "pfa" "pfb" "pfm"
         "pgm" "pgx" "phm" "picon" "pict" "pix" "pjpeg" "png"
         "pnm"
         "ppm" "ps" "psb" "psd" "ptif" "pwp" "qoi" "raf" "ras"
         "rgf" "rla" "rle" "rmf" "rw2"
         "sfw"
         "sgi" "six" "sixel" "sr2" "srf"
         "sun"
         "svg" "svgz" "tga" "tiff" "tiff64" "tim"
         "tm2" "ttc" "ttf" "vda" "vicar" "viff" "vips"
         "vst" "wbmp" "webm" "webp" "wmv" "wpg" "x3f" "xbm"
         "xcf" "xpm" "xps" "xv")))

  ;; 対象をimage-file-name-extensionsに追加する。
  ;; おそらく本来はこれだけで良いはず。
  (setq image-file-name-extensions
        (seq-union image-file-name-extensions target-extensions))

  ;; いくつか問題があるので、image-converter.el内の変数を直接変更する。
  ;; (Emacs 29.1時点)
  ;;
  ;; 問題:
  ;;
  ;; - image-file-name-extensionsに指定していない形式もコンバーター
  ;;   を使ってimage-modeやcreate-imageで表示できてしまう。
  ;;
  ;; - コンバーターの初回起動に何秒もかかる。コンバーターの対応形式
  ;;   をリストアップするのに時間がかかるので。
  ;;
  ;; - 一度コンバーターが起動すると、image-file-name-extensionsに指
  ;;   定していない形式もimage-diredでサムネイル表示されるようになっ
  ;;   てしまう。
  ;;
  ;; 対応形式をリストアップする前に手動で設定してしまうことで問題を回避する。
  ;; ここはimage-converter.elの実装が変わると変更が必要になるかもしれない。
  (setq image-converter-file-name-extensions target-extensions)
  (setq image-converter-regexp
        (concat "\\." (regexp-opt target-extensions) "\\'"))

  ;; 変換対象の拡張子を持つファイルをimage-modeで開く。
  ;; auto-mode-alistの初期値には
  ;; 「Image file types probably supported by `image-convert'.」
  ;; として既に含まれているものも多いが、全てが登録されているわけではない。
  ;; psdとか。
  ;; auto-image-file-modeでもいいのかもしれない。
  (dolist (ext target-extensions)
    ;; すでにauto-mode-alistに登録されている拡張子は変更しない。
    (unless (assoc-default (format "a.%s" ext) auto-mode-alist 'string-match)
      (push (cons (format "\\.%s\\'" ext) 'image-mode)
            auto-mode-alist))))

;; create-imageでコンバーターを使う。
(setq image-use-external-converter t)

;; ImageMagickのconvertコマンドをmagick convertに置き換える。
;; convertはWindowsで困るので。
(with-eval-after-load "image-converter" ;;image-converter.elが読み込まれてから
  (setf (plist-get (alist-get 'imagemagick image-converter--converters)
                   :command)
        '("magick" "convert")))

;; 2023-08-12追記
;; MP3等対応
;; image-mode等でMP3等をを表示する方法
(defun my-image-convert-ffmpeg (source format)
  (image-converter--convert 'ffmpeg source format))
(image-converter-add-handler "mp3" #'my-image-convert-ffmpeg)
(image-converter-add-handler "m4a" #'my-image-convert-ffmpeg)
;; image-diredでMP3等をサムネイルを表示する方法
(defun my-image-dired-ffmpeg-options (file-ext)
  (pcase file-ext
    ("mp4" ;;動画のサムネイルもffmpegで生成する。
     '("-stream_loop" "-1" ;;短い動画に備えて無限ループさせる。
       "-ss" "30" ;;開始30秒時点のフレームを使う。
       "-i" "%f"
       "-vf" "scale=%w:%h:force_original_aspect_ratio=decrease"
       "-update" "true"
       "-vframes" "1"
       "%t"))
    ((or "mp3" "m4a")
     '("-i" "%f"
       "-vf" "scale=%w:%h:force_original_aspect_ratio=decrease"
       "-vframes" "1"
       "%t"))))
(defun my-image-dired-create-thumb-1-around (orig-func
                                             original-file thumbnail-file)
  (if-let ((ffmpeg-options (my-image-dired-ffmpeg-options
                            (file-name-extension original-file))))
      (let ((image-dired-cmd-create-thumbnail-program "ffmpeg")
            (image-dired-cmd-create-thumbnail-options ffmpeg-options))
        (funcall orig-func original-file thumbnail-file))
    (funcall orig-func original-file thumbnail-file)))
(advice-add 'image-dired-create-thumb-1 :around #'my-image-dired-create-thumb-1-around)

;; 2023-08-12追記
;; image-converterがImageMagickで動画ファイルを変換するときに長時間
;; 固まるのを避ける。
;; 全フレーム読み込もうとしてしまうのだとか！
;; image-diredの方は対策済み。
(defun my-image-converter--convert-magick (old-fun type source image-format)
  ;; ファイル名の後に[0]をつける。data形式の場合は未対応。
  (unless image-format
    (setq source (concat source "[0]")))
  (funcall old-fun type source image-format))
(advice-add 'image-converter--convert-magick :around
            'my-image-converter--convert-magick)

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

(defun my-image-dired-thumb-name (old-func file)
  (if (eq 'image-dired image-dired-thumbnail-storage)
      ;; 独自のファイル名を生成する。
      (let* ((orig-path (expand-file-name file))
             (orig-filename (file-name-nondirectory orig-path))
             (orig-dir (file-name-directory orig-path)) ;;最後のスラッシュは含めてしまっていいかな。c:/とかあるし。
             (thumb-filename
              (concat (my-image-dired--encode-thumb-name orig-filename)
                      ".jpg"))
             (thumb-dir
              (expand-file-name (my-image-dired--encode-thumb-name orig-dir)
                                (image-dired-dir))))
        ;; ここでディレクトリを作ってしまうのはあまり良くないけど……
        (unless (file-directory-p thumb-dir)
          (with-file-modes #o700
            (make-directory thumb-dir t)))
        (file-name-concat thumb-dir thumb-filename))
    ;; 本来の関数を呼び出す。
    (funcall old-func file)))
(advice-add 'image-dired-thumb-name :around 'my-image-dired-thumb-name)

(setq image-converter--converters
  '((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
    (ffmpeg :command "ffmpeg" :probe "-decoders")
    (imagemagick :command ("magick" "convert") :probe ("-list" "format")))) ;; magickコマンドを使うように修正する(WindowsだとSystem32にconvert.exeがあるので)
(setq im-formats (image-converter--probe 'imagemagick))

(setq gm-formats (image-converter--probe 'graphicsmagick))

(list (list "ImageMagick" "GraphicsMagick")
      'hline
      (list (length im-formats) (length gm-formats)))

(seq-intersection im-formats gm-formats)

(seq-difference im-formats gm-formats)

(seq-difference gm-formats im-formats)

(image-converter--probe 'ffmpeg)