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

前回の続き。

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

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

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

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

やりたいことに一番近いのは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-create 、 convert-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-createやwidget-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")))))

図3: defcustomでedraw-attribute-alistを使ってみたときの見た目

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

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