image-diredで不要になったサムネイルを削除する

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

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