2024-01-26

プロパティ一覧編集widgetを作る(Emacs Widget Libraryについて調べる3)

前回の続き。

今回は複数のプロパティを保持するリスト(plistなりalistなり)を編集するwidgetを作成します。

すでにplistやalistという名前のwidgetは定義されているのですが、それの見た目はこんな感じです。

org-link-parametersをカスタマイズするところ(plistのalist)
図1: org-link-parametersをカスタマイズするところ(plistのalist)

違う。そうじゃないんだ。

やりたいことに一番近いのはfaceをカスタマイズする画面です。

customize-faceの画面
図2: customize-faceの画面

つまり、既に決まっている固定のプロパティ種類があり、その値の型もプロパティ種類によって決まっているような状況です。

プロパティの省略も可能で、省略した場合は何らかのデフォルト値が使われるといった具合です。

このfaceをカスタマイズするUIはcus-edit.el内にcustom-face-editという名前のwidgetとして定義されています。Emacs 29.2時点での定義は次の通りです。

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

:value-to-internal:match の部分にはcustom-face-edit-fix-value関数が使われていますが、これはface属性の古い書き方を新しい書き方に直すためのものなので、ここでは無視します。 :extra-offset 3 はwidget先頭に追加するスペース、 :button-args ... はヘルプエコー、 :format "%v" は単にタグ等を消して値部分だけ表示させる指定なので、あまり重要ではありません。 :value-createconvert-widget:args の三つが重要になります。

まずdefine-widgetの第二引数CLASSはchecklistとなっています。これは派生元となるいわゆる基本クラスで、custom-face-editはchecklistの性質を受け継ぎます。

checklistは複数の子widgetの中からいくつかを選ぶようなwidgetです。結果の値は選ばれた子widgetの値だけが含まれるリストになります。例えば次のようなコードを実行して:

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

1番目と4番目のチェックボックスのみを有効にしたら結果は ("First" 123) になります。

faceのカスタマイズではチェックボックスをoffにした部分は結果のplistに含まれないようにしたいので、checklistから派生しているのだと思います。

次に :value-create に指定されたcustom-face-edit-value-create関数を見てみましょう(日本語コメントは私が追記)。

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

この部分は :format の %v 部分を処理するときに呼び出される関数です。

実はこの部分はcheckboxの :value-create (widget-checklist-value-create)と本質的には大差ありません。違うところと言えば、未使用の属性を隠したり表示したりするボタンを追加しているくらいです。それと :default-face-attributes という指定の処理があるのですがとりあえず置いておきます。

次に :convert-widget に指定されたcustom-face-edit-convert-widget関数

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

この部分はwidget-createでwidgetオブジェクトを作成する際に呼び出されるいわばコンストラクタのようなもので完全に理解するにはwidget-createwidget-convertの処理を詳しく知る必要があるのですが、大ざっぱに言えば全ての子widgetに対して :deactivate:activate:delete のプロパティを強制的に追加しています。それによって、チェックボックスがON/OFFされて子widgetがactive、inactiveになったときの処理やwidgetを削除するときの処理を書き替えています。custom-face-editでは見た目を色々変えているので必要になります。あまり詳しく説明する必要は無さそうでしょうか。

そして最後の :args の部分。

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

これはチェックリストの項目を生成する部分です。

custom-face-attributesという変数にface属性の一覧があるので、そこからmapcarで変換します。custom-face-attributesの各要素は一つのface属性に関する情報を持つリストです。その一つ目の要素は属性キーワード(:family とか :width とか)です。二つ目はその属性を編集するためのwidget型です。三つ目以降もあるのですがここで使うのはそこまでです。mapcar部分を実際に評価してみると次のようになります。

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

つまり、各項目は (group (const :family) string) やら (group (const :width) (choice ...)) などといったgroup widgetになります。

ここで注目すべきは :inline t という指定です。 :inline というのは決して一つの行内のwidgetという意味ではありません。普通のgroupだと結果の値は (:family "Arial") のようなリストになるので全体としては ((:family "Arial") (:width condensed)) のようになりplistにもalistにもなりません。そこで :inline t を指定すると子の結果が親のリストの中に展開されて (:family "Arial" :width condensed) という形になり、めでたくplistになるわけです。

ちなみにこのgroupをconsにしてやると結果をplistではなくalistにできます。ただし、別の所に少々バグというか問題があってエラーが発生する場合があり、そこを修正してやる必要があります。

以上を踏まえて、決まった型のplistやalistを編集するより汎用的なwidgetを作成し edraw-widget.el にまとめました。これを使うと例えば次のようにalistを編集するwidgetを作成できます。

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

defcustomの:typeに指定することも出来ます。

(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")))))
defcustomでedraw-attribute-alistを使ってみたときの見た目
図3: defcustomでedraw-attribute-alistを使ってみたときの見た目

未知のプロパティが現れたときの処理はもう少し改善する余地があると思います。末尾に任意のプロパティとマッチするrepeatを加えてみたりもしたのですが、続く既知のプロパティまで巻き込んでしまうためうまく行きませんでした。マッチングのコードを修正する必要がありそうです。

制作の過程で色々ハマリどころがあって(inactiveなconsとcheckboxの通知タイミング、未指定のextra-offset、等)それについても書いておきたいのですが、長くなるので止めておきます。

2024-01-16

Webカラーwidgetを作る(Emacs Widget Libraryについて調べる2)

前回の続き。

試しにWeb用のカラーコードを入力するためのwidgetを定義してみましょう。

実はEmacs用のカラーコードを入力するためのwidgetは既にあります。

wid-edit.el 4053行目

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

実行すると次図のようになり、Chooseボタンを押すとカラーピッカー付きで色を入力できます。選択した色もwidgetの右側にサンプルとして表示されます。

Webカラーwidgetを表示させてChooseボタンを押したところ
図1: Webカラーwidgetを表示させてChooseボタンを押したところ

ここで定義したwidgetはdefcustomの:type部分に指定することも出来ます。

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

M-x customize-variableでmy-hogehoge-colorを選ぶと次図のようになります。ボタンのスタイルが変わっているのが面白いですね。私はCorfuを入れているので、C-M-iではこのように補完候補が表示されます。

my-hogehoge-colorをcustomizeで変更するところ
図2: my-hogehoge-colorをcustomizeで変更するところ

次は構造を持った値を編集するような複雑なwidgetを作りたいところです。

2024-01-16 ,

Emacs Lisp要素へのorg-modeリンクをエクスポートする

以前Emacs Lisp要素へのリンクをorg-modeに追加するというのを書きました。[[elisp-function:create-image][create-image]]のような形式でEmacs Lispの要素(関数・変数・face)へのリンクを書けるようにするものです。そしてC-c C-oでその要素の定義箇所へジャンプできるようにしました。

しかしエクスポートには対応していませんでした。そのようなリンクを含むOrg文書をHTMLとしてエクスポートしても、意味のあるリンクにはなりません。

元々Emacs内でソースコードを追いかけるときのメモのために用意したのでエクスポートする必要は無かったのですが、こうしたブログに書くときに正しくエクスポートできると便利なことが多々あります。

シンボルから定義の場所を探す

まず要素のシンボルから定義の場所(ファイルと行番号)を割り出します。次のようなコードでできるようです。

(defun my-elisp-element-file-line (symbol finder)
  (ignore-errors
    (let* ((buf-point (funcall finder symbol))
           ;;@todo バッファやポイントの状態を元に戻す。ただし、開きっぱなしの方が連続して変換するときは効率が良い。
           (buffer (car buf-point))
           (point (cdr buf-point)))
      (with-current-buffer buffer
        (cons (expand-file-name (buffer-file-name)) ;;abs-file
              (line-number-at-pos point t)))))) ;;line

(defun my-elisp-function-file-line (symbol)
  (my-elisp-element-file-line symbol #'find-function-noselect))

(defun my-elisp-variable-file-line (symbol)
  (my-elisp-element-file-line symbol #'find-variable-noselect))

(defun my-elisp-face-file-line (symbol)
  (my-elisp-element-file-line symbol
                              (lambda (symbol)
                                (find-definition-noselect symbol 'defface))))

例えば次のように使います。

(my-elisp-function-file-line 'create-image)
("c:/略/share/emacs/29.1/lisp/image.el" . 484)

find-function-noselect関数等を使うとその副作用でバッファが開きっぱなしになったり、もし既に開いていた場合はポイントが動いてしまったりするのですが、とりあえず放っておきます。開きっぱなしの方が連続的に沢山のリンクをエクスポートするときに速いという面はあると思うので。

ファイルと行番号からURLを求める

次にその場所を指すURLを求めるのですが、そのURLはローカルファイルへのURLではなく、世界中から参照できるWorld Wide Web上のURLでなければなりません。でなければこういったブログで使うことはできません。

幸いほとんどのソースコードはWeb上に存在するものです。

EmacsにバンドルされているファイルへのURLを求める

Emacsのソースコードは https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/ から参照できます。

例えばEmacs 29.1時点でのimage.el内の484行目は https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/image.el?h=emacs-29.1#n484 で参照できます。

従って次のような関数を作れば:

(defun my-path-globalize-emacs (abs-file line)
  "Create a URL to a file bundled with Emacs."
  (let ((dirs `((,lisp-directory
                 . "https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/")
                (,find-function-C-source-directory
                 . "https://git.savannah.gnu.org/cgit/emacs.git/tree/src/"))))
    (cl-loop for (dir . url) in dirs
             when (and dir (string-prefix-p (expand-file-name dir) abs-file))
             return
             (concat
              url
              (file-relative-name abs-file dir)
              "?h=emacs-" emacs-version
              (when line (format "#n%d" line))))))

次のような式でローカルファイルへのパスと行番号からWeb上でのURLを作成できます。

(my-path-globalize "c:/略/share/emacs/29.1/lisp/image.el" 484)
"https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/image.el?h=emacs-29.1#n484"

package.elで管理されているファイルへのURLを求める

package.elで管理しているファイルについてもある程度URLを求めることが出来るようです。

(defvar my-path-globalize-package-globalizers
  '(my-path-globalize-package-org
    my-path-globalize-package-github))

(defun my-path-globalize-package (abs-file line)
  "Create a URL to the file managed by package.el."
  (when-let* ((pkg-name-desc (my-path-globalize-package-find abs-file))
              (pkg-name (car pkg-name-desc))
              (pkg-desc (cdr pkg-name-desc))
              (pkg-dir (package-desc-dir pkg-desc))
              (rel-file (file-relative-name abs-file pkg-dir)))
    (seq-some (lambda (globalizer)
                (funcall globalizer rel-file line pkg-name pkg-desc))
              my-path-globalize-package-globalizers)))

(defun my-path-globalize-package-find (abs-file)
  ;;@todo package-user-dirで足切りする? package-directory-listも?
  (cl-loop for (name . descs) in package-alist
           for desc = (cl-loop for desc in descs
                               for dir = (package-desc-dir desc)
                               when (and dir
                                         (string-prefix-p
                                          (expand-file-name dir) abs-file))
                               return desc)
           when desc
           return (cons name desc)))

(defun my-path-globalize-package-org (rel-file line pkg-name pkg-desc)
  (when (eq pkg-name 'org)
    (when-let* ((pkg-extras (package-desc-extras pkg-desc))
                (pkg-commit (alist-get :commit pkg-extras)))
      (concat
       "https://git.savannah.gnu.org/cgit/emacs/org-mode.git/tree/lisp/"
       rel-file
       "?id=" pkg-commit
       (when line (format "#n%d" line))))))

(defun my-path-globalize-package-github (rel-file line _pkg-name pkg-desc)
  (when-let* ((pkg-extras (package-desc-extras pkg-desc))
              (pkg-url (alist-get :url pkg-extras))
              (pkg-commit (alist-get :commit pkg-extras)))
    (when (string-match "\\(https?://github\\.com/[^/]+/[^/]+\\)" pkg-url)
      (concat
       (match-string 1 pkg-url) "/blob/" pkg-commit "/" rel-file
       (when line (format "#L%d" line))))))

パッケージの紹介Webサイト(?)がGitHubの場合は、GitHubにあるソースコードを参照するようにしてみました。また、Org-modeは特別に処理しています。他にも必要に応じてルールを追加する必要があるでしょう。

例えば vertico-mode の場所:

(my-path-globalize-package (expand-file-name "~/.emacs.d/elpa/vertico-20231229.1740/vertico.el") 741)
"https://github.com/minad/vertico/blob/93f709d71e8908617a21ca469fd60123f5037ae4/vertico.el#L741"

org-link-parametersの場所:

(my-path-globalize-package (expand-file-name "~/.emacs.d/elpa/org-9.6.14/ol.el") 92)
"https://git.savannah.gnu.org/cgit/emacs/org-mode.git/tree/lisp/ol.el?id=58c91cbf9f2510700fbbdaaa166efcb1a5582cf7#n92"

両方まとめる

とりあえずこの二つをまとめて次のようにすることで:

(defvar my-path-globalizers
  '(my-path-globalize-emacs
    my-path-globalize-package))

(defun my-path-globalize (file line)
  "Return a URL on the World Wide Web that points to the LINE of the FILE.

FILE is a path to a local file that has the same content on the WWW.

LINE is a line number starting from 1."
  (let ((abs-file (expand-file-name file)))
    (seq-some (lambda (globalizer) (funcall globalizer abs-file line))
              my-path-globalizers)))

(my-path-globalize ファイル名 行番号)でローカルにあるEmacs Lispファイルの場所をWeb上のURLへ変換できるようになりました。

これを使ってシンボルから直接Web URLを求める関数も作成できます。

(defun my-elisp-face-web-url (symbol)
  (my-elisp-element-web-url symbol
                            (lambda (symbol)
                              (find-definition-noselect symbol 'defface))))

(defun my-elisp-variable-web-url (symbol)
  (my-elisp-element-web-url symbol #'find-variable-noselect))

(defun my-elisp-function-web-url (symbol)
  (my-elisp-element-web-url symbol #'find-function-noselect))

(defun my-elisp-element-web-url (symbol finder)
  (when-let ((file-line (my-elisp-element-file-line symbol finder)))
    (my-path-globalize (car file-line) (cdr file-line))))

org-modeでエクスポートする

後はorg-modeのリンクタイプに設定してやるだけです。

エクスポート用の関数を用意し:

(defun my-org-elisp-export-function (path desc format)
  (my-org-elisp-export-element path desc format #'my-elisp-function-web-url))

(defun my-org-elisp-export-variable (path desc format)
  (my-org-elisp-export-element path desc format #'my-elisp-variable-web-url))

(defun my-org-elisp-export-face (path desc format)
  (my-org-elisp-export-element path desc format #'my-elisp-face-web-url))

(defun my-org-elisp-export-element (path desc format path-converter)
  (or (when (eq format 'html)
        (when-let ((url (funcall path-converter (intern path))))
          (format "<a href=\"%s\">%s</a>" url (or desc path))))
      ;; pathが解決できないときはリンクにしない。
      (or desc path)))

org-link-parametersへ登録してやります:

(org-link-set-parameters
 "elisp-function"
 :follow (lambda (name) (find-function (intern name)))
 :export #'my-org-elisp-export-function)

(org-link-set-parameters
 "elisp-variable"
 :follow (lambda (name) (find-variable (intern name)))
 :export #'my-org-elisp-export-variable)

(org-link-set-parameters
 "elisp-face"
 :follow (lambda (name) (find-face-definition (intern name)))
 :export #'my-org-elisp-export-face))

テスト

試しに次にいろんな要素へのリンクを書いてみました。

Orgソース:

- Emacsバンドル
  - [[elisp-function:create-image]] (lisp/image.el)
  - [[elisp-function:url-retrieve]] (lisp/url/url.el ←階層あり)
  - [[elisp-function:widget-get]] (src/fns.c)
  - [[elisp-variable:truncate-lines]] (src/buffer.c)
  - [[elisp-face:font-lock-comment-face]] (lisp/font-lock.el)
- package.el
  - GitHub
    - [[elisp-function:vertico-mode][vertico-mode]]
  - org-mode
    - [[elisp-function:org-mode][org-mode]]
    - [[elisp-variable:org-link-parameters][org-link-parameters]]

注意点:再エクスポートで同じURLが生成されない問題

URLは現在実行している環境で使われているバージョンのソースコードを参照しています。文書を書いている時点のソースコードを指し示すのが最も無難だろうとの判断によるものですが、不都合なこともあるかもしれません。特に文書を書いてからしばらく経った後、Emacsやパッケージをバージョンアップした後に再度エクスポートした場合、同じURLが生成されないという問題があります。これが嫌なのであれば、大人しく通常のhttp(https)リンクを使うべきでしょう。上の仕組みを流用してそのようなhttpリンクを生成するようなコマンドも容易に作成できることでしょう。

2024-01-07

Emacs Widget Libraryについて調べる

Emacs Widget LibraryというのはEmacsのテキストバッファ内に(データ入力フォームみたいな)UIを構築するためのライブラリです。

customizeのUIなんかで使われているアレです。defcustomの:typeで指定しているのはまさにこのwidgetのtypeだったりします。他にもEmacsの様々なところで使われていますし、私のel-easydrawではプロパティ一覧編集の画面に使われていたりもします。

Emacs Lispを書いていると度々必要になるものなので、前々からこのEmacs Widget Libraryについてはちょくちょく調べています。

基本的な部分については一応マニュアルがあります。

The Emacs Widget Library

手っ取り早く動く例が欲しいのであれば、Programming Exampleがあります。この例は一つ一つのwidgetの挙動を細かく調べるには大きすぎるので、私は次のようなコードで色々試しています。

url-linkの例:

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

push-buttonの例:

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

listの例:

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

widget-keymapには次のものが割り当てられています:

  • ボタンを押すために必要なコマンド(RET, down-mouse-1等)
  • 前後のwidgetへ移動するコマンド(TAB, S-TAB等)

widget-setupは(現在のバッファについて)次のことを行います:

  • 一部widgetの最終初期化処理
  • UNDO情報のクリア
  • 変更を監視するフックの追加 (変更をしかるべき所に通知するのが主な目的ですが、同時にフィールド以外の所でテキスト編集ができなくなります)

そして肝心要のwidget-createは次のことを行います:

  1. widgetオブジェクトの作成
  2. バッファへの挿入

widget-createの引数は (type &rest args) です。 type はwidgetの種類を表すシンボルです。残りの引数列 argstype ごとに定められた形の引数列です。一般的には、キーワード引数が0個以上続いた後にキーワードが付かない値が0個以上続く形になっています。

widgetの type (種類)に何があるのかは、マニュアルのBasic TypesSexp Typesに載っているほか、M-x widget-browseの補完候補で分かります。または次のコードで(現在ロードされている)一覧を得ることも出来ます。

(let ((syms))
  (mapatoms (lambda (s) (when (get s 'widget-type) (push s syms))) obarray)
  syms)
(boolean checklist widget-browse documentation-link group natnum emacs-commentary-link float visibility coding-system custom-manual tree-widget-icon regexp checkbox c-symbol-list choice other toggle variable cons integer editable-field bibtex-entry-alist tree-widget-nohandle-guide flycheck-minimum-level alist option mule-input-method-string charset plist info-link sexp c-integer-or-nil radio-button-choice character tree-widget-no-handle lazy emacs-library-link flycheck-highlighting-style custom-browse-group-tag my-attribute-list tree-widget-no-guide glyphless-char-display-method tree-widget-empty-icon custom-face-edit tree-widget-leaf-icon custom-face tree-widget-open-icon tree-widget string custom-group-visibility custom-icon link repeat list function-link hook my-attribute-plist buffer-predicate custom-browse-variable-tag variable-link custom-magic fringe-bitmap custom-comment number text directory vector documentation-string custom-group-link custom-visibility custom-browse-face-tag choice-item radio-button symbol bibtex-field-alist custom-group face restricted-sexp custom-variable custom key c-extra-types-widget tree-widget-end-guide custom-face-all function custom-browse-visibility custom-display face-link color tree-widget-close-icon tree-widget-guide item const file editable-list function-item set insert-button key-sequence radio default file-link variable-item menu-choice delete-button push-button url-link c-const-symbol tree-widget-handle)

基本的なwidgetは wid-edit.el で定義されているので、それを見るのが一番手っ取り早いでしょう。例えば url-link はwid-edit.el内で次のように定義されています。

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

このコードによって、url-linkタイプは、linkタイプの:actionプロパティを'widget-url-link-actionに変更したものと定義されます。

これは良くあるオブジェクト指向プログラミング言語におけるクラスの定義と意味的にはほとんど同じです。linkが継承元クラスで、:actionというメソッドをオーバーライドすることに相当します。:actionはプロパティですが、その値は常に関数として(widget-applyで)呼び出されるのでメソッドのようなものです。:actionに指定された関数はwidgetが押されたときに呼び出されます。:actionに指定されているwidget-url-link-action関数の中身が (browse-url (widget-value widget)) となっているので、url-linkを押すとwidgetの現在値に設定されたURLがbrowse-url関数で開かれるわけです。

ちなみに継承元であるlinkは:

(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%]")

さらにその継承元であるitemは:

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

さらにさらにその継承元であるdefaultは:

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

と定義されており、このように継承関係を辿っていくことが出来ます。

(ちなみに、実装的にはJavaScriptのprototypeチェーンを使った継承に似ています。prototypeの代わりにシンボルの'widget-typeプロパティが使われていますが)

プロパティの一覧については、後からdefine-widget部分に載っていないプロパティが動的に追加・参照されることも多々あるのでこれだけでは完全ではありませんが、ある程度参考にはなるでしょう。

新しいwidgetタイプを作る時に使うプロパティについてはDefining New Widgetsに説明がありますが、これだけで分かる人もあまりいないと思うので wid-edit.el を見て各widget-*関数からどのようにそれらのプロパティが参照されているかを確認した方が早いでしょう。

様々なタイミングでどのような処理がされているのかいくらでも書くことが出来ますが、キリがないのでとりあえずこの辺で。

最後にwidgetタイプをクラスに見立ててクラス図を描いたのを載せておきます。

Basic Typesに書いてあるもの:

2024-01-07-classes-basic.png

Sexp Typesに書いてあるもの:

2024-01-07-classes-sexp.png

Basic Typesに書いてあるものの詳細:

2024-01-07-classes-basic-detailed.png

※(関数以外の)デフォルト値を変更しているだけのものは // を付けて残してあります。

2023-09-08 ,

el-easydrawで縦書きは表示できるか

style属性に writing-mode:vertical-rl; と指定すれば縦書きを表示できます。

edrawでテキストを縦書きにしてみた様子
図1: edrawでテキストを縦書きにしてみた様子

ただしEmacs 27.1世代の古いlibrsvgではウンともスンとも言わず全く効果はありませんでした。

私が今使っているWindows上の(MSYS2でビルドされた)Emacs 29.1においても、上スクリーンショットのように正しい位置に描画されません。他にも一部の文字の位置がずれる問題も発生しています。

text-anchorをmiddleにすることで縦方向の中心に揃えることが出来るはずですが、これも正しく機能しているとは言い難い状況です(先頭文字のmiddleになっている?)。

また、edraw自身も境界矩形を正しく認識していません。これを修正するにはstyleの値を解析する必要がありそうです。(2023-09-10追記: writing-modeプロパティを追加して境界矩形はそれを考慮するようにしました。styleの方は依然考慮していません)

実際にこのブログに描いてエクスポートすると次のようになります(埋め込みのSVGなので文字の範囲選択や検索が可能です)。

バスタ新宿中央道日野新島々駅安曇野支所前さわんどBT中の湯大正池帝国ホテル前上高地BT
図2: 実際にエクスポートされたSVG
2023-09-08 ,

el-easydrawでCSS filterは使えるのか

使えるみたいです。

各種図形のstyleプロパティにfilterを指定した様子
図1: 各種図形のstyleプロパティにfilterを指定した様子

style属性に filter:drop-shadow(3px 3px 5px black); などと指定してやると、ドロップダウンシャドウが表示されます。

(その他の書き方: filter - CSS: カスケーディングスタイルシート | MDN)

実際にエクスポートしたのが次。表示されるかはブラウザ次第です。

TEXTAAABBBCCCHEARTSPADEDIA
図2: edrawで描いてエクスポートしたSVG

ちゃんとやるならSVG本来のフィルタに対応すべきなのでしょうが、UIを作るのが面倒くさいんですよねぇ。

ちなみに、手元のEmacs 27.1バイナリで試したところEmacs内の表示には効果がありませんでした。おそらくここ数年でlibrsvgが対応したのだと思います。

filterを使うと作図エディタとしての動作がかなり重くなります。EmacsでSVGを使って色々やる場合に一番ネックになる点は、実はlibrsvgがリアルタイム向きではないという事です。Emacs Lispを使ってSVGを組み立ててそれをイベントのたびに更新するという仕組みはそれ自体かなり無駄が多いのですが、そこは今日のPCではそこまで大きな問題ではありません。一番のネックはなんといっても画像の1ピクセル毎にかかる処理時間なのです。グリッド線にブレンドモードを指定しただけでかなり重くなったりもします。この辺りは元々用途が違うものを無理矢理使っているのですから仕方が無いところかもしれません。

2023-08-26 ,

Emacsの中で動く作図ツール 最近の変更点(2023年1月~8月)

Emacsの中で動く作図ツールですが、前回(2022年末)からの変更点をまとめました。

misohena/el-easydraw: Embedded drawing tool for Emacs

ちなみにインストールはpackage-vcやらstraightやらで出来るらしいです。私は普通にGitのサブモジュールとしてcloneしてload-pathを通しているだけです。

接着機能

図形(の中の点)を他の図形にくっつける(移動に追従させる)機能を追加しました。図形の間を線で結んだり(パスツールでCtrlを押しながら図形をクリック)、テキストを矩形などの中心に配置し(テキストツールでCtrlを押しながら図形をクリック)、移動してもその状態を維持し続けられます。

接着機能の使用例(注:矢印設定は現在は複数選択で一括で出来ます)
図1: 接着機能の使用例(注:矢印設定は現在は複数選択で一括で出来ます)

仕様はかなり悩みました。今のところ条件は限定されており、また、残っている問題も多いです。内部的には点接続という図形内のアンカーポイントなどの点を別の図形内の点に関連付ける仕組みで実現しています。接続関係を表すデータは、SVG内にdata属性として記録しています。コンテキストメニュー内にも接着関連のコマンドをいくつか追加しました。

変形機能の改善
  • transform属性を図形の座標に適用
  • グループの変形に対応
  • 変形方式設定を追加
  • グループ化解除時にtransform属性を子に適用
  • GUIで変形(C-t)

最低限の変形機能は出来たと思いますがまだまだ沢山の問題が残っています。

変形と一口に言っても何をどのように変えるのかはある程度選択の幅があります。図形の種類(SVG要素の種類)によっては出来ないこともあるので、そういうときにどうするかが難しいです。

変形コマンドの使用例
図2: 変形コマンドの使用例
別フレーム対応

プロパティエディタとシェイプピッカーは別フレームで表示できるようになりました。編集中にフレームにしたりウィンドウに戻したり柔軟に変更できます。メニューボタンやコンテキストメニューから操作できます。だだ、使ってみるとそれほど便利では無いなと思いました。それほど大きな図を描くわけではありませんし、フレームが開くのに少し時間がかかるというのもあるかもしれません。そもそも私はEmacsでフレームを使うことに慣れていません。

フレーム表示例
図3: フレーム表示例
カスタムシェイプにラベルを追加

ほとんど例としてでてすが、二種類ほど追加しておきました。すでにカスタムシェイプリストを編集してしまっているとリセットしないと反映されないと思います。

シェイプピッカーも色々直したいところがあります。とりあえず折りたたみ状態は保持したいところ。

手書きツールの改善
生成する点の数を大幅に削減しました。
複製機能

選択図形を複製するコマンドを追加しました。単にコピーしてペーストしてもいいのですが、Dキー一つでできます。

また、選択ツールにおいて、M-ドラッグで複製しつつ平行移動します。

M-矢印キーまたはM-S-矢印キーで複製しつつ平行移動します。S付きは10px単位で移動します。C-u 数値のプレフィックスを付けると数値のピクセル数だけ移動します。

S-ドラッグによる移動方向制限
シフトキーを押しながらドラッグする操作に対応しました。ツールによって意味は異なりますが、45度単位で移動することが多いです。
切り抜き機能
マウスで範囲を指定してドキュメント全体を切り抜く機能を追加しました。全体を平行移動してドキュメントのサイズを変更します。範囲外を自動的に削除したりは しません 。図を描いたら端が余ってしまったということが良くあるのでそういうときに使います。実は小さくするときだけでなく大きくしたいときにも使えます。
日本語化

current-language-environmentが "Japanese" の時は日本語で表示されます。 edraw-msg-file 変数で無効化できます。環境によっては文字化け等正しく表示されない場合もあります。その場合は環境のフォント設定等を見直すか、諦めて無効化してください。

日本語でメニューが表示されている様子
図4: 日本語でメニューが表示されている様子

元々全てのメッセージをedraw-msg関数で囲っていたのはこのためでした。Emacsはメッセージが多言語化されているところがほぼありません。見つかったのはチュートリアルくらいです。それがcurrent-language-environmentによって切り替わっているので、それにならいました。そもそもEmacsのdocstringには多言語に対応する仕組みが無いのは大いに不満ですね!(最低限言語を指定するメタデータがあって、ボタン一発で翻訳するとかどうだろう)

マーカーの改善

マーカー(パスに付ける矢印や丸印)の形状をある程度カスタマイズできるようにしました。プロパティエディタから変更したり、メインメニューや変数edraw-default-marker-propertiesでデフォルトを変更できます。

将来的には形状自体を増やせるようにしたいです。そのための下ごしらえも少ししました。

パスツールのM-クリック・ドラッグ操作
Alt+クリック・ドラッグでハンドルを確実にコントロールできます。ハンドルをM-ドラッグするとそのハンドルのみを移動します(反対側のハンドルは動きません)。アンカーをM-ドラッグするとそのアンカーの二つのハンドルを再作成します(スムーズ点になります)。アンカーをM-クリックするとそのアンカーの二つのハンドルを削除します(コーナー点になります)。いわゆる切り替えツールとほぼ同じです。
点の座標指定移動
パスのアンカーやハンドルのコンテキストメニューに「座標による移動コマンド」を追加しました。精密な操作が必要な場合に有用です。
座標の表示
色々な場面で座標やサイズをメッセージ出力するようにしました。
図形に対するコンテキストメニューの「設定」によく使うプロパティの変更を追加
image要素に対するhrefとtext要素に対するfont-sizeを追加しました。
テキストツールの既存テキストクリック操作

これまでクリックは単に新しくテキストを追加するだけでしたが、既存のテキストをクリックした場合はそのテキストの文字列を(ミニバッファで)入力するようにしました。これまでプロパティエディタを開いて変更していたのですが、やっぱりその方が便利かなと思いまして。既存テキストの近くに新しいテキストを追加したい場合はC-uプレフィックスを入力してからクリックしてください。強制的に追加になります。

テキストまわりはもっと沢山の設定項目が必要です。

ツールヘルプの表示
ツールの操作は気が付きにくいものが多いので、ツール切り替え時に簡単なガイドを表示するようにしました。
選択ツールのC-ドラッグ操作
Ctrl+ドラッグで範囲と重なる図形を選択、選択解除します。
複数選択図形一括操作
複数の選択図形をプロパティエディタで変更できるようにしました。また、コンテキストメニューの「設定」でも一度にプロパティ値を変更できるようにしました。
ビューサイズの改善
表示領域自動拡大の改善
ズーム時の表示領域自動拡大の上限をウィンドウサイズに対する比率で指定出来ようにしました(edraw-editor-auto-view-enlargement-max-size変数参照)。デフォルトは幅約94%、高さ約63%に設定されています。あまり大きくすると環境によっては不安定になりそうで心配しています。
edraw-set-view-size-specの単純化
ビューのサイズ指定は、単純に高さと幅を数値で指定するだけになりました。これにより誤入力を減らせます。指定の解除はビューのリセットコマンドを使用してください。

困ったら 0 や v 0 を押してください。元に戻ります。

本当はドラッグでビューサイズを変えられると良いんですけどね。右下につまみを表示しなければなりません。

キー割り当ての追加
  • 選択図形に対する操作
    • g : グループ化
    • G : グループ化解除
    • D : 複製
    • p f : fillを変更
    • p s : strokeを変更
    • p p または M-RET: プロパティエディタを開く
    • M-矢印キー または M-S-矢印キー または C-u N M-矢印キー : 複製後移動
    • TAB : 次の図形(M-]と同じ)
    • S-TAB : 前の図形(M-[と同じ)
    • C-t : インタラクティブ変形
  • i : 画像ツール
  • dvb : svg要素のviewBox属性を変更
カスタマイズ変数の追加
edraw-editor-image-scaling-factor
大きさの微調整をします。ノートPCで少し小さいと感じたので追加しました。Emacs自体が(create-image関数が)自動スケーリング機能を持っているのですがギリギリそれが働かない解像度だったようで、それとは別に用意しました。
edraw-editor-default-tool
起動したときに選択するツールです。これまでは矩形ツールだったのですが、選択ツールの方がいいかなと思ったので変更できるようにしました。
edraw-org-link-image-max-size variable
org-mode上でインライン画像表示するときの最大サイズを設定できるようにしました。ウィンドウからはみ出すのを防止できます。
SVGファイル・データ内のコメントを可能な限り維持
SVGファイルやデータ内にあるコメントを可能な限り維持するようにしました。 <!-- -*- mode: edraw -*- --> というヘッダーコメントや任意のフッターコメントを入れることを想定しています。svg要素内にあるコメントは図形の前後関係など、動作に支障を来す可能性があります。
カラーピッカーの改善
  • 最近使った色の保存
  • 最近使った色をキーで選択(C-1, C-2, ..., C-0)
  • ドラッグ時にピッカーの外に出たときの挙動を改善(境界線上の色を指定しやすくする)
  • 色テキストを追加・置換するコマンド(カラーピッカー単独での利用)の改善
    • 子フレーム対応
    • set-transient-mapによる安定したキー操作
    • edraw-color-picker-replace-or-insert-color-at-pointコマンドを追加
    • css-modeやmhtml-modeでの設定例を追加

カラーピッカーのedraw-editor以外からの利用(応用)まではなかなか手が回らずいくつか放置されていた問題がありましたが、修正したので大分使いやすくなったと思います。私は先日書いたような設定でcss等の色が書いてある部分をいつでもカラーピッカーで変更できるようになりました。他の色形式に対応したり、元の書き方を出来るだけ変えないようにする等まだ改善点は残っています。それと子フレームは環境によっては正しく動かない可能性があるので心配しています。一応子フレームを使わないようにするカスタマイズ変数もあります。

カラーピッカー自体には、後は固定のパレットの追加と他の表色系への対応を考えています。

web-modeでカラーピッカーを使っている様子
図5: web-modeでカラーピッカーを使っている様子
edrawコマンド
edraw-mode.elにedrawコマンドを追加しました。M-x edrawで新しいバッファを作成してedraw-modeを立ち上げるだけのシンプルなものです。素早く新しい図を作成したい場合に有用です。名前を付けて保存するにはC-x C-sやC-x C-wでOKですが、その時の拡張子やauto-mode-alistの設定等によってはedraw-modeが解除されてしまうのでその際は再度M-x edraw-modeしてください。
edraw-modeの改善

単体の.edraw.svgファイル(edraw-modeバッファ)を編集する際に支障がある問題を改善しました。

  • バッファが空の場合に表示されないバグを修正
  • ファイル保存時にUTF-8を強制
  • テキストを編集できてしまうバグを修正
  • (テキスト)カーソルの非表示
  • 他のモード(xml-mode等)との確実な切り替えを確認
  • メインメニューの「保存」を単にsave-bufferコマンド(C-x C-s)へ変更
  • メインメニューにxml-modeへの切り替えを追加(単にxml-modeを呼び出すだけ)

org-modeからの利用ばかり考えていて、長らくこちらはおろそかになっていました。ちょっと試す分にはedraw-modeの方が速い気がしたので手を付けました。

README
  • org-modeの非同期エクスポートを有効にしている場合の設定方法を追加
  • org-modeの通常のファイルリンクで使う方法を追加
  • SVGファイル内のコメントやmagic-mode-alistでedraw-modeを使う方法を追加(.edraw.svgという長い拡張子を使わない方法)
バグ修正
一部の環境でエディタが表示されない
librsvgのバージョンによってセーブして再び開くとエディタが表示されない不具合がありました。svg要素のxmlnsが消えてしまうのが原因でした。新しめのlibrsvgはxmlnsを厳格に解釈するようなので、その影響かもしれません。それに伴いimage要素ではhrefではなくxlink:href属性を使用するようにしました。
画像ツールのファイル名入力を改善

Macで画像ファイル名の拡張子が入力されない不具合を修正しました。

また、画像は参照元のファイルがあるディレクトリかそのサブディレクトリにあるものしか表示できません。これはlibrsvgがセキュリティ上課している制限です。

マウスカーソルのちらつきを改善
マウスカーソルが画面が更新されるたびに一瞬だけ別の形状に変わるのを出来るだけ抑制しました。

その他沢山の細かい修正があります。

2023-08-25 ,

Emacsのcss-modeやcustomize-face等でカラーピッカーを使う設定

以前(と言ってももうずいぶん前になりますが)Emacsで動くSVG実装のカラーピッカーを作りましたが、少し整えてからcss-modeやカスタマイズ機構で使うための設定を用意しました。作図エディタ本体の改良で忙しくカラーピッカー単体での利用の方はおろそかになっていました。ようやく手を付けられたので色々いじっているところです。

2023-08-25-color-picker.png

まず次のelispを導入します。

misohena/el-easydraw: Embedded drawing tool for Emacs

私は自分のemacs設定ディレクトリのサブモジュールになっていますが、package-vcやらstraightやらでも入れられるそうです。その辺り詳しいことは知りません。別にload-pathの通ったところに全部置いておけば済む話です。

それで、css-modeやmhtml-modeやらで使うには例えば次のようにします。

;; この辺りはパッケージ管理システムを使っていると自動的に作られているかも。
;; 一応;;;###autoload指定は入れてあるので。
(autoload 'edraw-color-picker-replace-color-at "edraw-color-picker" nil t)
(autoload 'edraw-color-picker-replace-or-insert-color-at-point "edraw-color-picker" nil t)

;; お好みでキー割り当て。
(defun my-edraw-color-picker-add-keys (map)
  ;; マウスのクリックでそこにある色名を置換。
  (define-key map [mouse-1] #'edraw-color-picker-replace-color-at)
  ;; C-c C-oでそこに色名があれば置換、無ければ挿入。
  (define-key map (kbd "C-c C-o")
              #'edraw-color-picker-replace-or-insert-color-at-point))

;; local-mapにキーを設定する関数。
(defun my-edraw-color-picker-enable ()
  (my-edraw-color-picker-add-keys (or (current-local-map)
                                      (let ((map (make-sparse-keymap)))
                                        (use-local-map map)
                                        map))))

;; お好みのモードにキー設定を追加。
(add-hook 'css-mode-hook 'my-edraw-color-picker-enable)
(add-hook 'mhtml-mode-hook 'my-edraw-color-picker-enable)
(add-hook 'web-mode-hook 'my-edraw-color-picker-enable)

EmacsのCustomize用のバッファ(customize-faceとか)で使うには次のようにします。

;; Customize用のバッファではEmacsの色名を使う。
(defun my-edraw-color-picker-enable-for-custom-mode ()
  (setq-local edraw-color-picker-insert-default-color-scheme 'emacs))
(add-hook 'Custom-mode-hook 'my-edraw-color-picker-enable-for-custom-mode)

;; フィールドのキーマップにキー設定を追加。
;; local-mapに設定するとフィールド上では効かないので。
(with-eval-after-load "cus-edit"
  (my-edraw-color-picker-add-keys custom-field-keymap))

カラーピッカーは現在デフォルトでは子フレームで表示されるようになっていますが、環境によっては正しく表示されないかもしれません。その場合は (setq edraw-color-picker-use-frame-p nil) にするとオーバーレイを使った表示になります。それはそれで無理矢理行と行の間に差し込むのでレイアウトが崩れることもあるかもしれませんが。

カラーピッカーの大きさは edraw-color-picker-near-point-scale で変えられます。デフォルトは0.75です。

無理にポイントの近くに表示しなくても (edraw-color-picker-read-color) でミニバッファから入力した方が使いやすいような気もしますがどうでしょうね……。

今後の改良点としては:

  • 他の表色系に対応
  • 置換前の表記に出来るだけ合わせる
  • 現在値の表示

辺りでしょうか。

その前に作図エディタ側からの必要性で固定パレットが入ると思います。

基本作図エディタ本体が優先なのでいつになるかは分かりませんが、そのうち。

2023-08-18

before-stringに別のオーバーレイのfaceが適用されない

before-stringプロパティを持つオーバーレイ(ov1)があったとします。そのオーバーレイ(ov1)を囲むように別のオーバーレイ(ov2)もあったとします。その別のオーバーレイ(ov2)がfaceプロパティを持っていた場合、そのfaceはov1のbefore-stringに影響するでしょうか。

[OV1BEFORE][OV1TEXT] OV2TEXT][OV2TEXT ov1の範囲ov2の範囲ov1のbefore-stringによって生成された部分青くハイライトするfaceが設定されている
図1: 二つのオーバーレイが重なる様子

色々試してみたのですが、なかなか影響させる方法が見つかりませんでした。

ov1のbefore-stringはov1が囲んでいるテキストの最初の文字のfaceテキストプロパティのみに影響を受けるようです(もちろんbefore-string自体にテキストプロパティが付いている場合は別です)。

これはtransient-mark-modeやhl-line-modeを使ってbefore-stringを持つオーバーレイを囲ってみればよく分かります。before-stringの部分だけハイライトされません。

Emacs Lispで再現するコードは次のようになります。

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

結果は次のようになります。

before-stringに他のオーバーレイのfaceプロパティが適用されない様子
図2: before-stringに他のオーバーレイのfaceプロパティが適用されない様子

色々変えて試してみました。

  • priorityプロパティを色々指定してみても変わりません。
  • ov2の範囲を色々変えても変わりません。
  • after-stringもbefore-stringと同様に影響を受けません。
  • [OV1TEXT]の先頭文字([)にfaceテキストプロパティ(実際にはfont-lock-face)を付けると、before-stringにはそのfaceが適用されます。つまり (put-text-property (+ beg 9) (+ beg 10) 'font-lock-face '(:background "red")) のように。これは回避策には利用できそうですがov2のfaceが適用されているわけではありません。ちなみにafter-stringは[OV1TEXT]の最後の文字……ではなく、その次の文字に設定したfaceが適用されます。
  • displayプロパティで表示した文字列([OV1TEXT]を置き換える)は影響を受けます。

displayプロパティは影響を受ける。その事実を知ったとき、私にはあるアイデアが浮かびました。before-stringにdisplayテキストプロパティを付けたらどうなるんだろう。つまり次のようにするわけです。

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

結果は何と……

before-stringに他のオーバーレイのfaceプロパティが適用されている様子
図3: before-stringに他のオーバーレイのfaceプロパティが適用されている様子

ちゃんと適用されました!

これらは一体どう解釈すれば良いのでしょうか。

まずbefore-stringに他のオーバーレイのfaceが適用されないのはバグでしょうか、意図した仕様でしょうか、それとも単に未定義動作(どうなっても文句は言えない)なだけでしょうか。前述したとおりtransient-mark-modeで範囲選択すればすぐに分かるので誰も気が付かないと言うことは無いと思うんですよね。さりとてこの挙動に何かメリットがあるのかと問われればあまり思いつきません。

一方before-stringのdisplayには効くというのはどうなのでしょうか。この挙動に頼って良いものなのでしょうか。

GNUのサイトに行ってバグトラッカーとメールのアーカイブを何度か行ったり来たりした後、嫌になって探すのを諦めました。

個人的にはどちらにも適用されるのが自然な挙動のように感じます。

今回の問題が気になったきっかけは、dired-details-rでhl-line-modeが正しく機能しなかったことです。dired-details-rでは、行末の"\n"部分にオーバーレイをかけてbefore-stringでファイルの詳細情報を表示しています1。なので、ファイルの詳細情報の部分は一切ハイライトされません。これでは現在の行をハイライトする意味がありません。

dired-details-rでhl-line-modeが正しく機能しない様子
図4: dired-details-rでhl-line-modeが正しく機能しない様子

すでに色々回避策を適用してしまったのですが、もしbefore-stringのdisplayに頼って良いのならもっとシンプルで安定したコードに出来そうです。

いやはや、Emacsのテキスト&オーバーレイプロパティまわりは何とも複雑ですね。

(追記:dired-details-rでhl-line-modeが正しく機能しない件は解決しました! ちなみにこのテクニックはall-the-icons-dired(私は色々独自に手を入れて使っています)でも有効です。あれはafter-stringでアイコンを挿入するので、そのままではhl-line-modeでアイコン部分がハイライトされません)

hl-line-modeが完全に機能するようになった様子
図5: hl-line-modeが完全に機能するようになった様子

脚注:

1

その辺りの経緯については以前に書いたと思います。たぶんEmacsでdisplayプロパティを使って改行を置き換えると非常に遅くなる件のあたり

2023-08-17

image-diredにサムネイル画像関連フックを追加する

もっと……もっとフックを……、フックが欲しいのじゃ!

私はdired-details-rを使ってファイルの詳細情報をファイル名の右側に表示していますが、image-diredでファイル名の前にサムネイルを追加すると表示がずれることがあります。

少し前の改良でファイル名の前にあるアイコンやらサムネイルやらの幅を考慮することは出来たのですが、それはdiredがディレクトリを読み込んだ直後の話。その後でサムネイルの状態に何か変化があると、やはりずれてしまいます。

典型的なのは、サムネイルの表示・非表示を切り替える操作をした場合。 image-dired-dired-toggle-marked-thumbs コマンド(C-t C-tで選択した画像のサムネイルをトグル)や私の改造だと my-image-dired-dired-show-all-thumbs コマンド(C-t C-aで全画像のサムネイルを表示)あたりの操作です。表示すれば詳細が右にずれますし、整えてから消せば左にずれます。

もう一つはサムネイル画像を生成し終わったとき。新しくサムネイルを生成するときは、ひとまず無効な画像(30ピクセル四方の正方形です)を表示させておいて、生成が終わったら更新するようにimage-diredは出来ています。問題はこれが非同期であるという点です(もちろん長時間待たされないという意味では良い点です)。サムネイルを生成するための外部プロセス(ImageMagickやらGraphicsMagickやら)が終了したらclear-image-cacheを実行することで画像を表示するオーバーレイが更新されます。その時に詳細情報が右にずれます。非同期なのでそのタイミングは予測できません。

というわけで次図のような画面が出来上がるわけです。

詳細情報が右にずれたdiredバッファ
図1: 詳細情報が右にずれたdiredバッファ

もちろんgを押せばすぐに揃うのですが、面倒くさいせいかなぜか押さないことも多いです。するとずれた部分が時々目の中にチラチラ入ってきて何だか気分が悪いです。

それに何だかみっともないじゃないですか。こうやってずれたスクリーンショットを気が付かずに出してしまうこともあります(実際に最近の記事の中にあります!)。こんなに好き勝手に改造して自己満足に浸っているくせにズレてるのかよ! みたいな。

というわけで直すことにしたのでした。

これを直すには、diredバッファへサムネイルのオーバーレイを挿入した後とサムネイル画像の生成が終わった後に、見た目を更新する処理を挟む必要があります。しかしそのようなタイミングで呼び出してくれる便利なフックはもちろん存在しません。フック……もっとフックを! と思うことはEmacsではいつものことです。というわけで、そのフック(それらのタイミングで任意の関数を呼び出す仕組み)をimage-diredに追加してみます。

まずはサムネイルを表示・消去した直後に呼び出すフック。diredバッファにサムネイルを表示するオーバーレイを挿入するのはimage-dired-dired.el内のimage-dired-dired-toggle-marked-thumbsコマンドです(Emacs 29.1時点)。その中身は次の通り。

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

この関数の (if thumb-ov (overlay-put overlay 'thumb-file thumb-file)) の後くらいに処理を挟みたいわけです。この関数はトグル動作なので、表示するときと消去するときの両方で通るところに挟むのが良いでしょう。しかしそこに処理を挟むのは困難です。

それ以前に、私はこの前の改造でこの関数をバラしてサムネイルの前後の余白を調整したところでした。

なので、その改造後の関数に手を入れてフック機能を追加してしまいましょう。以下★印の所三箇所を追加しました。

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

こうしておくことで、一つのサムネイルが表示・非表示されるたびに任意の処理を挟むことが出来ます。そこでレイアウトを整えてやろうというわけです。

次にサムネイル画像の生成が終わったとき。画像の生成はimage-dired-external.el内のimage-dired-create-thumb-1関数で行っています。内容を見てみましょう。

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

この関数は引数にoriginal-fileとthumbnail-fileを取ります。分かりやすいですね。

start-processで外部プロセスを起動しています。

その直後にプロセスオブジェクトのsentinelとしてlambda関数を設定することでプロセスの終了を検出しています。sentinelはプロセスの状態が変わったときに呼び出されます。

問題なのはこれがlambda、つまり匿名の関数だということ。この関数にadviceを追加して処理を追加するようなマネはできません。

しかしその後を見ると、このimage-dired-create-thumb-1はプロセスオブジェクトを返却しています。やった! ラッキー!! プロセスオブジェクトが得られるなら、そのsentinelを書き替えることが出来ます。次のように。

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

つまり、image-dired-create-thumb-1が設定した元のsentinelをとっておいて、独自の関数にsentinelを書き替えてしまい、その独自の関数は元のsentinelを呼び出してから追加の処理をするわけです。

こういう横取りの仕方を見ると私はよく割り込みベクタのフックを思い出します。MS-DOSで常駐プログラム書いたり、システムコールをフックして処理を挟んでみたり。やってることは昔と変わらないなー。

というわけでこれで処理を挟む準備は整いました。後は次のようにすればdired-details-rがレイアウトを整えてくれます。

;; サムネイル画像を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)

画像生成後の方は、いつ呼び出されるのか予測が出来ないので少し込み入っています。