(define-widget 'custom-face-edit 'checklist
  "Widget for editing face attributes.
The following properties have special meanings for this widget:

:value is a plist of face attributes.

:default-face-attributes, if non-nil, is a plist of defaults for
face attributes (as specified by a `default' defface entry)."
  :format "%v"
  :extra-offset 3
  :button-args '(:help-echo "Control whether this attribute has any effect.")
  :value-to-internal 'custom-face-edit-fix-value
  :match (lambda (widget value)
           (widget-checklist-match widget
                                   (custom-face-edit-fix-value widget value)))
  :value-create 'custom-face-edit-value-create
  :convert-widget 'custom-face-edit-convert-widget
  :args (mapcar (lambda (att)
                  (list 'group :inline t
                        :format "%v"
                        :sibling-args (widget-get (nth 1 att) :sibling-args)
                        (list 'const :format "" :value (nth 0 att))
                        (nth 1 att)))
                custom-face-attributes))

(progn
  (pop-to-buffer (generate-new-buffer "*Widget Example*"))
  (widget-create 'checklist
                 :value '("Second" t) ;;初期値
                 :notify (lambda (widget &rest _)
                           (message "通知 value=%s" (widget-value widget)))
                 ;;以下args
                 '(const "First")
                 '(const "Second")
                 '(boolean :on "有効" :off "無効")
                 '(number :value 123))
  (use-local-map widget-keymap)
  (widget-setup))

(defun custom-face-edit-value-create (widget)
  (let* ((alist (widget-checklist-match-find
                 widget (widget-get widget :value)))
         (args  (widget-get widget :args))
         (show-all (widget-get widget :show-all-attributes))
         (buttons  (widget-get widget :buttons))
         (defaults (widget-checklist-match-find
                    widget
                    (widget-get widget :default-face-attributes)))
         entry)
    ;; 改行と空白の挿入
    (unless (looking-back "^ *" (line-beginning-position))
      (insert ?\n))
    (insert-char ?\s (widget-get widget :extra-offset)) ;;注意:nilのとき1文字挿入してしまう。バグ？　仕様？
    ;; 値部分の挿入
    (if (or alist defaults show-all)
        (dolist (prop args)
          (setq entry (or (assq prop alist)
                          (assq prop defaults)))
          (if (or entry show-all)
              (widget-checklist-add-item widget prop entry)))
      (insert (propertize "-- Empty face --" 'face 'shadow) ?\n))
    ;; 未使用属性を隠す/表示するボタン
    (let ((indent (widget-get widget :indent)))
      (if indent (insert-char ?\s (widget-get widget :indent))))
    (push (widget-create-child-and-convert
           widget 'visibility
           :help-echo "Show or hide all face attributes."
           :button-face 'custom-visibility
           :pressed-face 'custom-visibility
           :mouse-face 'highlight
           :on "Hide Unused Attributes"    :off "Show All Attributes"
           :on-glyph nil :off-glyph nil
           :always-active t
           :action 'custom-face-edit-value-visibility-action
           show-all)
          buttons)
    (insert ?\n)
    ;; ボタンと子供達を記録
    (widget-put widget :buttons buttons)
    (widget-put widget :children (nreverse (widget-get widget :children)))))

(defun custom-face-edit-convert-widget (widget)
  "Convert :args as widget types in WIDGET."
  (widget-put
   widget
   :args (mapcar (lambda (arg)
                   (widget-convert arg
                                   :deactivate 'custom-face-edit-deactivate
                                   :activate 'custom-face-edit-activate
                                   :delete 'custom-face-edit-delete))
                 (widget-get widget :args)))
  widget)

  :args (mapcar (lambda (att)
                  (list 'group :inline t
                        :format "%v"
                        :sibling-args (widget-get (nth 1 att) :sibling-args)
                        (list 'const :format "" :value (nth 0 att))
                        (nth 1 att)))
                custom-face-attributes)

(
 (group :inline t :format "%v" :sibling-args nil (const :format "" :value :family) (string :tag "Font Family" :help-echo "Font family or fontset alias name."))
 (group :inline t :format "%v" :sibling-args nil (const :format "" :value :foundry) (string :tag "Font Foundry" :help-echo "Font foundry name."))
 (group :inline t :format "%v" :sibling-args nil (const :format "" :value :width)
        (choice :tag "Width" :help-echo "Font width." :value normal (const :tag "compressed" condensed) (const :tag "condensed" condensed) ...))
 ...
)

(progn
  (require 'edraw-widget)
  (pop-to-buffer (generate-new-buffer "*Widget Example*"))
  (widget-create 'edraw-attribute-alist
                 :tag "Props"
                 :format "%v"
                 :notify
                 (lambda (w &rest _) (message "%s" (prin1-to-string (widget-value w))))
                 ;; :greedy nil ←未知の値の扱いに関わる(デフォルトはtにしてある)
                 :value '((stroke-width . 123.45) (stroke . "red") (unknown . "uval") (fill . "green"))
                 '(fill
                   (string :tag "Fill"))
                 '(stroke
                   (string :tag "Stroke"))
                 '(stroke-width
                   (number :tag "Stroke Width"))
                 '(stroke-join
                   (choice :tag "Stroke Join"
                           :value "miter"
                           (const "miter")
                           (const "round")
                           (const "bevel"))))
  (use-local-map widget-keymap)
  (widget-setup))

(require 'edraw-widget)
(defcustom my-hogehoge-properties
  '((stroke-width . 123.45) (stroke . "red") (fill . "green"))
  "Hoge Hoge no Properties."
  :type '(edraw-attribute-alist
          :tag "My Hogehoge Properties"
          (fill
           (string :tag "Fill"))
          (stroke
           (string :tag "Stroke"))
          (stroke-width
           (number :tag "Stroke Width"))
          (stroke-join
           (choice :tag "Stroke Join"
                   :value "miter"
                   (const "miter")
                   (const "round")
                   (const "bevel")))))

(define-widget 'color 'editable-field
  "Choose a color name (with sample)."
  :format "%{%t%}: %v (%{sample%})\n"
  :value-create 'widget-color-value-create
  :size (1+ (apply #'max 13 ; Longest RGB hex string.
                   (mapcar #'length (defined-colors))))
  :tag "Color"
  :value "black"
  :completions (defined-colors)
  :sample-face-get 'widget-color-sample-face-get
  :notify 'widget-color-notify
  :match #'widget-color-match
  :validate #'widget-color-validate
  :action 'widget-color-action)

;; 実装にはedraw-color.elやedraw-color-picker.elの助けを借ります。
;; https://github.com/misohena/el-easydraw/blob/master/edraw-color.el
;; https://github.com/misohena/el-easydraw/blob/master/edraw-color-picker.el
(require 'edraw-color)
(require 'edraw-color-picker)

(define-widget 'my-web-color 'editable-field
  "Choose a web color (with sample)."
  :value "black"
  ;; タグ: 値 サンプル
  :format "%{%t%}: %v %{      %}\n"
  ;; デフォルトのタグ(%t部分)
  :tag "Color"
  ;; 値部分の作成(%v部分)
  :value-create 'my-widget-web-color-value-create
  :size 26 ;; rgba(255,255,255,1.2345)くらいが収まる長さにしておく
  ;; 補完候補(C-M-i (M-TAB)で補完候補を出せる)
  :completions (mapcar #'car edraw-color-web-keywords)
  ;; 見本部分のface
  :sample-face-get 'my-widget-web-color-sample-face-get
  ;; 見本の更新
  :notify 'my-widget-web-color-notify
  ;; 値の検証
  :match #'my-widget-web-color-match
  :validate #'my-widget-web-color-validate
  ;; ミニバッファからの入力
  :action 'my-widget-web-color-action)

(defun my-widget-web-color-value-create (widget)
  ;; 値を表す部分(:formatの%v部分)をバッファ上に作成します。

  ;; editable-fieldとしての部分を作成。
  (widget-field-value-create widget)
  (widget-insert " ")
  ;; その後にChooseボタンを追加。
  (widget-create-child-and-convert
   widget 'push-button
   :tag " Choose " :action 'my-widget-web-color--choose-action)
  (widget-insert " "))

(defun my-widget-web-color--choose-action (widget &optional _event)
  ;; Chooseボタンが押されたら呼び出されます。
  ;; カラーピッカーで色を入力してもらい、それを親widgetの値として設定します。
  (let* ((wp (widget-get widget :parent))
         (old-color (widget-value wp))
         (new-color (edraw-color-picker-read-color nil old-color)))
    (widget-value-set wp new-color)))

(defun my-widget-web-color-sample-face-get (widget)
  ;; 見本部分(:formatの%{から%}までの間)に適用するfaceを返します。
  (let ((color (condition-case nil
                   (edraw-color-from-string (widget-value widget))
                 (error (widget-get widget :value)))))
    (if color
        (list (cons 'background-color (edraw-to-string-hex (edraw-change-a color 1.0)))) ;; 半透明が表現できないので無理矢理不透明にします。本当はSVGで市松模様背景付きのサンプルを作りたい所。
      'default)))

(defun my-widget-web-color-action (widget &optional event)
  "Prompt for a color."
  ;; フィールド上でRETを押したときに呼び出されます。
  ;; ミニバッファから色を入力してもらい、それをwidgetの値として設定します。
  (let* ((old-color (widget-value widget))
         (new-color (edraw-color-picker-read-color nil old-color)))
    (when new-color
      (widget-value-set widget new-color)
      (widget-setup)
      (widget-apply widget :notify widget event))))

(defun my-widget-web-color-notify (widget child &optional event)
  "Update the sample, and notify the parent."
  ;; 何かイベントが発生したときに呼び出されます。
  ;; たいていの場合テキストが変化したときなので、サンプルのfaceを更新します。
  (overlay-put (widget-get widget :sample-overlay)
               'face (widget-apply widget :sample-face-get))
  (widget-default-notify widget child event))

(defun my-widget-web-color-match (_widget value)
  ;; WIDGETにVALUEを設定可能なら非nilを返します。
  (and (stringp value)
       (or (assoc value edraw-color-web-keywords)
           (string-match edraw-color-string-patterns-re value))))

(defun my-widget-web-color-validate (widget)
  ;; WIDGETの現在の値が正当かチェックします。
  ;; エラーがなければnilを返します。
  (let ((value (widget-value widget)))
    (unless (my-widget-web-color-match widget value)
      (widget-put widget :error (format "Invalid color: %S" value))
      widget)))

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-insert "\n")
(widget-create 'my-web-color
               :tag "色"
               "black")
(use-local-map widget-keymap)
(widget-setup)

(defcustom my-hogehoge-color "#ff0000"
  "My Hogehoge HTML color."
  :type 'my-web-color)

(defun my-hogehoge-html ()
  (format "<span style=\"color: %s\">hogehoge</span>" my-hogehoge-color))

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-create 'url-link
               :tag "GNUのWebサイト"
               "https://www.gnu.org/")
(widget-setup)

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-create 'push-button
               :action (lambda (widget &optional _event)
                         (message "押された value=%s" (widget-value widget)))
               :tag "押して"
               "何かの値")
(use-local-map widget-keymap) ;; これが無いと押せない。linkは押せるのに
(widget-setup)

(pop-to-buffer (generate-new-buffer "*Widget Example*"))
(widget-create 'list
               :tag "何かの固定長固定型のリスト"
               :notify (lambda (widget &rest args)
                         (message "通知 value=%s" (widget-value widget)))
               '(const "何かの固定値")
               '(boolean :tag "何かの真偽値" :on "有効" :off "無効")
               '(text :tag "好きな複数行文字列" :value "hogehoge"))
(use-local-map widget-keymap)
(widget-setup)

(let ((syms))
  (mapatoms (lambda (s) (when (get s 'widget-type) (push s syms))) obarray)
  syms)

(define-widget 'url-link 'link
  "A link to a web page."
  :action 'widget-url-link-action)

(define-widget 'link 'item
  "An embedded link."
  :button-prefix 'widget-link-prefix
  :button-suffix 'widget-link-suffix
  :follow-link 'mouse-face
  :keymap widget-link-keymap
  :help-echo "Follow the link."
  :format "%[%t%]")

(define-widget 'item 'default
  "Constant items for inclusion in other widgets."
  :convert-widget 'widget-value-convert-widget ;; 引数列をwidgetオブジェクトへ変換する
  :value-create 'widget-item-value-create ;; :formatの%v部分として、:valueの値をprincでバッファへ挿入する
  :value-delete 'ignore
  :value-get 'widget-value-value-get ;; :valueの値をそのまま返す
  :match 'widget-item-match
  :match-inline 'widget-item-match-inline
  :action 'widget-item-action ;; 自分自身に対して :notify を呼び出す
  :format "%t\n")

(define-widget 'default nil
  "Basic widget other widgets are derived from."
  :value-to-internal (lambda (_widget value) value)
  :value-to-external (lambda (_widget value) value)
  :button-prefix 'widget-button-prefix
  :button-suffix 'widget-button-suffix
  :completions-function #'widget-default-completions
  :create 'widget-default-create ;; :format等に従ってテキストやオーバーレイなどをバッファへ挿入する。
  :indent nil
  :offset 0
  :format-handler 'widget-default-format-handler ;; :formatに知らないエスケープ文字がある場合に呼ばれる
  :button-face-get 'widget-default-button-face-get
  :mouse-face-get 'widget-default-mouse-face-get
  :sample-face-get 'widget-default-sample-face-get
  :delete 'widget-default-delete ;; バッファからwidgetの全テキストを削除する
  :copy 'identity
  :value-set 'widget-default-value-set
  :value-inline 'widget-default-value-inline
  :value-delete 'ignore ;; :value-createで挿入したものを削除する
  ;; :value-create で :format の %v 部分をバッファへ挿入する
  :default-get 'widget-default-default-get
  :menu-tag-get 'widget-default-menu-tag-get
  :validate #'ignore ;; widgetの現在値が正当かチェックする
  :active 'widget-default-active
  :activate 'widget-specify-active
  :deactivate 'widget-default-deactivate
  :mouse-down-action #'ignore
  :action 'widget-default-action
  :notify 'widget-default-notify
  :prompt-value 'widget-default-prompt-value)

(let ((beg (point))
      (_ (insert "[OV2TEXT [OV1TEXT] OV2TEXT]"))
      (end (point)))
  (let ((ov1 (make-overlay (+ beg 9) (- end 9))))
    (overlay-put ov1 'evaporate t)
    (overlay-put ov1 'before-string "[OV1BEFORE]"))
  (let ((ov2 (make-overlay beg end)))
    (overlay-put ov2 'evaporate t)
    (overlay-put ov2 'face '(:background "#4080c0"))))

(let ((beg (point))
      (_ (insert "[OV2TEXT [OV1TEXT] OV2TEXT]"))
      (end (point)))
  (let ((ov1 (make-overlay (+ beg 9) (- end 9))))
    (overlay-put ov1 'evaporate t)
    (overlay-put ov1 'before-string
                 ;; ↓★displayテキストプロパティを設定する。
                 (propertize "_" 'display "[OV1BEFORE-DISPLAY]")))
  (let ((ov2 (make-overlay beg end)))
    (overlay-put ov2 'evaporate t)
    (overlay-put ov2 'face '(:background "#4080c0"))))

;; Emacs 29.1付属のimage-dired-dired.elより
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
  "Toggle thumbnails in front of marked file names in the Dired buffer.
If no file is marked, toggle display of thumbnail on the current file's line.
ARG, if non-nil (interactively, the prefix argument), specifies the files
whose thumbnail display to toggle instead of the marked files: if ARG is an
integer, use the next ARG (or previous -ARG, if ARG<0) files; any other
value of ARG means toggle thumbnail display of the current line's file."
  (interactive "P" dired-mode)
  (setq image-dired--generate-thumbs-start  (current-time))
  (dired-map-over-marks
   (let ((image-pos  (dired-move-to-filename))
         (image-file (dired-get-filename nil t))
         thumb-file
         overlay)
     (when (and image-file
                (string-match-p (image-dired--file-name-regexp) image-file))
       (setq thumb-file (create-image
                         (image-dired--get-create-thumbnail-file image-file)))
       ;; If image is not already added, then add it.
       (let ((thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point)))
                                if (overlay-get ov 'thumb-file) return ov)))
         (if thumb-ov
             (delete-overlay thumb-ov)
           (put-image thumb-file image-pos)
           (setq overlay
                 (cl-loop for ov in (overlays-in (point) (1+ (point)))
                          if (overlay-get ov 'put-image) return ov))
           (overlay-put overlay 'image-file image-file)
           (overlay-put overlay 'thumb-file thumb-file))
         ;; ★ここに追加したい
         )))
   ;; Show or hide thumbnail on ARG next files.
   arg)
  (add-hook 'dired-after-readin-hook
            'image-dired-dired-after-readin-hook nil t))

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

;; ★2023-08-17追加
(defvar my-image-dired-dired-change-thumb-hook nil
  "diredバッファ内のサムネイルの表示状態が変化したら呼び出されるフッ
クです。

呼ばれるときの引数は(THUMBNAIL-OVERLAY ORIGINAL-IMAGE-FILENAME
IMAGE-POSITION)です。現在のバッファは変化したdiredバッファです。")

(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)
              ;; ★2023-08-17追加 : 表示→非表示
              (run-hook-with-args 'my-image-dired-dired-change-thumb-hook
                                  nil image-file image-pos))
          (when (memq visibility '(t toggle))
            ;; ★2023-08-17修正 : 非表示→表示
            (let ((new-thumb-ov
                   ;; 独自の関数を呼ぶ
                   (my-image-dired-dired-create-thumbnail-overlay
                    image-pos image-file thumb-file)))
              (run-hook-with-args 'my-image-dired-dired-change-thumb-hook
                                  new-thumb-ov image-file image-pos))))))))

;; Emacs 29.1付属のimage-dired-external.elより

(defun image-dired-create-thumb-1 (original-file thumbnail-file)
  "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
  (image-dired--check-executable-exists
   'image-dired-cmd-create-thumbnail-program)
  (let* ((size (number-to-string (image-dired--thumb-size)))
         (modif-time (format-time-string
                      "%s" (file-attribute-modification-time
                            (file-attributes original-file))))
         (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
                                                       thumbnail-file))
         (spec `((?s . ,size) (?w . ,size) (?h . ,size)
                 (?m . ,modif-time)
                 (?f . ,original-file)
                 (?q . ,thumbnail-nq8-file)
                 (?t . ,thumbnail-file)))
         (thumbnail-dir (file-name-directory thumbnail-file))
         process)
    (when (not (file-exists-p thumbnail-dir))
      (with-file-modes #o700
        (make-directory thumbnail-dir t))
      (message "Thumbnail directory created: %s" thumbnail-dir))

    ;; Thumbnail file creation processes begin here and are marshaled
    ;; in a queue by `image-dired-create-thumb'.
    (let ((cmd image-dired-cmd-create-thumbnail-program)
          (args (mapcar
                 (lambda (arg) (format-spec arg spec))
                 (if (memq image-dired-thumbnail-storage
                           image-dired--thumbnail-standard-sizes)
                     image-dired-cmd-create-standard-thumbnail-options
                   image-dired-cmd-create-thumbnail-options))))
      (image-dired-debug "Running %s %s" cmd (string-join args " "))
      (setq process
            (apply #'start-process "image-dired-create-thumbnail" nil
                   cmd args)))

    (setf (process-sentinel process)
          (lambda (process status)
            ;; Trigger next in queue once a thumbnail has been created
            (cl-decf image-dired-queue-active-jobs)
            (image-dired-thumb-queue-run)
            (when (= image-dired-queue-active-jobs 0)
              (image-dired-debug
               (format-time-string
                "Generated thumbnails in %s.%3N seconds"
                (time-subtract nil
                               image-dired--generate-thumbs-start))))
            (if (not (and (eq (process-status process) 'exit)
                          (zerop (process-exit-status process))))
                (message "Thumb could not be created for %s: %s"
                         (abbreviate-file-name original-file)
                         (string-replace "\n" "" status))
              (set-file-modes thumbnail-file #o600)
              (clear-image-cache thumbnail-file)
              ;; PNG thumbnail has been created since we are
              ;; following the XDG thumbnail spec, so try to optimize
              (when (memq image-dired-thumbnail-storage
                          image-dired--thumbnail-standard-sizes)
                (cond
                 ((and image-dired-cmd-pngnq-program
                       (executable-find image-dired-cmd-pngnq-program))
                  (image-dired-pngnq-thumb spec))
                 ((and image-dired-cmd-pngcrush-program
                       (executable-find image-dired-cmd-pngcrush-program))
                  (image-dired-pngcrush-thumb spec))
                 ((and image-dired-cmd-optipng-program
                       (executable-find image-dired-cmd-optipng-program))
                  (image-dired-optipng-thumb spec)))))))
    process))

(defvar my-image-dired-create-thumb-hook nil)

(defun my-image-dired-create-thumb-1-around-for-call-hook
    (orig-fun original-file thumbnail-file &rest args)
  "`image-dired-create-thumb-1'に対するaround adviceです。"
  (let* (;; 元のimage-dired-create-thumb-1を呼び出す。
         (process (apply orig-fun original-file thumbnail-file args))
         ;; 返ってきたprocessオブジェクトの元のsentinelをとっておく。
         (orig-sentinel (process-sentinel process)))
    ;; sentinelを横取りする。
    (set-process-sentinel
     process
     (lambda (process status)
       (prog1
           ;; 元のsentinelを呼ぶ。
           (funcall orig-sentinel process status)
         ;; 成功だったら、フックを呼び出す。
         (when (and (eq (process-status process) 'exit)
                    (zerop (process-exit-status process)))
           (run-hook-with-args 'my-image-dired-create-thumb-hook
                               original-file thumbnail-file)))))
    process))

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

;; サムネイル画像をdiredバッファに挿入した後、または削除した後の処理。
;; 呼び出されるときのcurrent-bufferはdiredバッファです。

(defun my-image-dired-dired-update-on-change-thumb (_ov _original-file pos)
  (save-excursion
    (goto-char pos)
    (when (fboundp 'dired-details-r-update-current-line)
      (dired-details-r-update-current-line))))

(add-hook 'my-image-dired-dired-change-thumb-hook
          #'my-image-dired-dired-update-on-change-thumb)

;; サムネイル画像を生成し終わったときの処理。
;; 呼び出されるときのcurrent-bufferがどこかは分からないので注意すること。

(defun my-image-dired-dired-update-on-create-thumb (original-path thumb-path)
  ;; 念のため確実にフルパスにする。
  (setq original-path (expand-file-name original-path))
  (setq thumb-path (expand-file-name thumb-path))

  (let ((dired-buffers
         ;; 元画像があるディレクトリを表示するdiredバッファを列挙する。
         ;; サブディレクトリを挿入していると複数あり得る。
         (let ((original-dir (file-name-directory original-path)))
           (cl-loop for buf in (buffer-list)
                    when (and
                          (eq (buffer-local-value 'major-mode buf) 'dired-mode)
                          (assoc original-dir
                                 (buffer-local-value 'dired-subdir-alist buf)))
                    collect buf))))

    ;; 各diredバッファについて:
    (dolist (buf dired-buffers)
      (with-current-buffer buf
        ;; @todo サムネイル左右の余白も更新したい。
        ;; dired-details-rでoriginal-pathの行だけ更新する。
        (when (fboundp 'dired-details-r-update-file)
          (dired-details-r-update-file original-path))))))

(add-hook 'my-image-dired-create-thumb-hook
          'my-image-dired-dired-update-on-create-thumb)