2024-02-15

Corfuの自動補完で候補の存在を伝える事と候補を選べるようにする事を分離する

前回の続き。

私が自動補完が煩わしいなと思う所は、補完候補が表示されると同時ににいくらかのキー割り当てが(候補選択のために)変更されてしまい、それが誤操作を誘発する点です。それはorg-modeの表で何かを入力した後にTABや矢印キーを押して別のセルへ移動しようとしたときかもしれません。はたまた普通の場所でどこかの行を修正して、下の行に移動し、RETを押して改行を追加しようとしたときかもしれません。そういったときに、突然出現した自動補完にキーを奪われ意図せず補完候補を選んでしまうわけです。

一方でそれでも自動補完が欲しいと思う所は、補完候補の存在に気が付かせてくれる点です。C-M-iで手動で補完候補を出すことも出来ますが、それはそこで補完できることを知っていないとできません。

自動補完は、候補の自動的な表示とユーザーの選択によって機能します。前者は欲しいのに後者は鬱陶しい。となればそれらを分離すれば良いと考えるのは自然でしょう。

つまり次のようになってくれれば良いわけです。

  1. 補完候補を見つけたらそれを自動でポップアップ表示する(しかし一切のキーを奪わず、候補の選択操作は出来ない)
  2. その状態で明示的にC-M-iを押すと候補の選択が出来るようになる(同時に最初の候補が選択されるもしくは唯一ある候補が入力される)

次のコードで出来ます。

(defvar-keymap my-corfu-auto-map
  :doc "Keymap used when popup is shown automatically."
  "C-g" #'corfu-quit)

(defvar my-corfu-in-auto-complete nil)

(defun my-corfu--auto-complete-deferred:around (oldfun &rest args)
  ;; 自動補完を試みるときに呼び出される
  (let ((my-corfu-in-auto-complete t))
    ;; 元の関数を呼び出す
    ;; 補完候補があるなら続けてsetup等が呼ばれる
    (apply oldfun args)))

(advice-add 'corfu--auto-complete-deferred :around #'my-corfu--auto-complete-deferred:around)

(defun my-corfu--setup:around (oldfun &rest args)
  (if my-corfu-in-auto-complete
      ;; 自動補完の時
      (progn
        (setf
         ;; 子フレームを半透明にする
         (alist-get 'alpha corfu--frame-parameters) 90
         ;; C-M-iを押せと表示する (2024-02-16追記) (2024-02-17修正: やっぱりtabではなくheaderを使う)(2024-02-18修正: やっぱりtabを使う。色が目立つから)
         (alist-get 'tab-line-format corfu--buffer-parameters) "   C-M-i:補完"
         ;; 最初の候補を選ばない
         corfu-preselect 'prompt)
        (let (;; キー割り当てを極力無くす
              (corfu-map my-corfu-auto-map))
          (apply oldfun args)))
    ;; 手動補完の時
    (setf
     ;; 子フレームを完全不透明にする
     (alist-get 'alpha corfu--frame-parameters) 100
     ;; C-M-iを押せと表示しない (2024-02-16追記) (2024-02-17修正: やっぱりtabではなくheaderを使う)(2024-02-18修正: やっぱりtabを使う。色が目立つから)
     (alist-get 'tab-line-format corfu--buffer-parameters) nil
     ;; 最初の候補を選ぶ
     corfu-preselect 'first)
    (apply oldfun args)))

(advice-add 'corfu--setup :around #'my-corfu--setup:around)

;; tab-line-heightを考慮して高さを増やす(2024-02-17追記)
(defun my-corfu--make-frame:around (oldfun frame x y width height buffer)
  (when (alist-get 'tab-line-format corfu--buffer-parameters)
    (cl-incf height (window-tab-line-height (frame-root-window frame))))
  (funcall oldfun frame x y width height buffer))

(advice-add 'corfu--make-frame :around #'my-corfu--make-frame:around)

補完候補が出ているときのキーマップは通常corfu-mapですが、自動補完の時にだけ使われるmy-corfu-auto-mapを定義しました。ポップアップを消すためのC-gだけ残して他のキー割り当てを全て取り除いています。これでもはや移動キーやTAB、RETを奪われることはありません。

Corfuのポップアップは基本的にcorfu--setupで始まりcorfu--teardownで終わるようです。自動補完の場合はcorfu--auto-complete-deferred経由でcorfu--setupが呼ばれるので、そのタイミングで各種変数を書き替えています。

選択操作ができない状態の時はポップアップを半透明で表示するようにしてみましたが、選択状態で分かるので特段必要では無かったかもしれません。「候補選択:C-M-i」などと一覧の一番下(上?)に表示すればより親切かもしれません(2024-02-16追記:そうしました)。

実際に使ってみると、最初は少し戸惑いますが慣れれば悪くないのかなとも思います。候補が出てるとこれまでの癖でついC-nを押してしまうというのはあるのですが……。しばらく使ってみないとよく分かりません。

(自動補完時に)候補を減らすのはもはや必要ないかもしれません。頻繁に候補を出されたところでキーが奪われるわけではありませんし。まぁ、ポップアップの表示自体が邪魔(視覚が奪われる)ということはあるかもしれませんが。その辺りも今後の調整ということで。

自動的に出現した補完候補(この時点でC-g以外のキーは通常通りの動作)
図1: 自動的に出現した補完候補(この時点でC-g以外のキーは通常通りの動作)
C-M-iを押して補完を開始したところ(この時点から候補選択等のキー操作ができる)
図2: C-M-iを押して補完を開始したところ(この時点から候補選択等のキー操作ができる)

(追記: 以前書いた設定corfu-mapのRETキーに独自の my-corfu-insert-or-newline という名前のコマンドを割り当てていましたが、正しくは corfu-my-insert-or-newline とすべきでした。C-M-iで手動補完を実行した後に素早くRETを押すと最初の補完候補が選ばれず単に改行されてしまっていました。なぜかというと、コマンド名がcorfu-で始まるかでupdateするかを判断している部分があったからです。なんてこった!)

(2024-02-18追記: 以前書いた設定はcorfu-mapを自動補完の時にも使うことが前提でしたが、今回の改良でcorfu-mapは手動補完専用になったので、設定を次のように書き替えました)

(with-eval-after-load "corfu"
  ;; 上の自動補完時にキーを奪わない設定が前提。
  ;; https://misohena.jp/blog/2024-02-15-separate-notification-and-selection-with-corfu-auto.html
  ;; 他にもorg-mode時に #+ や [[ で自動補完を開始する設定もしている。
  ;; https://misohena.jp/blog/2024-02-16-completion-in-org-mode.html

  ;; 候補リストの最初と最後を行き来できるようにする。
  (setq corfu-cycle t)
  ;; 自動的に補完候補を出す。
  (setq corfu-auto t)

  ;; 特殊な文字は決定と同時に挿入する。
  ;; https://github.com/minad/corfu/wiki#tab-and-go-completion が近い。
  ;; 特殊な文字はモードによって変わってくる。C++なら:や(も同様に処理したいだろう。
  ;; lispなら関数名の後にスペースや)で決定したい。他にも;とかも?
  (defun corfu-my-insert-RET () ;; corfu-で始まるかで動作が変わるところがある。 (savex C-M-i RETと素早く押したときに、RETがcorfu-で始まるコマンドだとupdateが走り正常に動作するが、my-corfu-だとそうならない。
    (interactive)
    (corfu-insert)
    (call-interactively 'newline));; インタラクティブじゃないとインデントされなかったりする。
  (defun corfu-my-insert-self ()
    (interactive)
    (let ((ch last-command-event))
      (when (characterp ch)
        ;; (2024-03-03追記:その文字を含んだ候補があるなら補完を終了しないようにした)
        (when (and (>= corfu--index 0)
                   (not (seq-some (lambda (str) (seq-contains-p str ch))
                                  corfu--candidates)))
          (corfu-insert))
        (insert-char ch))))
  (define-key corfu-map (kbd "RET") 'corfu-my-insert-RET)
  (define-key corfu-map (kbd "SPC") #'corfu-my-insert-self)
  (define-key corfu-map (kbd ")") #'corfu-my-insert-self)
  (define-key corfu-map (kbd "]") #'corfu-my-insert-self)
  (define-key corfu-map (kbd "}") #'corfu-my-insert-self)

  ;; その他手動補完時のキー設定
  (define-key corfu-map (kbd "M-TAB") #'corfu-complete) ;;M-TABをTABと同じにすることでM-TAB二回(C-M-i二回)で一つ目の候補を選択出来るようになる。C-M-i C-iと押すより楽
  )

  ;; Corfuの候補リストにアイコンを表示する。
  (when (locate-library "kind-icon")
    (setq kind-icon-default-face 'corfu-default)
    (add-to-list 'corfu-margin-formatters #'kind-icon-margin-formatter))

  ;; lsp-modeの設定はeglotへ移行して使わなくなったので削除。
  )
2024-02-14

Corfuの自動補完と手動補完で補完スタイルを変える方法

そもそも補完スタイルとは何かについてはマニュアルを参照するのが手っ取り早いでしょう(Completion Styles (GNU Emacs Manual)(日本語訳)。簡単に言えば先頭一致とか部分一致とか曖昧一致とかそういうのです。入力したテキストと補完候補が一致していることをどのように判定するかのルールです。例えば basic はほぼ先頭一致ですがカーソル(ポイント)を左に移動したときの挙動が追加されています(純粋な先頭一致は emacs21emacs22)。 substring はほぼ部分一致です。 flex は含まれている文字が順番に登場すれば一致と見なします。このようなルールを変数completion-stylesで指定します。複数指定出来るのは、マッチする候補があるスタイルを順に探していく仕組みになっているからです。

それで以前Corfuを導入したときに、私は自動補完と手動補完で補完候補のソースを変える設定をしました。

companyからcorfuへ移行~自動と手動で補完候補を変える | Misohena Blog

これは自動補完の時に確度の低い候補が出てきてキー入力を奪ってしまうことを回避するのが目的でした。自動補完の時は補完候補の大本を確度の高い物だけに限定してしまおうということです。

しかしそれだけでは不十分で、補完スタイル、つまり補完候補と入力テキストとのマッチング方法によっても実際に出現する候補は変わってきます。例えば補完スタイルにflexなどを指定してしまうと、非常に多くの補完候補とマッチングしてしまい、自動補完のポップアップが頻繁に出現することになりかねません。かといって、手動で補完するときはより沢山候補を出してほしい場合もあるでしょう。自動と手動で補完スタイルを切り替えたいのは当然ではないでしょうか。

というわけで、それを行うコードは次のようになります。

(defun my-corfu--auto-complete-deferred--change-completion-styles (old-fun &rest args)
  ;; corfu-autoの作用で補完候補を出すときに呼び出される
  (let (;; 自動補完の時に使う補完スタイル
        (completion-styles '(basic)))
    ;; 元の処理
    (apply old-fun args)))

(advice-add 'corfu--auto-complete-deferred :around #'my-corfu--auto-complete-deferred--change-completion-styles)

corfu--auto-complete-deferredは自動補完時にのみ呼び出される関数です。そこで一時的にcompletion-stylesをbasicのみにしてしまうと、入力したテキストと先頭一致する候補しか出てこなくなります。

これでひとまず目的は達成できたのですが、結局不意に現れた自動補完ポップアップによって誤操作してしまうという問題は相変わらず完全には解決できていません。自動補完で出す候補を少なくすることは確かに誤操作をする機会を減らしますが、一方で補完できる機会も減らしてしまいます。

そもそも自動補完というのは何が良いのでしょうか。別に補完がしたければ明示的にC-M-iと押せば補完できるのですからそれで良いはずです。しかしそれは補完できることをあらかじめ知っていなければできません。自動補完の良い所は、ユーザーが「こんな補完ができるのか」と気がつけるところにあるのです。そう考えたときに、別の方法を思いつきました。

(続く)

2024-02-05 ,

org-modeにEmacs Lisp要素へのリンクタイプを追加する(org-elisp-link.el)

以前「Emacs Lisp要素へのorg-modeリンクをエクスポートする」や「Emacs Lisp要素へのリンクをorg-modeに追加する」という記事を書きましたが、そこで書いた物を org-elisp-link.el として一つのEmacs Lispにまとめました。

misohena/org-elisp-link: Org-mode Link Types for Emacs Lisp Elements

同様の事をやるEmacs Lispはいくつか見かけましたが、エクスポートまでするのは見つかりませんでした。org-modeのリンクタイプはエクスポートを実装していないものが多い気がします。もちろんEmacs内での作業に役に立てばほとんどの場合それで十分なのですが、たまにエクスポートすると「あれ?」と思うことがあります。

Emacs Lispの言語要素(関数、変数、フェイス、ライブラリ)へのリンクをエクスポートしたいなんて人はそう多くは無いでしょう。誰得? オレだよオレ、俺得。私はこのブログで関数名や変数名を書くことがありますし、自分で見返したときにいちいちEmacsで定義を見に行くよりもブラウザでソースコードへ飛べた方が便利なケースもあります(常にとは言わない)。

READMEにも書きましたが、このEmacs Lispを使うと次のような記述が可能になります。

[[elisp-function:track-mouse]]関数は[[elisp-library:subr;line=4530][subr.elの4530行目]]に定義されています。[[elisp-variable:track-mouse]]という変数も別に定義されています。[[elisp-function:track-mouse]]関数は例えば[[elisp-function:artist-mouse-draw-continously;library=artist]]で使われています。

もちろんC-c C-o (org-open-at-point)で飛べますし、C-c l (org-store-link)でのリンクストア操作にも対応しています。

エクスポートについては以前「Emacs Lisp要素へのorg-modeリンクをエクスポートする」に書いたとおり、現在インストールされているソースコードの中からファイル名と行番号を探し、それに対応するWeb上のコードブラウザへのURLを作成しています。実際に上をエクスポートすると下のようになります。

<p>
<code><a href="https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/subr.el?h=emacs-29.2#n4530">track-mouse</a></code>関数は<a href="https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/subr.el?h=emacs-29.2#n4530">subr.elの4530行目</a>に定義されています。<code><a href="https://git.savannah.gnu.org/cgit/emacs.git/tree/src/keyboard.c?h=emacs-29.2#n12850">track-mouse</a></code>という変数も別に定義されています。<code><a href="https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/subr.el?h=emacs-29.2#n4530">track-mouse</a></code>関数は例えば<code><a href="https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/textmodes/artist.el?h=emacs-29.2#n4899">artist-mouse-draw-continously</a></code>で使われています。
</p>

以前書いたEmacsをアップグレードしたときにエクスポート結果が変わってしまう問題に対処するため、いくつかオプションを指定出来るようにしました。

[[elisp-function:tetris-start-game;line=600;library=tetris;emacs-version=29.2][Emacs 29.2におけるtetris.el内の600行目にあるtetris-start-game関数]]

このように書けばEmacs 29.2におけるtetris.el内の600行目を指すURLが必ずエクスポートされます。まぁ、常にこのような記述をすべきだとは思いませんけど。

リンクのdescription部分を書いていないときに見た目が酷いことになるので、 :activate-function を使って、シンボル名以外の部分を隠す機能も用意しておきました。前から [[elisp-function:track-mouse]] と書くと elisp-function: の部分が邪魔だなぁと思っていたのでした。もちろんdescription部分も含めて [[elisp-function:track-mouse][track-mouse]] と書けば良いのですが、情報が重複してて嫌だなぁと思っていたのでした。

その他README.org(日本語)に色々説明を書いたので詳しくはそちらで。

以下メモ:

;や&を含む関数名は存在する(c-forward-to-nth-EOF-;-or-}c-semi&comma-inside-parenlist)。もちろん<は>はある(string<とか)。\を含むものは見当たらない。ちゃんとエスケープできるようにした。

org-link-parameters:activate-func は使い方が難しいのだけど(特に効果を打ち消す方。変更フックでは検出できないケースもあるので)、すでに隠している部分を少し広げるくらいなら問題ないと思う。

find-funcライブラリの中身を見てEmacsが各種定義場所を探すときに何をしているのか色々勉強になった。もうちょっと直交性がある感じで綺麗に書いて欲しい。関数がnilで変数がdefvarでフェイスがdeffaceとか終始そんな感じ。いや、そもそもライブラリ名がfind-funcだった。

find-function-regexp-alistが興味深い。その正規表現(find-function-regexpとか)を見ると、思っていたより色々関数や変数等を定義する書式があることが分かる。ただ、この正規表現は%s部分に名前を入れて関数や変数等の定義を探すためのものなので、今回の用途に直接使うのは難しい。

結構頑張ってdefcustomを沢山用意した。

先日Emacs Widget Libraryの勉強をしたのでdefcustomの:type部分を書くのがとても楽になった。

バッファ内オプション( #+HTML_LINK_???? みたいの)の処理とテンプレート文字列( <a href="{{{URL}}}">{{{CONTENTS}}}</a> みたいなの)の処理は以前org-geolinkを作ったときのものがわりとよく出来ていたのでそのまま持ってきた。バッファ内オプションを増やす方法はもうちょっとマシな方法がないのだろうか。それほどちゃんと調べていないのでよく分からない。

ELPAのURL変換はもうちょっと何とかならないだろうか。それと私はEmacs設定ディレクトリ(Gitで管理している)のsubmoduleにしているものも多いので(自分の作ったものは特に)、それを検出してGitHubへのURLを生成したい。

elisp-functionとelisp-funのどちらがいいか。elfunというのもあり? elvar、elface、ellib。

2024-01-31

Emacsでdiffの文字化けを回避する(様々な文字エンコーディングに対応する)

何だか時代錯誤感のあるタイトルで申し訳ないのですが、私は長年Emacsを使っていてもdiffやらgrepやら基本的なコマンドの使い方が分かっていない人間なのです。ご容赦ください。grepの方は最近はripgrepの登場で大分マシになりましたが。いや、そうじゃ無くて、2024年にもなって文字化けなどと書かねばならないというところですよ!

日常的に複数の文字エンコーディング(文字符号化方式、簡単に言えば文字コード、Emacs用語ではコーディングシステム)を使っている人はdiffをどうしているのでしょうか。まぁ、使う文字エンコーディングが一つに偏っているならそれに合わせて残りは場当たり的に対処すれば良いのでしょう。私もそうしていました。UTF-8以外使うな! などと過激なことを言う方も昨今いらっしゃいますが、私はそうは思いません。長年コンピュータを使ってきた人間にとって、過去に作った物を無かったことには出来ませんからね。

とは言えdiffを取ったときに文字化けしているバッファを見ると煩わしさを感じるのも事実です。

そういうときはdiffのバッファの中で M-x revert-buffer-with-coding-system (C-x RET r) の後、文字エンコーディングを選ぶのが簡単です。diffは取り直しになりますが。

他にもread onlyを解除して、バッファ全体をencode-coding-regionしてからdecode-coding-regionしてやると直せる場合もあります。diffの取り直しは回避できますが、常に直せるかはちょっと分からないです。

ediffで済むならそれを使うという手もあります。

いずれにせよ煩わしいことには変わりないので、ある程度自動的に対処するように次のようなコードを書きました。

(defun my-diff-detect-coding-system (file)
  "FILEのcoding systemを返す。分からなかったらnilを返す。"
  (let ((cs
         (when (file-regular-p file) ;;ディレクトリは除外する
           (with-temp-buffer
             (insert-file-contents file nil nil 1000000) ;;1MBくらい読んでおく?
             ;; これが一番簡単で確実っぽい
             last-coding-system-used))))
    (message "Detected coding system: %s" cs)
    (unless (memq cs '(nil undecided no-conversion)) ;;変なのは返さない
      cs)))

(defun my-diff-around (orig-fun old new &rest args)
  "diffにひっかけるaroundアドバイス。"
  ;; NEWのcoding systemに合わせてdiffを取る
  (let ((coding-system-for-read (or coding-system-for-read ;;すでに指定されている場合はそれを使う
                                    (my-diff-detect-coding-system new))))
    (apply orig-fun old new args)))

(advice-add 'diff :around 'my-diff-around)

要するにファイル(NEW側のみ)の文字エンコーディングを判別して、それをcoding-system-for-readに設定してからdiffを実行するだけです。

my-diffという関数を作ろうか迷いましたが、diffはいろんな場所から呼び出されているような気がしたので全てに適用させるためにdiffに対するadviceにしてみました。

文字エンコーディングを判別しているところですが、insert-file-contentsの後にlast-coding-system-usedを参照するのが見つけた方法の中では一番簡単でした。最初はdetect-coding-regionを使ったのですが、UTF-16が判別できないこととファイルローカル変数の指定が効かないことが問題になりました。UTF-16はどのみち別の問題があるので諦めるとして、 -*- coding:cp932 -*- のような指定は効いてほしいところ。半角カナでCP932(SJIS)で「ミエ」と書いたらUTF-8の「д」と区別が付かないんですよ(どんなシチュエーションだよ)。そんなときにcoding:の指定を入れれば解決できるわけです。set-auto-coding関数を使えばUTF-16(auto-coding-regexp-alist)やファイルローカル変数の判別が可能になるのですが、今度は行末タイプ(unix、dos、mac)が判別できません。行末タイプだけを判別するような関数を探したのですが見当たりませんでした。自分で \r\n を検索すれば良いのでしょうが、そんな面倒なことをするよりもlast-coding-system-usedを参照するだけで済むようでした。それらの判別処理は全てinsert-file-contentsの中で行われていますので。

UTF-16はどうしましょうね。こればっかりはUTF-8にでも変換してからdiffを取るくらいしか思いつきません。--textを指定するとして、diff自身が出力するヘッダーの文字エンコーディングと合いませんからね。

ディレクトリ単位の比較は相変わらず化けるので必要に応じて C-x RET r するということで。

あ、diff自体が出力する日本語メッセージが化けますね。「のみに存在」とかいうやつ。実行前に環境変数も変えようかな……。

こうして今日も一つ直すと何個も直すところが増えていくのでした。

まだまだdiffの事はよく分かりません。

2024-01-28 ,

org-modeでインライン画像化する画像形式を限定する

以前Emacsが扱える画像形式をちゃんと設定して多種多様な画像を表示できるようにしたのですが(「画像形式とimage-converterの設定」のあたり)、その副作用でorg-mode内で余計なファイルリンクまでインライン画像表示されるようになってしまいました。

例えばmp3や動画ファイル、pdfに至るまでorg-modeの中でインライン画像表示されるようになってしまったのです。例えばTODOリスト内にローカルにあるメディアファイルへのリンクを書いてそれを読む(もしくは聞く)ようにメモを書いたとして、そのリンクがインライン画像表示されてしまうわけです。「image-diredでmp3カバー画像を表示する」のようにImage Dired内でサムネイルとして表示される分には全く構わないわけですが、org-mode内でいちいち全てのリンクが画像として表示されてはたまりません。

原因

インライン画像化される画像形式は、org-display-inline-images関数から呼び出されるimage-file-name-regexp関数が返す正規表現によって決まっています。現在私の所でこの関数を呼び出すと……

(image-file-name-regexp)
\.\(3\(?:G[2P]\|g[2p]\)\|A\(?:I\|PNG\|RT\|VIF?\)\|BMP\|C\(?:R[23]\|UR\)\|D\(?:C[MR]\|DS\|NG\|PX\|XT[15]\)\|E\(?:P\(?:DF\|S[FI]\|T[23]\|[IST]\)\|RF\)\|F\(?:ITS\|L\(?:32\|IF\|V\)\|TS\)\|GIF\|H\(?:DR\|EI[CF]\|RZ\)\|I\(?:C\(?:ON\|[BO]\)\|IQ\|PL\)\|J\(?:2[CK]\|B\(?:I?G\)\|N[GX]\|P\(?:EG\|[2CEGMST]\)\)\|K\(?:25\|DC\)\|M\(?:2V\|4[AV]\|EF\|IFF\|KV\|NG\|O\(?:NO\|V\)\|P\(?:EG\|[34CGO]\)\|RW\|TV\|VG\)\|N\(?:EF\|RW\)\|O\(?:RF\|T[BF]\)\|P\(?:AM\|BM\|C\(?:DS\|[DLTX]\)\|DFA?\|EF\|F[ABM]\|G[MX]\|HM\|I\(?:C\(?:ON\|T\)\|X\)\|JPEG\|N[GM]\|PM\|S[BD]?\|TIF\|WP\)\|QOI\|R\(?:A[FS]\|GF\|L[AE]\|MF\|W2\)\|S\(?:FW\|VGZ?\)\|T\(?:GA\|I\(?:FF\(?:64\)?\|[FM]\)\|M2\|T[CF]\)\|V\(?:DA\|I\(?:CAR\|FF\|PS\)\|ST\)\|W\(?:BMP\|EB[MP]\|MV\|PG\)\|X\(?:3F\|BM\|CF\|P[MS]\|V\)\|a\(?:i\|png\|rt\|vif?\)\|bmp\|c\(?:r[23]\|ur\)\|d\(?:c[mr]\|ds\|ng\|px\|xt[15]\)\|e\(?:p\(?:df\|s[fi]\|t[23]\|[ist]\)\|rf\)\|f\(?:its\|l\(?:32\|if\|v\)\|ts\)\|gif\|h\(?:dr\|ei[cf]\|rz\)\|i\(?:c\(?:on\|[bo]\)\|iq\|pl\)\|j\(?:2[ck]\|b\(?:i?g\)\|n[gx]\|p\(?:eg\|[2cegmst]\)\)\|k\(?:25\|dc\)\|m\(?:2v\|4[av]\|ef\|iff\|kv\|ng\|o\(?:no\|v\)\|p\(?:eg\|[34cgo]\)\|rw\|tv\|vg\)\|n\(?:ef\|rw\)\|o\(?:rf\|t[bf]\)\|p\(?:am\|bm\|c\(?:ds\|[dltx]\)\|dfa?\|ef\|f[abm]\|g[mx]\|hm\|i\(?:c\(?:on\|t\)\|x\)\|jpeg\|n[gm]\|pm\|s[bd]?\|tif\|wp\)\|qoi\|r\(?:a[fs]\|gf\|l[ae]\|mf\|w2\)\|s\(?:fw\|vgz?\)\|t\(?:ga\|i\(?:ff\(?:64\)?\|[fm]\)\|m2\|t[cf]\)\|v\(?:da\|i\(?:car\|ff\|ps\)\|st\)\|w\(?:bmp\|eb[mp]\|mv\|pg\)\|x\(?:3f\|bm\|cf\|p[ms]\|v\)\)\'

といった具合なので、そりゃ沢山の形式がインライン画像化されてしまうわけです。

手動でインライン画像表示をしていたらあまり気にならないのかもしれませんが、私はorg-flyimageで自動的にインライン画像表示をさせているので意図しないものまで全て即事に表示されてしまうわけです。

修正方法

これを修正するとして、image-file-name-regexp関数が返す内容を修正すべきでしょうか。それともorg-mode側を修正すべきでしょうか。

image-file-name-regexp関数を修正してしまうと他の部分で画像が表示されなくなってしまうことが予想されます。また、そもそもインライン画像化はエクスポートしたときに画像化される形式に限定すべきでしょう。

org-flyimageの自動表示対象を変更できるようにするという手もありますが(必要なら手動で表示する余地を残す)、そこまでは必要ないでしょう。

というわけでorg-display-inline-images関数の挙動を書き替えれば良いのですが、私の場合以前「org-inline-image-fixのEmacs 29対応」に書いたような経緯でこの関数を完全に置き換えてしまっているので、そちらを修正することになります。org-display-inline-images関数は外から手を加えるのが難しい構造をしていて、色々強引な手を使った挙げ句Emacs29になったタイミングでより良い関数に置き換えたのでした。

Add ability to customize displayed image file names · misohena/org-inline-image-fix@07856aa

上のコミットでorg-better-inline-images-image-file-name-regexpというカスタマイズ変数を追加し、画像化するか判定するための正規表現を変更できるようにしました。設定できる値は、nil(従来通りimage-file-name-regexp関数を使う)、文字列(正規表現)、関数(image-file-name-regexp関数の代わりに正規表現を返す)、拡張子のリストに対応しています。

本当は画像としてエクスポートするファイル名かどうか(org-export-default-inline-image-ruleorg-html-inline-image-rules)を基準にしようとも思ったのですが、tifやxpm等微妙な形式もありますし、ox.elやox-html.el等を必ずロードしなければならないのでやめておきました。数も少ないですし、拡張子のリストが指定出来ればそれで十分でしょう。

これで私はインライン画像表示する形式を、gif、jpg、jpeg、png、svg、webpに限定しました。必要な形式があったらその都度追加するということで。

org-better-inline-images-image-file-name-pというカスタマイズ変数も追加しておきましたが不要でした。

Org 9.6から現在までのインライン画像表示機能に対する変更点の確認

ついでに最近のインライン画像表示機能に対する変更点も確認しておきました。関数を置き換えた以上、本家の方に加えられた変更に目を光らせていなければなりません。

これらはおそらく次のリリース(9.7?)に含まれることになるのでしょう。

注目はインライン画像の幅を制限する機能(org-image-max-width変数)でしょう。待ちわびていた人もいるのではないでしょうか。今のところ高さの制限(org-image-max-height?)は無いように見えます。なので私の改良はまだ意義があるということで。

インライン画像のalign(右寄せ、中央寄せ)も実装されたようです。 #+ATTR_HTML: :align center 等の指定やグローバルオプション(org-image-align)の指定が反映されるようです。個人的には使う予定はありません。

org-elementにいくつか便利な関数が追加されたり、引数の指定方法が改善されたりしたので、それに伴う修正がいくつか入っていました。

環境変数の展開は、そもそもそんなことができること自体知りませんでした。試しに [[file:$APPDATA/Microsoft/Windows/Start Menu/Programs]] と書いたらちゃんとスタートメニューにアクセスできました。私はCorfuでファイル名の補完を有効にしているのですが、 file:$ と打った瞬間に全環境変数が補完候補として出てきます。環境変数を入れた後も、ちゃんとそれを展開した後のディレクトリにあるファイルを補完候補として出してきます!

一部のものは私の改造版にも反映しておきました。残りは9.7が出てからにします。

2024-01-27

複数行にわたるコメントの中のS式を評価する

Emacs Lispで次のようなコードを書いたとします。

;; 使用例:
;; (my-hogehoge-function
;;   1
;;   2
;;   3)

(defun my-hogehoge-function (a b c)
  (+ a b c))

複数行あるコメントの最後、 ) の直後でeval-last-sexp (C-x C-e)を実行すると……

Debugger entered--Lisp error: (scan-error "Unbalanced parentheses" 313 1)

などと出てコメント内のS式を評価できません。

いちいちuncommentしてから評価して元に戻すのも面倒です。

Googleで検索して見ると kensanata/eval-sexp-in-comments: eval sexp in comments, for Emacs というのを見つけました。ソースコードを見るとwith-temp-bufferで別バッファへ移してからコメントを外し、その後eval-last-sexpを実行していました。それだと現在のバッファの中で評価したい場合に困ります。

eval-last-sexpの中身を見てみると、elisp--preceding-sexpという関数でポイントの前にあるS式テキストをlispオブジェクトの形で取り出してから、評価しているようでした。

なので、このelisp--preceding-sexpに細工をしてコメントの中にいるときは別バッファにコピーしてコメントを外し、そこでelisp--preceding-sexpを呼び出してS式を返せば良いと考えました。

;; my-elisp.el

(defun my-elisp-beginning-of-continuous-comments ()
  "現在の連続コメントの先頭を返す。

連続コメントとは、連続改行(空行)を除く空白文字のみで区切られた複
数のコメントのまとまりを指す。そのまとまりの最初の;の位置を返す。

例:
123 ;; line-1
    ;; line-2

    ;; line-3

「line-3」の末尾の場合「;; line-3」の先頭、「line-2」の末尾の場合
「;; line-1」の先頭の位置を返す。

各行;;の先頭はコメントに含まれない。

現在のポイントがコメント内ではない場合nilを返す。

文字列の中の;;には反応しない。
例:
\"
;; line-1 ←ここで実行してもnilを返す。コメントでは無く文字列の中なので。
\"

(以下追記)
同じコメントスタートに限定するかは迷うところ。
 ;; (+
;;     2
;;;    3)
みたいなのも現状では受け入れる。

    ;; line-1
123 ;; line-2
    ;; line-3
みたいなのは無理(;; line-2が先頭になる)。
対応できないことは無いだろうけど
そもそもコメントの前に何かある場合も対応する必要があるかは疑問。

理想的にはコメント開始の水平位置と;の数が揃っている連続行を
抽出すべきなのだと思う。"
  (cond
   ((derived-mode-p 'emacs-lisp-mode)
    (save-excursion
      (let (beginning-of-comment)
        (while (and (comment-beginning)
                    (progn
                      (skip-chars-backward " \t")
                      (skip-chars-backward ";")
                      (setq beginning-of-comment (point))
                      (skip-chars-backward " \t")
                      (bolp))
                    (not (bobp)))
          (backward-char))
        beginning-of-comment)))
   (t
    (save-excursion
      ;; TODO: 現在のメジャーモードでのコメントが先頭にある場合はそれも無視すべき?
      ;; TODO: 「123 ;; (if」から複数行に続く形式に対応していない。123の部分にコメント以外のセミコロン(文字列等)があることを考慮しなければならない。
      (let (beginning-of-comment)
        (forward-line 0)
        (while (looking-at "[ \t]*;+[ \t]*")
          (setq beginning-of-comment (match-end 0))
          (forward-line -1))
        beginning-of-comment)))))

(defun my-elisp-sexp-in-comment (beg end)
  "BEGからENDの中にあるコメントの中にあるS式を返す。"
  (when (and beg end (< beg end))
    (let ((original-buf (current-buffer)))
      (with-temp-buffer
        (emacs-lisp-mode)
        (insert-buffer-substring original-buf beg end)
        (goto-char (point-min))
        ;; ↓これだと最終行のコメントが空でかつEOBの時になぜか「Beginning of buffer」のエラーが出る。
        ;; (uncomment-region (point-min) (point-max))
        (while (re-search-forward "^\\s-*;+" nil t)
          (replace-match "")
          ;; 次の行へ(現在の行にある残りのコメント中コメントは残す)。
          (forward-line 1))
        (goto-char (point-max))
        ;; 1段階コメントを外した後の状態からS式を取り出す。
        ;; コメントの中にコメントがある場合は、
        ;; 再帰的にこの関数が呼び出されることもある。
        ;; ;; ;; (+
        ;; ;; ;;  ;; コメント
        ;; ;; ;;  1 2)
        ;; みたいなのも正しく処理する。
        (elisp--preceding-sexp)))))

(defun my-elisp-preceding-sexp-in-comment ()
  "ポイントがコメント内にあるとき、複数行にわたるコメントを考慮して
ポイントの直前にあるS式を読み取る。"
  (my-elisp-sexp-in-comment (my-elisp-beginning-of-continuous-comments) (point)))

(defun my-elisp-preceding-sexp-around (orig-fun &rest args)
  "elisp--preceding-sexpの:around advice。"
  (let ((end (point))
        (beg (my-elisp-beginning-of-continuous-comments)))
    (if (and beg (< beg end))
        (my-elisp-sexp-in-comment beg end)
      (apply orig-fun args))))

(provide 'my-elisp)

(2024-01-30修正: コメントの中のコメントをうまく処理できるようにしました)

設定方法:

(when (version<= "25.1" emacs-version) ;; Require #'elisp--preceding-sexp
  (autoload 'my-elisp-preceding-sexp-around "my-elisp")
  (advice-add 'elisp--preceding-sexp :around 'my-elisp-preceding-sexp-around))

これで無事複数行にわたるコメント内のS式を評価できるようになりました。

ただ、メジャーモードがemacs-lisp-modeではない場合のことも考えると、少々煮え切らないコードになってしまいました。例えばorg-modeのソースコードブロックの中にコメントがあって、その中のS式を評価したい場合など。C言語やシェルスクリプトのコメント(//や#)の中に複数行にわたってS式を書いてそれを評価したい、なんてケースはあるでしょうか?(実際、別言語のソースコードのコメントの中にelispのコードを書いて、その別言語のコードを生成したことは度々あった気がします) 考え出すと切りがないです。文字列などクォートされたセミコロンを考慮しなければならないので単純な正規表現で処理するのもためらわれたりと色々面倒なところもありました。

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

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