Yearly Archives: 2024

2024-03-23 ,

org-elisp-linkでcl-defmethodへのリンクを書けるようにする

以前書いたorg-elisp-linkで、cl-defmethodで定義したメソッドへのリンクを書けるようにしました。

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

例えばlistを引数に取るseq-takeへのリンクは [[elisp-function:seq-take;method-args=(nil list t)]] のように書きます。

method-args= オプションの書式は ( qualifiers . specializers ) になります。 qualifiers はあまり指定されないのでnilの場合が多いかと思います。 specializers はcl-defmethodで指定する引数列の引数名を除いたものと考えれば良いでしょう。

qualifiers を使用する例としては、例えばelp.elの中にあるloadhist-unload-elementへのリンクなんてどうでしょう(lispディレクトリでgrepして探しました)。

(cl-defmethod loadhist-unload-element :extra "elp" :before ((x (head defun)))
  "Un-instrument before unloading a function."
  (elp-restore-function (cdr x)))

elp.elの中に上のような定義があるのですが、そこへのリンクは次のように書くことになります。

[[elisp-function:loadhist-unload-element;method-args=((:extra "elp" :before) (head defun));library=elp]]

実装はelisp-mode.elのxrefバックエンド、特にelisp--xref-find-definitionsあたりを利用しています。

xrefを使ってelispの関数やら変数やらの定義へジャンプするには、次のようにすればできます。

(let ((xref-backend-functions '(elisp--xref-backend))) ;; 強制的にelispバックエンドを使うようにする
  (xref-find-definitions "find-file"))

cl-defmethodによって複数の選択肢がある場合はxrefのメニューが出ます。

(let ((xref-backend-functions '(elisp--xref-backend)))
  (xref-find-definitions "seq-take"))

今回リンクの上でC-c C-o(org-open-at-point)したときはこの方法で定義位置へジャンプするようにしてみました。従来はこのような場合に必ずcl-defgenericの方へジャンプしてしまったり、それが無ければジャンプできなかったりしていました。

エクスポートの時はジャンプせずに定義の場所を取得する必要があります。

ジャンプせずに定義の候補を取得するには次のようにすればできます。

(elisp--xref-find-definitions 'seq-take)
(#s(xref-item
    #("(cl-defgeneric seq-take)" 1 14 (face font-lock-keyword-face) 15 23 (face font-lock-function-name-face))
    #s(xref-elisp-location
       seq-take
       cl-defgeneric "c:/...path-to-emacs.../share/emacs/29.2/lisp/emacs-lisp/seq.el"))
 #s(xref-item
    #("(cl-defmethod seq-take ((list list) n))" 1 13 (face font-lock-keyword-face) 14 22 (face font-lock-function-name-face))
    #s(xref-elisp-location
       (seq-take nil list t)
       cl-defmethod "c:/...path-to-emacs.../share/emacs/29.2/lisp/emacs-lisp/seq.el")))

結果はxref-itemというレコードになります。xref-itemはsummaryとlocationという二つの要素から成ります。

summaryの方は単なる文字列(テキストプロパティ付き)です。

locationの方は場所を特定するための情報で、elisp--xref-find-definitionsが返す場合はxref-elisp-locationというレコードになります。xref-elisp-locationはsymbol、type、fileから成ります。

試しにseq-takeの2番目の候補の場所を取得してみましょう。

(let ((loc (xref-item-location (nth 1 (elisp--xref-find-definitions 'seq-take)))))
  (list
   (xref-elisp-location-type loc)
   (xref-elisp-location-symbol loc)
   (xref-elisp-location-file loc)))
(cl-defmethod ; type
 (seq-take nil list t) ; symbol
 "c:/...path-to-emacs.../share/emacs/29.2/lisp/emacs-lisp/seq.el" ; file
 )

定義位置へジャンプするとき、これらの情報はそのままfind-function-search-for-symbolに引き渡されます。

typeの cl-defmethodfind-function-regexp-alistのキーです。このalistからcl--generic-search-method関数が求められ、symbolがそのcl--generic-search-method関数に引き渡されて実際の検索が行われます。symbolは (seq-take nil list t) なので、メソッド名が seq-take 、qualifier無し、引数の型がlistであるようなcl-defmethodが(re-search-forwardで)検索されます。

今回追加したmethod-args=オプションの形式は、このsymbolのメソッド名を除いた残りの部分と一致するようになっています。

2024-03-03

shell-modeでgitを使うたびにブラウザが開きまくるのを直す

先日Corfuの自動補完の設定を変えてからだと思うのですが、M-x shellでgitのコマンドを打つたびにブラウザでヘルプが開いて困っていたので重い腰を上げて直しました。

原因は pcomplete/git 関数内で git help コマンドを実行しているところにあります。

;; pcmpl-git.elより
(defun pcomplete/git ()
  "Completion for the `git' command."
  (let ((subcommands (pcomplete-from-help `(,vc-git-program "help" "-a")
                                          :margin "^\\( +\\)[a-z]"
                                          :argument "[[:alnum:]-]+")))
    (while (not (member (pcomplete-arg 1) subcommands))
      (if (string-prefix-p "-" (pcomplete-arg))
          (pcomplete-here (pcomplete-from-help `(,vc-git-program "help")
                                               :margin "\\(\\[\\)-"
                                               :separator " | "
                                               :description "\\`"))
        (pcomplete-here (completion-table-merge
                         subcommands
                         (when (string-prefix-p "-" (pcomplete-arg 1))
                           (pcomplete-entries))))))
    (let ((subcmd (pcomplete-arg 1)))
      (while (pcase subcmd
               ((guard (string-prefix-p "-" (pcomplete-arg)))
                (pcomplete-here
                 (pcmpl-git--expand-flags
                  (pcomplete-from-help `(,vc-git-program "help" ,subcmd) ;; ★ここ★
                                       :argument
                                       "-+\\(?:\\[no-\\]\\)?[a-z-]+=?"))))

これはgitコマンドの引数を補完するためのコードです。 git help コマンドは指定可能なコマンドやオプションを列挙するために呼び出しているようです。

git help コマンドの呼び出しは三つ存在するのですが、 git help -agit help はコンソールから試してみても標準出力にテキストが表示されるので問題ありません。しかし git help status などとサブコマンド名を入れてみるとブラウザが開きます。

現在私が使っているGitはMSYS2やCygwinのものではなく、Git for Windowsなのでそれが原因なのかもしれません。Git Bashから git help --man status などと打っても No manual entry for git-status などと出るだけです。manやinfoが入っていないのでブラウザでhtmlを開くのでしょう。

試しに `(,vc-git-program "help" ,subcmd) の部分を `(,vc-git-program ,subcmd "-h") に直したら問題は解消しました。

といっても直接ファイル(pcmpl-git.el)を書き替えるのも何ですし、どうしましょうね。pcomplete/git関数は少々内容が込み入っていて、全体をコピーして一部を書き替えて置き換えるのも気が引けます。

問題のリスト `(,vc-git-program "help" ,subcmd)pcomplete-from-help関数に引き渡されています。なので、pcomplete-from-help関数の第一引数(command)に `(,vc-git-program "help" ,subcmd) が渡されたときに `(,vc-git-program ,subcmd "-h") へ差し替えてしまいましょう。pcomplete-from-help関数はあちこちで利用されているでしょうから、安全のためにpcomplete/gitの中から呼び出される時だけ、この変換処理をすることにしてみます。

;; shell-modeでgitコマンドの引数を補完させるとブラウザが開くのを抑制する。
;; 次の三つのパターンがあるが、git help <subcmd>のときだけブラウザが開くので
;; それをgit <subcmd> -hに置き換える。他はそのまま。
;;  git help -a        => そのまま
;;  git help           => そのまま
;;  git help <subcmd>  => git <subcmd> -h
(with-eval-after-load "pcmpl-git"
  (defun my-pcomplete/git:around (oldfun)
    (cl-letf* ((old-pcomplete-from-help
                (symbol-function 'pcomplete-from-help))
               ((symbol-function 'pcomplete-from-help)
                (lambda (command &rest args)
                  (apply old-pcomplete-from-help
                         ;; Replace git help <subcmd>
                         (if (and (listp command)
                                  (equal (car command) vc-git-program)
                                  (equal (cadr command) "help")
                                  (cddr command)
                                  (not (string-prefix-p "-" (caddr command))))
                             ;; => git <subcmd> -h
                             `(,(car command) ,(caddr command) "-h")
                           command)
                         args))))
      (funcall oldfun)))
  (advice-add 'pcomplete/git :around 'my-pcomplete/git:around))

cl-letfでsymbol-functionを書き替えるコードはやっぱり少し鬱陶しいですね。

pcomplete-from-helpgit help <subcmd> というコマンドを渡すところは他に無いでしょうし、もしあったとしても意図的にブラウザを開くために使うことは無いでしょうから、pcomplete/gitの中だけに限定する必要は無かったかもしれません。それなら:

(with-eval-after-load "pcmpl-git"
  (defun my-pcomplete-from-help:filter-args (args)
    ;; Replace git help <subcmd>
    (let ((command (car args)))
      (if (and (listp command)
               (equal (car command) vc-git-program)
               (equal (cadr command) "help")
               (cddr command)
               (not (string-prefix-p "-" (caddr command))))
          ;; => git <subcmd> -h
          `((,(car command) ,(caddr command) "-h") ,@(cdr args))
        args)))
  (advice-add 'pcomplete-from-help :filter-args 'my-pcomplete-from-help:filter-args))

程度でも良いかもしれません。

2024-02-25 ,

org-link-completion.elによるリンクの補完とorg-modeのリンク構文

先日から作っているorg-link-completion.elですが、一応org-modeのリンク表記の内部のうち、ほとんど全ての場所で補完ができるようになりました。

misohena/org-link-completion: Complete the link type, path and description part of links at point in org-mode buffer.

次の場所で補完できるはずです。

  • [[ link-type:
  • [[ searchtarget
  • [[# custom-id
  • [[# custom-id ][ description
  • [[* heading
  • [[* heading ][ description
  • [[( coderef)
  • [[(coderef)][ description
  • [[ Search Target
  • [[ Search Target ][ description
  • [[ /dir/file
  • [[ ./dir/file
  • [[ /dir/file
  • [[ c:/dir/file
  • [[ /dir/file ][ description (上記 / ./ / c:/ を含む)
  • [[file: file
  • [[file+sys: file
  • [[file+emacs: file
  • [[file: file ][ description (上記 file+sys: file+emacs: を含む)
  • [[ unknown-type: path
  • [[ unknown-type: path ][ description

補完できないところは[と[、]と[、]と]の間くらいじゃないでしょうか。

そもそもorg-modeでどんなリンクが書けるのかというのがあやふやだったんですよね。仕方ないのでちゃんとおさらいしました。

org-modeのリンクで一番重要なコンセプトは、URLや(ディレクトリを含む)ファイルパスのように見えるもの以外は内部リンクだということでしょう。つまり、 file: とか https: とか付いているものや ./screenshot.png のようなもの以外は現在のorg-modeバッファ内へのリンクです。

ただ、私は解析の都合上 file: とか https: のようなリンクタイプが付いているかそうでないかによって大きく二通りに分けました。その上で、付いていないもののうち、ファイルパスは外部リンク、そうでないものは内部リンクということになります。

それを踏まえて全ての形式を列挙すると次のようなります。

  • リンクタイプ無し
    • 内部リンク
      • [[ # カスタムID ]
      • [[ * 見出し ]
      • [[ ( コード行参照 ) ]
      • [[ 色々検索 ]
    • 外部リンク
      • ディレクトリ始まりファイルパス

        • 相対パス
          • [[ ./ ファイルパス
          • [[ ../ ファイルパス (追記:漏れていたので追加)
        • 絶対パス

          • [[ / ファイルパス
          • [[ ~/ ファイルパス
          • [[ ~ ユーザ名 ファイルパス (追記:漏れていたので追加)
          • [[ \ ファイルパス (MS-Win) (追記:漏れていたので追加)
          • [[ ドライブレター : /または\ ファイルパス (MS-Win) (追記:コロンの後には/か\が必要)

          (追記:絶対パスはfile-name-absolute-pがtを返す形式でなければならない。つまり ~ユーザ名 なんてのも許容される(!)し c:\ とバックスラッシュが続くのも許容される。c:の後にパス区切りが無いドライブ相対指定は許容されない。当然プラットフォームによって異なる。面白いのが相対パスにバックスラッシュを使った .\file は許容されないが絶対パス \file は許容される点)

        (注: file: と同じように 後ろに :: を付けられるが省略)

  • リンクタイプ付き
    • 省略記法(org-link-abbrev-alist, org-link-abbrev-alist-local)
    • リンクタイプ(org-link-parameters)
      • file: (file+sys:file+emacs: も形式は同じ。 ファイルパス は空でも良い)
        • [[file: ファイルパス ]
        • [[file: ファイルパス :: 行番号 ]
        • [[file: ファイルパス :: 色々検索 ]
        • [[file: ファイルパス :: * 見出し ]
        • [[file: ファイルパス :: # カスタムID ]
        • [[file: ファイルパス :: ( コード行参照 ) ]
        • [[file: ファイルパス :: / 正規表現 / ]
      • その他沢山(標準的なもの: attachment:, bbdb:, docview:, doi:, elisp:, gnus:, rmail:, mhe:, help:, http:, https:, id:, info:, irc:, mailto:, news:, shell:)

……漏れがあったらすみません。

いろんなリンクの例としてexamples/links.orgというのも作っておきました。

# の後で補完すれば全カスタムIDが候補として出ますし、 ( の後なら全(ref:)表記、 * の後なら全見出しが出ます(見出しだけはorg-modeの標準でも補完してくれます)。

色々検索 の部分ですが、概ね次のように検索されるようです。

  1. dedicated target (<< と >> で囲んだ文字列がリンクターゲットになります。文字列はエクスポートされません)
  2. 要素(ブロック)の名前 (#+NAME:で指定する)
  3. 見出し
  4. 全文検索 (org-link-search-must-match-exact-headlineがnilの時またはorg以外のファイルの時のみ)

概ね <<My Target>>#+NAME: table1 のようなものへのリンクと考えた方が良さそうなので、それだけを補完候補として出しています。

ファイルの :: 以降はまだ未実装です。現時点では補完されません。

file以外のリンクタイプについては手を付けていません。 org-link-parametersから :capf-path:capf-desc という非標準のプロパティを取得してそれを呼び出すようにしてあるので自分でいくらでも追加できます。org-elisp-link.elもその方法で補完関数を追加しているので、関数名や変数名をorg-modeバッファ内で補完できます。

いずれの種類においても有効なのが他の同種のリンクから候補を集めるという方法です。リンクの説明部分を補完するときに、既に書かれている同じタイプとパスを持つリンクから説明部分を拝借してくることが出来ます。パスについても同じタイプを持つリンクから候補を集めます。

色々やると大きなファイルで処理が遅くなる場合もあるかもしれません。全ての補完関数は個別に取り除く(無効化する)ことが出来るようになっています。

というわけで大枠は出来たかと思います。細かいところがまだ残っていますが、まぁ、そのうちやったりやらなかったりするでしょう。

ここまでやっておいてこの投稿を書いている間に何回C-c C-lでミニバッファにパスや説明部を入力してリンクを作成したことか。まぁ、今後は両方使えるということで(笑)

参考資料:

2024-02-23 ,

org-link-completion.el

先日からorg-elisp-link.elに書いていた補完用のコードのうち、elispリンクに限らない一般的な枠組みの部分をorg-link-completion.elへ移動しました。

ブログリンクなどelispリンクと関係ないものを書いているのに org-elisp-link- で始まる関数やらマクロやらを使わないといけないのが何だか気持ち悪く感じてきたので。

基本的な考え方はorg-elisp-link.elにあった時とほとんど同じです。

より強くorg-modeのリンク部分をサポートするという意味で、リンクタイプ部分の補完機能も入れてあります。つまりorg-modeでの入力補完に書いた(pcomplete/org-mode/link関数を修正した)ような [[ の直後部分でリンクタイプを補完することもできるようになっています。ポイントの周辺を解析する関数もそれに合わせてリンクタイプ部分にいることを理解できるように修正しました。解析結果のリストの構造も少しだけ変わっています。

そのリストにアクセスするために以前はnthを連発していたのですが、それを改善するマクロも追加しました。

例えば以前次のようなコードを書きました。

(defun my-blog-link-capf-path ()
  "[[blog:2024-02-20-hello-emacs]]のようなリンクの補完候補を返します。
my-blog-dirにorgファイルがあるものとします。"
  (when-let ((pos (or org-elisp-link-capf-pos (org-elisp-link-capf-path-parse))))
    (let* ((type-beg (nth 0 pos))
           (type-end (nth 1 pos))
           (path-beg (nth 2 pos))
           (path-end (nth 3 pos))
           (type (buffer-substring-no-properties type-beg type-end)))
      (when (string= type "blog")
        (list
         path-beg path-end
         (cl-loop for file in (directory-files my-blog-dir)
                  when (string-match "\\`\\(.+\\)\\.org\\'" file)
                  collect (match-string 1 file))
         :company-kind (lambda (_) 'file))))))

これを次のようにアクセッサで書けるようにし……

(defun my-blog-link-capf-path ()
  "[[blog:2024-02-20-hello-emacs]]のようなリンクの補完候補を返します。
my-blog-dirにorgファイルがあるものとします。"
  (when-let ((pos (or org-link-completion-pos (org-link-completion-parse-at-point))))
    (let* ((path-beg (org-link-completion-pos-ref pos path-beg))
           (path-end (org-link-completion-pos-ref pos path-end))
           (type (org-link-completion-pos-ref pos type)))
      (when (string= type "blog")
        (list
         path-beg path-end
         (cl-loop for file in (directory-files my-blog-dir)
                  when (string-match "\\`\\(.+\\)\\.org\\'" file)
                  collect (match-string 1 file))
         :company-kind (lambda (_) 'file))))))

最終的に次のようになりました。

(defun my-blog-link-capf-path ()
  "[[blog:2024-02-20-hello-emacs]]のようなリンクの補完候補を返します。
my-blog-dirにorgファイルがあるものとします。"
  (org-link-completion-parse-let :path (type path-beg path-end)
    (when (string= type "blog")
      (list
       path-beg path-end
       (cl-loop for file in (directory-files my-blog-dir)
                when (string-match "\\`\\(.+\\)\\.org\\'" file)
                collect (match-string 1 file))
       :company-kind (lambda (_) 'file)))))

最初は分割束縛(この用語もどう日本語にするか悩ましいですが、今回はとりあえずこう書きます)で書こうと思ってpcasecl-destructuring-bindseq-letの三つを理解しやすさ、コード量、意味論、速度、letの入れ子の数など多角的に検討したのですが、実際に使って書いてみたときの全体的なコードが過剰に複雑に見える気がしてnth羅列の方がまだマシという気がしたので最終的に上のようなマクロに落ち着きました。

我々はコード中のマジックナンバーに不快な匂いを感じるよう訓練されているわけですが、それが分割束縛になったところで明示的なインデックス番号が非明示的な語順に変わっただけだということで汚いことには変わりがないんですよね。汚いものは汚いように見えるべきじゃないかと私はよく思います。上のようなマクロを作ってそれだけを使うようにしておけば汚い部分は大分局所化されますね。

で、三つの分割束縛の方法について。

pcaseは総じて優秀だなという印象。少ないコード量で複雑なマッチングと束縛をこなせます。マクロ展開の速度?がこれだけやけに速いみたいなのですが何だろう。チェックが過剰になりがちなのでバイトコンパイルすると最終的な速度はcl-destructuring-bindに追い越されますが。一番の問題点はコードが記号だらけで見づらくなるところですね。それと展開されたコードがかなりの数のletの入れ子になっていました。これ再帰で使ったらすぐにmax-lisp-eval-depthmax-specpdl-sizeの制限に引っかかるのでは? まぁバイトコンパイルすれば緩和されますが。値がnil、4要素のリスト、6要素のリストのいずれかという状況に対してパターンの指定は意味的にやや過剰という面があるでしょう。ちなみにpcase-letというのもありますが、パターンに一致しなかったときの動作は未定義と書かれています。まぁ、最初に全体をwhen-letで受けてから長さをチェックしてpcase-letを使えば良いのでしょうが、大人しくpcaseを使いました。

cl-destructuring-bindの引数リストってあのcl-defunと同じなんですね。ビックリしました。 (&whole pos &optional type-beg type-end path-beg path-end desc-beg (desc-end nil desc-p)) みたいに書いて遊んでました。やべぇなこれ(笑) 面白いから使いたかったのですが、結局どれも使わなかったのと、記述が長くなりがちなのもマイナスでしょうか。というかあまり遊んでると目的外使用感が出てきてしまいますね。あ、plistをこれで受けるなんて使い方もできるのか! 展開されたコードは一番美しかったです。順番にpopしていくだけですね。

seq-letはコードの見た目がシンプルでとても気持ちが良いです。でもシーケンスの長さが一致しないときの挙動が文書化されていません。docstringにもEmacs Lispのマニュアルにも書かれていません。中身はpcase-letを使っているみたいなのですが……。いや、最初の例で4要素のvectorを2つの変数で受けているから大丈夫ということなのかな? もし足りないのはnilになり過剰なのは単に捨てられることが保障されているなら積極的に使っていきたいです。リスト用ではなくシーケンス用なので速度は若干遅いです。まぁ、ほとんどの場合気にする差ではありません。基本的にseq--elt-safeの羅列が生成されるようです。

まぁ、細けぇことはいいんだよ、動けばいいんだ! ということで。

2024-02-20 ,

org-modeリンクの説明部分でcompletion-at-pointできるようにする

昨日の続き。

昨日の投稿の最後に blog: リンクのpath部分([[blog:<ここ>)を補完するコードを書きましたが、今度は説明(description)部分([[blog:2024-02-20-hello-emacs][<ここ>))を補完するコードを書いてみました。

(2024-02-23追記: 補完関数を定義する一般的な枠組み部分をorg-link-completion.elへ移動しました。それに伴い以下のコード等を書き直しました)

org-elisp-link.el org-link-completion.elの方に必要となる機能をすでに追加してあります。org-link-properties:completion-at-point プロパティはやめて :capf-path:capf-desc を使うようにしました。これによって、path部分と説明部分を補完する関数を別々に指定することが出来ます。

これを使うとブログリンクの説明部分を補完するコードを次のように書くことが出来ます。

(require 'org-link-completion)

(defun my-org-blog-link-capf-desc ()
  "ポイント上のblogリンクの説明部分を補完します。"
  (org-link-completion-parse-let :desc (type path desc-beg desc-end)
    (when-let ((blog (my-blog-from-link-type type)))
      (let* ((title (let* ((dir (plist-get blog :local-dir))
                           (file (expand-file-name (concat path ".org") dir)))
                      (my-org-blog-org-file-title file))))
        (list
         desc-beg desc-end
         (append
          (when title
            (list title
                  (concat title " | " (plist-get blog :title))))
          (list path)))))))

(defun my-org-blog-org-file-title (file)
  "org-modeで記述されているFILEからタイトルを取得します。"
  (when (file-regular-p file)
    (with-temp-buffer
      (insert-file-contents file nil nil 16384) ;; きっと先頭の方にあるでしょう。
      (goto-char (point-min))
      (let ((case-fold-search t))
        (when (re-search-forward
               "^#\\+TITLE: *\\(.*\\)$" nil t)
          (match-string-no-properties 1))))))

(org-link-set-parameters "blog"
                         :capf-desc 'my-org-blog-link-capf-desc)

実際に使うと次のようになります。

blogリンクのdescriptionを補完しているところ
図1: blogリンクのdescriptionを補完しているところ

ファイルの先頭部分にある「#+TITLE:」を見て自動的にタイトルを候補にしてくれます。

blog: リンクに留まらず、普通の file: リンクでも同じ事が出来そうです。.orgファイルへのリンクは同じ方法でタイトルが取得できますから、それを補完候補にすることができます。他にも何らかの方法でタイトルを取得できるファイルへのリンクはそれを補完候補にすることもできるでしょうね。といってもあまり思いつきませんが。pdfとか? http、httpsリンクタイプでhtmlからtitleを取ってくるのはやり過ぎでしょうか?

2024-02-19 ,

org-modeリンクのpath部分でcompletion-at-pointできるようにする

(2024-02-23追記: 以下でorg-elisp-link.elに追加したリンク補完機能の内、一般的な枠組みの部分をorg-link-completion.elへ移動しました。考え方はほとんど以下と同じですが細部は多少変わっています。関数名等もorg-link-completion-で始まるように変わっています)

この間作った org-elisp-link.elで、リンクのpath部分をcompletion-at-point (C-M-i)で補完できるようにしました。

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

例えば [[elisp-function:save- と書いた後に C-M-i を押すと、save-で始まる関数名が補完候補としてずらっと出るというわけです。

関数名を補完させるところ
図1: 関数名を補完させるところ

いや、分かってるんですよ。C-c C-lを押せばミニバッファに補完付きでファイルタイプを入力できて、そのファイルタイプにorg-link-parameters:complete プロパティが設定されていれば、ミニバッファで補完付きで関数名ぐらい入力させられるということは。

でもやっぱりorg-modeバッファ内で、at pointでやりたいじゃないですか。せっかく最近Corfuの補完設定を改善したところですし。

どう実現したかというと、org-link-parametersに非標準のプロパティ :completion-at-point :capf-path を追加しました。(追記:description部分を補完するために :capf-path へ改名しました)

そしてcompletion-at-point-functionsへ登録するための関数(capf)を新しく作成しました。そう、org-pcompleteを拡張するのは止めました。pcompleteには上図のようなアイコン(kind)情報を伝える機能がありません。なのでorg-pcompleteの部分(pcomplete-completions-at-point)はそのままに、それと併存してもう一つ新しい補完関数を追加します。これはリンクのパス部分([[ の後の : 以降)だけに反応します。org-pcompleteはリンクのパス部分には反応しないので問題はありません。

新たに作成した補完関数は次の通りです。

(defvar org-elisp-link-capf-pos nil
  "Temporarily hold the result of `org-elisp-link-capf-path-parse' function.")

(defun org-elisp-link-completion-at-point ()
  "Complete path part of link in org-mode.

[[<link-type>:(complete at this point)

For completion, refer to `:capf-path property of
`org-link-parameters'.

To use this, do the following in org-mode buffer:
(add-hook \\='completion-at-point-functions
          #\\='org-elisp-link-completion-at-point nil t)"
  (when-let ((org-elisp-link-capf-pos (org-elisp-link-capf-path-parse)))
    (let* ((type-beg (nth 0 org-elisp-link-capf-pos))
           (type-end (nth 1 org-elisp-link-capf-pos))
           (type (buffer-substring-no-properties type-beg type-end))
           (capf (org-link-get-parameter type :capf-path)))
      (when capf
        (funcall capf)))))

(defun org-elisp-link-capf-path-parse ()
  "Return (type-beg type-end path-beg path-end) of link at point.

( [[<type>:<path>(point is in <path>) )"
  (save-excursion
    (let ((origin (point))
          path-beg path-end
          type-beg type-end)
      (when (and (skip-chars-backward "^:\n \t[") ;; TODO: Skip escape sequence
                 (eq (char-before) ?:)
                 (setq path-beg (point))
                 (goto-char (1- (point)))
                 (setq type-end (point))
                 (skip-chars-backward "-A-Za-z0-9_+")
                 (eq (char-before) ?\[)
                 (eq (char-before (1- (point))) ?\[)
                 (setq type-beg (point)))
        (goto-char origin)
        (skip-chars-forward "^]\n \t")
        (setq path-end (point))
        (list type-beg type-end path-beg path-end)))))

org-elisp-link-capf-path-parse関数はリンクの範囲を特定する関数です。ポイントの位置にあるリンクが [[<type>:<path> の形をしているとして、現在ポイントが<path>の中を指しているものと仮定します。前後の文字を調べて実際にそうならば、<type>と<path>それぞれの先頭と末尾の位置をリストで返します。

org-elisp-link-completion-at-point関数はcompletion-at-point-functions変数に登録される補完関数です。

しかし見てもらえれば分かりますが非常にシンプルです。やっている事と言えば:

  1. org-elisp-link-capf-path-parseで現在ポイントが指しているリンクの情報を取得して
  2. リンクタイプに対応するorg-link-parameters内の :capf-path プロパティ(補完関数)を取り出し
  3. そこに処理を丸投げする

だけです。

なので原理的にはelispリンクに限った話ではありません。他のリンクタイプでも、同様に補完関数を作ってorg-link-parameters:capf-path プロパティを設定すれば補完が出来るようになります。

丸投げされる側、例えば elisp-function: タイプの補完関数org-elisp-link-capf-path-functionは次のようになっています。

(defun org-elisp-link-capf-path-function ()
  "Complete <function> of [[<link-type>:<function> at point."
  (org-elisp-link-capf-path--symbol
   (lambda (sym)
     (when-let ((sym (intern-soft (symbol-name sym))))
       (or (fboundp sym)
           (get sym 'function-documentation))))
   #'elisp--company-kind))

(defun org-elisp-link-capf-path--symbol (predicate kind)
  "Complete <symbol> of [[<link-type>:<symbol> at point."
  (when-let ((pos (or org-elisp-link-capf-pos ;; 解析済みの情報があればそれを使う
                      (org-elisp-link-capf-path-parse))))
    (let ((path-beg (nth 2 pos))
          (path-end (nth 3 pos)))
      (list
       path-beg path-end
       (elisp--completion-local-symbols)
       :predicate
       predicate
       :company-kind kind
       :company-doc-buffer #'elisp--company-doc-buffer
       :company-docsig #'elisp--company-doc-string
       :company-location #'elisp--company-location
       :company-deprecated #'elisp--company-deprecated))))

この辺りはelisp-mode.elelisp-completion-at-point関数を大いに参考にさせてもらっています。というか内部的な関数も利用させてもらっています。まぁ、cape.elなんかも参照している部分がありますし、とりあえず良いんじゃないでしょうか。

こうしてみると結構簡単に作れるものですよね。org-modeでpcompleteなんか使う必要は無いような……。

他のリンクタイプ、 elisp-variable: elisp-face: elisp-library: にもそれぞれ補完関数があり、それらもorg-link-parameters:capf-path プロパティに設定すれば補完が出来るようになります。

おまけとして file: タイプに対する補完関数org-elisp-link-capf-path-fileも入れておきました。

(defun org-elisp-link-capf-path-file ()
  "Complete <filename> of [[<link-type>:<filename> at point."
  (when-let ((pos (or org-elisp-link-capf-pos
                      (org-elisp-link-capf-path-parse))))
    (let ((path-beg (nth 2 pos))
          (path-end (nth 3 pos)))
      (list
       path-beg path-end
       #'read-file-name-internal
       :annotation-function
       (lambda (str) (if (string-suffix-p "/" str) " Dir" " File"))
       :company-kind
       (lambda (str) (if (string-suffix-p "/" str) 'folder 'file))
       :exclusive 'no))))

これもread-file-name-internalなどという関数を使っていますが、やっぱりcape(cape-file)で使っていたのでそれに倣いました。

もはやelispリンクとは関係ありませんが、org-modeにリンクパスのcompletion-at-point機能が無いのが悪いんです。せっかく汎用的な仕組みを実装した以上、最低限 file: についても書いておくべきかなと思いました。

ちなみに file: だけでなく file+sys:file+emacs: にも同じ関数が使えます。 file+sys:file+emacs: って知ってました?

最終的に org-elisp-link.el の初期化は次のようになりました:

(with-eval-after-load "org"
  (require 'org-elisp-link)
  (org-elisp-link-initialize)

  (org-link-set-parameters "file"
                           :capf-path 'org-elisp-link-capf-path-file)
  (org-link-set-parameters "file+sys"
                           :capf-path 'org-elisp-link-capf-path-file)
  (org-link-set-parameters "file+emacs"
                           :capf-path 'org-elisp-link-capf-path-file)

  (add-hook 'org-mode-hook
            (lambda ()
              ;; 追加の順番よっては正しく動かないかも?
              (add-hook 'completion-at-point-functions
                        'org-elisp-link-completion-at-point nil t)))
  )

手元にはブログ専用リンクタイプ(blog:)なんてものもあるので、それも補完できると楽が出来そうです。補完関数はブログのディレクトリをdirectory-filesして少し加工すればいいだけなので簡単ですね。

例えば次のような感じでしょうか。(2024-02-23追記: org-link-completion.elを使うように書き替えました)

(require 'org-link-completion)

(defun my-org-blog-link-capf-path ()
  "ポイント上のリンクのパス部分を補完します。
[[blog:2024-02-20-hello-emacs]]のようなリンクの補完候補を返します。

ブログの元orgファイルは(plist-get blog :local-dir)で得られるディ
レクトリにあるものとします。"
  (org-link-completion-parse-let :path (type path-beg path-end)
    (when-let ((blog (my-blog-from-link-type type)))
      (list
       path-beg path-end
       (cl-loop for file in (directory-files (plist-get blog :local-dir))
                when (string-match "\\`\\(.+\\)\\.org\\'" file)
                collect (match-string 1 file))
       :company-kind (lambda (_) 'file)))))

(org-link-set-parameters "blog"
                         :capf-path 'my-org-blog-link-capf-path)
2024-02-18 ,

org-modeの補完を直す

最近補完まわりを色々改善したので気を良くしてあちこちで無駄に補完をさせて楽しんでいるのですが、org-modeの補完がイマイチうまく動かないことが多いです。色々調べた結果org-pcomplete.elに問題があることが分かってきました。なので少し直してみました。

見つけた問題はだいたい次の通りです:

  • リンクタイプが補完できない (→「org-modeでの入力補完」で解決済み)
  • #+ATTR_HTML等一部のキーワードが補完できない (→「org-modeでの入力補完」で解決済み)
  • 行の途中に区切り文字(スペースや[)があると、その行の末尾でリンクが補完できない
  • 行の途中にあるリンクが補完できない
  • 行の途中にある見出し検索リンクが補完できない (→最近1/7のコミット「Fix [[* completion when there is text after point」で解決済み)
  • 行の途中にあるTeX表記が補完できない
  • 右に既に優先度や見出しが入っている場合にTODOキーワードが補完できない

一番気になったのがリンクの補完です。例えば

[[
hoge [[
あれは[[

の末尾では補完できますが

hoge hoge [[
あれは[[file:hoge.txt]]または[[

の末尾では補完できません。日本語は空白で区切らないので最初は空白が入っていると同じ問題が起きることには気が付きませんでした。日本語でも二つ目以降のリンクが補完されません。

また、行の途中に戻って補完するのも無理なようです。基本的に行末で無ければ補完できません。

というわけで、それらを直すコードを作ってみました。

(with-eval-after-load "org-pcomplete"
  ;; 「#+」の部分を補完する関数。
  ;; ATTR_HTMLやBEGIN_FIGURES-COL2等を追加。
  ;; `pcomplete/org-mode/file-option'を置き換える。
  (defun my-pcomplete/org-mode/file-option ()
    "Complete against all valid file options."
    ;; org-pcomplete.elの`pcomplete/org-mode/file-option'よりコピーして改変
    (require 'org-element)
    (pcomplete-here
     (org-pcomplete-case-double
      (append (mapcar (lambda (keyword) (concat keyword " "))
                      org-options-keywords)
              (mapcar (lambda (keyword) (concat keyword ": "))
                      org-element-affiliated-keywords)
              ;; ★[変更]: 追加。
              (mapcar (lambda (keyword) (concat keyword ": "))
                      '("ATTR_HTML" "ATTR_ORG"))
              (let (block-names)
                (dolist (name
                         '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC"
                           "VERSE"
                           ;; ★[変更]: 追加。
                           "FIGURES-FLOW" "FIGURES-COL2" "FIGURES-COL3")
                         block-names)
                  (push (format "END_%s" name) block-names)
                  (push (concat "BEGIN_"
                                name
                                ;; Since language is compulsory in
                                ;; export blocks source blocks, add
                                ;; a space.
                                (and (member name '("EXPORT" "SRC")) " "))
                        block-names)
                  ;; ★[変更]: 削除。ATTR_CENTERって何だよ……
                  ;;(push (format "ATTR_%s: " name) block-names)
                  ))
              (mapcar (lambda (keyword) (concat keyword ": "))
                      (org-get-export-keywords))))
     (substring pcomplete-stub 2)))
  (advice-add 'pcomplete/org-mode/file-option :override
              'my-pcomplete/org-mode/file-option)

  ;; リンクを補完する関数。
  ;; link-abbrevだけでなくリンクタイプも補完させる。
  ;; `pcomplete/org-mode/link'を置き換える。
  (defun my-pcomplete/org-mode/link ()
    "Complete against defined #+LINK patterns."
    ;; org-pcomplete.elの`pcomplete/org-mode/link'よりコピーして改変
    (while ;;★[変更]: ←追加(ただし`my-org-parse-arguments'の修正で不要)
        (pcomplete-here
         (pcomplete-uniquify-list
          (copy-sequence
           (mapcar (lambda (e) (concat (car e) ":"))
                   (append org-link-abbrev-alist-local
                           org-link-abbrev-alist
                           ;; ★[変更]: 追加
                           org-link-parameters)))))))
  (advice-add 'pcomplete/org-mode/link :override 'my-pcomplete/org-mode/link)

  ;; 見出しへの検索リンク([[*)を補完する関数。
  ;; エラーが出るので最新のコミットでの修正を取りこむ。
  ;; `pcomplete/org-mode/searchhead'を置き換える。
  (defun my-pcomplete/org-mode/searchhead ()
    "Complete against all headings.
This needs more work, to handle headings with lots of spaces in them."
    (while (pcomplete-here
            (save-excursion
              (goto-char (point-min))
              (let (tbl)
                (while (re-search-forward org-outline-regexp nil t)
                  ;; Remove the leading asterisk from
                  ;; `org-link-heading-search-string' result.
                  (push (substring (org-link-heading-search-string) 1) tbl))
                (pcomplete-uniquify-list tbl)))
            ;; ★[変更]: この部分を削除。substringでpcomplete-stubが空の時にargs-out-of-rangeが出る。最新版では削除されてる。
            ;; ;; When completing a bracketed link, i.e., "[[*", argument
            ;; ;; starts at the star, so remove this character.
            ;; ;; Also, if the completion is done inside [[*head<point>]],
            ;; ;; drop the closing parentheses.
            ;; (replace-regexp-in-string
            ;;  "\\]+$" ""
            ;;  (substring pcomplete-stub 1))
            )))
  (advice-add 'pcomplete/org-mode/searchhead :override
              'my-pcomplete/org-mode/searchhead)

  ;; ★引数列の抽出部分を根本的に直す。
  ;; `org-parse-arguments'を置き換える。
  (defun my-org-parse-arguments ()
    "Parse whitespace separated arguments in the current region."
    (pcase (org-thing-at-point)
      ;; 2024-01-07のコミットで追加された部分
      ;; Fix [[* completion when there is text after point
      ;; https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/lisp/org-pcomplete.el?id=97951352bb4a32b06f0dede37cf5f796ad3f14c2
      (`("searchhead" . nil)
       ;; [[* foo<point> bar link::search option.
       ;; Arguments are not simply space-separated.
       (save-excursion
         (let ((origin (point)))
           (skip-chars-backward "^*" (line-beginning-position))
           (cons (list (buffer-substring-no-properties (point) origin))
                 (list (point))))))
      ;; 行指向の文法要素のみ行頭から引数を集める
      ((or `("file-option" . ,thing)
           `("block-option" . ,_))
       (let ((begin (line-beginning-position))
             ;; #+STARTUPはpcomplete-argsを参照しているので行末まで集める
             ;; (ただし最後の引数より前で補完が出来ないバグはそのままになる)
             (end (if (equal thing "startup") (line-end-position) (point)))
             begins args)
         (save-excursion
           (goto-char begin)
           (while (< (point) end)
             (skip-chars-forward " \t[")
             (push (point) begins)
             (skip-chars-forward "^ \t\n[")
             (push (buffer-substring-no-properties (car begins) (point))
                   args)))
         (cons (reverse args) (reverse begins))))
      ;; それ以外は基本的に直前のみを返す
      ;; リンクは[の後からリンクタイプの後(:があればそれも含む)まで
      (`("link")
       (save-excursion
         (skip-chars-backward "^[" (line-beginning-position))
         (let ((beg (point))
               (end (progn
                      (skip-chars-forward "-A-Za-z0-9_")
                      (if (eq (char-after) ?:) (1+ (point)) (point)))))
           (cons (list (buffer-substring-no-properties beg end))
                 (list beg)))))
      (_
       (save-excursion
         (let ((end (point)))
           (skip-chars-backward "^ \t\n[")
           ;; TODO: 現在の引数の末尾まで含めるか迷う
           (cons (list (buffer-substring-no-properties (point) end))
                 (list (point))))))))
  (advice-add 'org-parse-arguments :override 'my-org-parse-arguments)

  ;; 現在いる場所の文法要素を調べる関数。
  ;; ★`org-thing-at-point'で検出できなかったものを補う。
  (defun my-org-thing-at-point:after-until ()
    ;; 元の`org-thing-at-point'がnilを返したとき、
    (cond
     ;; [[type:のようにコロンの後でもlinkにする。
     ;; 補完するのはコロンまでなのだから、コロンまで含めるべき。
     ((save-excursion
        (skip-chars-backward ":" (1- (point)))
        (skip-chars-backward "-A-Za-z0-9_")
        (and (eq ?\[ (char-before))
             (eq ?\[ (char-before (1- (point))))))
      (cons "link" nil))
     ;; 既に右に見出しが入っているときのTODOキーワード
     ((save-excursion
        (let ((pos (point)))
          (goto-char (line-beginning-position))
          (save-match-data
            (and (looking-at "^\\*+ +\\([^ \t\\[]*\\)")
                 (<= (match-beginning 1) pos)
                 (<= pos (match-end 1))))))
      (cons "todo" nil))))
  (advice-add 'org-thing-at-point :after-until
              'my-org-thing-at-point:after-until)

  ) ;; End of with-eval-after-load "org-pcomplete"

org-modeでの入力補完」ですでに書いたコードも含めているので少々長くなっています。

一番大きな原因はorg-parse-arguments関数の動作にあるようです。他の同種の関数(pcomplete-parse-arguments-function変数に設定される関数)であるpcomplete-parse-comint-arguments(shellのコマンドラインの補完に使われる)と比べてみるとよく分かるのですが、org-parse-argumentsは現在の行の頭から末尾まで全てを解析してしまっている一方pcomplete-parse-comint-argumentsは現在ポイントが指している引数までしか解析しません。pcompleteはそれらが返した引数列の最後の要素しか補完しないので、org-modeでは行末部分でしか補完されません。

org-parse-argumentsがなぜ行の末尾まで解析しているのかは不明ですが、pcomplete/org-mode/file-option/startupにはpcomplete-argsを参照して排他的なオプションを候補から外す処理をしているので、その時に末尾まで解析するように修正したのかもしれません。あくまで想像ですが。

いずれにせよ、基本的にはorg-parse-argumentsが返すのは現在のポイントが指している引数(字句)までに限るべきです。そうでないと行の途中で補完できなくなってしまいます。

そもそも「#+」のような行指向の文法要素なら別ですが、リンクやTeX表記などはポイントが指している字句のみを返せば十分であり、行頭から解析する必要は全くありません。最近(1月7日に) [[* で始まるリンク(見出し検索リンク)に対する修正が入りましたが(Fix [[* completion when there is text after point)これもその点は分かっているようで、ポイントが指している部分しか返していません。

上に書いたmy-org-parse-arguments関数の部分はその辺りを修正しました。

二つ目以降のリンクが補完されない原因はpcomplete/org-mode/link関数内のpcomplete-hereの前にwhileが無いからなのですが、org-parse-argumentsがポイントが指している部分しか返さないようにすればwhileが無くても問題ありません。

TODOキーワードが空の見出しで無ければ補完されないのはマニュアルにも書いてある(Completion (The Org Manual))ので仕様なのですが、一応修正しました。

単語の途中にポイントを置いて補完したときにどうなるべきなのかは微妙な問題な気がします。基本的にはその単語を置き換えるように動作すべきだと思うのですが、現状では必ずしもそうはなっていません。Corfuが有効だとエラーが発生するケースもありました。Corfuを無効化するとエラーは出なくなるのですが、かといって正しく補完されるわけでも無く単に空白が一文字挿入されるだけだったりします。よく分からないので未解決です。

pcompleteのことは詳しくないのですが、元々コマンドラインの補完をするためのライブラリなのでしょうか? org-modeの補完に利用するのが適切なのかは正直疑問だと思います。org-thing-at-pointで調べたものをorg-parse-argumentsで再度調べ直さなければならないような状況に陥っていますし、使わずに書いた方がスッキリしそうな気がします。まぁ、補完関数に必要な処理を全て知らないので分かりませんが。

2024-02-17

Emacsのコンテキストメニューをキーから開く

Emacs28から(?)context-menu-modeというグローバルマイナーモードがあって有効にしてどこかを右クリックするとコンテキストメニューが出ます。

diredでファイルを右クリックした画面
図1: diredでファイルを右クリックした画面

常々「何が出来るのかわかんねーよC-h mは見づらいし、マニュアル読め? あんなの全部読めるわけ無いだろ、というか覚えておけるわけ無いだろ」と思っている人間にはとても素晴らしい機能だと思います。

左手でポテチをつまみながらリラックスして右手でマウスを握って操作をしたい人にも良いですね。

といっても普通にキーボードで操作しているときには逆に使いづらいのです。このメニューはMS-Windowsだとアプリケーションキー(またはShift+F10)でも開けるのですが右クリックと同じメニュー(x-popup-menuによる)が出てきてしまいます。もちろん矢印キーで操作できるのですが、C-n等は使えません。私はいまだにXKeymacsを使っているので一般的なWindowsアプリケーションはたいていEmacsキーバインドで使えるのですが、Emacsには適用されないように設定しています。Emacsはそんなの無くてもEmacsキーバインドで使えますし、XKeymacsの不完全なエミュレーションを使う必要は無いですからね。でもx-popup-menuで表示されるWindows標準のメニューUIにも効果が無くなってしまうわけです。困った困った。

メニューバーの方も同じ問題があってF10を押すとメニューバーにキーフォーカスが移るのですが、こちらも矢印キーしか受け付けません。(ちなみに私は機能の存在を発見しやすくするためにメニューバーは表示したままにしています。使うことはそれほど多くはありません)

ただし、メニューバーを非表示にしているときはF10を押すとCUIでメニューが出てきます。menu-bar-openのコードを呼んでみるとtmm-menubartmm-promptという流れになっています。試しに M-: (tmm-prompt (context-menu-map)) を実行してみるとCUIでコンテキストメニューが表示されました。

diredで(tmm-prompt (context-menu-map))を評価した画面
図2: diredで(tmm-prompt (context-menu-map))を評価した画面

見た目が少しイモっぽいですがちゃんとメニューとして機能します。同じ物が二つ表示されてるのは vertico-mode のせいですね。後でどちらかを非表示にしないと。

とりあえず次のようにしておけばアプリケーションキーやShift+F10でtmm-promptを使ったコンテキストメニューが表示できます。

(with-eval-after-load "mouse"
  (defun my-context-menu-open-tmm ()
    (interactive)
    (tmm-prompt (context-menu-map)))

  (define-key global-map (kbd "S-<f10>") 'my-context-menu-open-tmm)
  (define-key context-menu-mode-map (kbd "<apps>") 'my-context-menu-open-tmm)
  (define-key context-menu-mode-map (kbd "<menu>") 'my-context-menu-open-tmm))

というかcontext-menu-openのdocstringには「Start key navigation of the context menu.」って書かれてるんですけどね。うーん……。context-menu-open関数自体を置き換えてしまってもいいかもしれませんね。もしくはremapする?

まぁそもそも始めから M-` を押してtmm-menubarを開くのでもたいていの場合は間に合ってしまいますが。今のところ内容はほとんど被っているようですし。もう少し現在の位置に応じて色々変えてくれるともっと使いやすくなりそうですね。org-modeなんてTableの位置でもないのにTableなんてメニュー項目を出してくるなと言いたい。

(追記)

Verticoとの兼ね合いをどうするかについて。とりあえずtmm-prompt関数ではVerticoを一時的に無効にしてみました。Verticoを使うと1文字入力だけでメニュー項目を選択出来なかったので。ヘルプを消したり"==>"を":"にしたりして見た目もちょっとスッキリに。

(defun my-tmm-prompt:around (oldfun &rest args)
  (let ((tmm-completion-prompt "")
        (tmm-mid-prompt ":")
        (completion-show-help nil))
    (if (and (boundp 'vertico-mode) vertico-mode)
        ;; verticoがある場合
        (if t
            ;; verticoを無効にする場合
            ;; 一時的にverticoを無効にして実行
            (unwind-protect
                (progn
                  (vertico-mode -1)
                  (apply oldfun args))
              (vertico-mode 1))
          ;; verticoを使う場合 (いまいち)
          (cl-letf (((symbol-function 'tmm-add-prompt) #'ignore)
                    (vertico-count 20))
            (apply oldfun args)))
      ;; そのまま実行
      (apply oldfun args))))
(advice-add 'tmm-prompt :around 'my-tmm-prompt:around)
2024-02-16 ,

org-modeでの入力補完

org-modeでの補完候補はorg-pcomplete.elで設定しているようで、特に#+で始まるオプションについてはpcomplete/org-mode/file-option関数で候補を生成しています。そのソースコードは次の通りです。

;; org-pcomplete.elより引用
(defun pcomplete/org-mode/file-option ()
  "Complete against all valid file options."
  (require 'org-element)
  (pcomplete-here
   (org-pcomplete-case-double
    (append (mapcar (lambda (keyword) (concat keyword " "))
                    org-options-keywords)
            (mapcar (lambda (keyword) (concat keyword ": "))
                    org-element-affiliated-keywords)
            (let (block-names)
              (dolist (name
                       '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC"
                         "VERSE")
                       block-names)
                (push (format "END_%s" name) block-names)
                (push (concat "BEGIN_"
                              name
                              ;; Since language is compulsory in
                              ;; export blocks source blocks, add
                              ;; a space.
                              (and (member name '("EXPORT" "SRC")) " "))
                      block-names)
                (push (format "ATTR_%s: " name) block-names)))
            (mapcar (lambda (keyword) (concat keyword ": "))
                    (org-get-export-keywords))))
   (substring pcomplete-stub 2)))

この関数で次のような文字列を補完候補として生成しています。

なぜこれを調べたかというと、 #+ATTR_HTML が補完候補に現れないことに気が付いたからです。

理由は上のコードを見れば分かるとおり、ATTR_で始まるものはCENTER、COMMENT、EXAMPLE、EXPORT、QUOTE、SRC、VERSEしか登録していないからです。

え、ちょっと待って? #+ATTR_CENTER: #+ATTR_COMMENT: #+ATTR_EXAMPLE: #+ATTR_EXPORT: #+ATTR_QUOTE: #+ATTR_SRC: #+ATTR_VERSE: なんてありましたっけ? 聞いたこともありませんし使ったこともありません。ちょっと検索しても分かりませんでした。どういうこと??

ATTR_HTMLはエクスポートキーワードの中にあるのかなとも思ったのですが、そういうわけでも無さそうです。

ATTR_HTMLを追加しようにもこの関数の途中に処理を挟むのは難しいので、諦めて全部上書きしてしまうことにしました。ついでに独自のspecial blocks(org-special-blocks.el ― turn blocks into LaTeX envs and HTML divs)も補完候補に加えます(#+begin_figures-col2<div class="figures-col2> にしてくれます)。ATTR_CENTER等は削除してしまいましょう。よく分かりませんし、使いませんし。

(with-eval-after-load "org-pcomplete"
  ;; org-pcomplete.elの`pcomplete/org-mode/file-option'よりコピーして改変
  (defun pcomplete/org-mode/file-option ()
    "Complete against all valid file options."
    (require 'org-element)
    (pcomplete-here
     (org-pcomplete-case-double
      (append (mapcar (lambda (keyword) (concat keyword " "))
                      org-options-keywords)
              (mapcar (lambda (keyword) (concat keyword ": "))
                      org-element-affiliated-keywords)
              ;; ★[変更]: 追加
              (mapcar (lambda (keyword) (concat keyword ": "))
                      '("ATTR_HTML" "ATTR_ORG"))
              (let (block-names)
                (dolist (name
                         '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC"
                           "VERSE"
                           ;; ★[変更]: 追加。CSSで画像を並べるのに使っています
                           "FIGURES-FLOW" "FIGURES-COL2" "FIGURES-COL3")
                         block-names)
                  (push (format "END_%s" name) block-names)
                  (push (concat "BEGIN_"
                                name
                                ;; Since language is compulsory in
                                ;; export blocks source blocks, add
                                ;; a space.
                                (and (member name '("EXPORT" "SRC")) " "))
                        block-names)
                  ;; ★[変更]: 削除。ATTR_CENTERって何……?
                  ;;(push (format "ATTR_%s: " name) block-names)
                  ))
              (mapcar (lambda (keyword) (concat keyword ": "))
                      (org-get-export-keywords))))
     (substring pcomplete-stub 2))))

この所Corfuの自動補完をいじっていましたが、もちろんこれらの設定も自動補完に影響します。 #+beg くらいまで打てば自動で補完候補が出現します。corfu-auto-prefixが3なので#+の後に3文字入力したら表示されるのでしょう。

本当は #+ と入力しただけで補完候補が現れてくれればいいのですが。

一応次のようにすれば実現出来ます(corfu--auto-complete-deferredにいったい幾つadviceを仕掛けるつもりだ)。

(defun my-corfu--auto-complete-deferred:around:for-org (oldfun &rest args)
  (let (;; org-modeで#+が出たら即自動補完する
        (corfu-auto-prefix
         (if (and (derived-mode-p 'org-mode) ;;org-modeで……
                  ;; <bol><spaces>#+<identifier>
                  (save-excursion
                    (and (skip-chars-backward "-A-Za-z0-9_+")
                         (eq (char-before) ?+)
                         (eq (char-before (1- (point))) ?#)
                         (goto-char (- (point) 2))
                         (skip-chars-backward " \t")
                         (bolp))))
             0
           corfu-auto-prefix)))
    (apply oldfun args)))
(advice-add 'corfu--auto-complete-deferred :around
            #'my-corfu--auto-complete-deferred:around:for-org)

[[ を入力したらリンクタイプも補完してほしいんですよね。先日書いたやつ[[elisp-function: を入力するのが大変なので(よくfucntionやらfunctoinやら打ち間違えます。やっぱり [[elfun: にでもしておけば良かったかな)。 まぁ、そのうち。

(追記:リンクタイプも補完するようにしました)

ああよく見たら、同じくorg-pcomplete.elpcomplete/org-mode/linkというのがあるんですね。

;; org-pcomplete.elより引用
(defun pcomplete/org-mode/link ()
  "Complete against defined #+LINK patterns."
  (pcomplete-here
   (pcomplete-uniquify-list
    (copy-sequence
     (mapcar (lambda (e) (concat (car e) ":"))
             (append org-link-abbrev-alist-local
                     org-link-abbrev-alist))))))

リンクタイプを差し置いてlink abbrevだけあるのかよ!

まぁ、これもそのまま修正しちゃいましょう。(2024-02-23追記:org-link-completion.elでリンクタイプを補完できるようにしたので、それを使えば次の変更は不要です)

(with-eval-after-load "org-pcomplete"
  ;; org-pcomplete.elの`pcomplete/org-mode/link'よりコピーして改変
  (defun pcomplete/org-mode/link ()
    "Complete against defined #+LINK patterns."
    (pcomplete-here
     (pcomplete-uniquify-list
      (copy-sequence
       (mapcar (lambda (e) (concat (car e) ":"))
               (append org-link-abbrev-alist-local
                       org-link-abbrev-alist
                       ;; ★[変更]: 追加
                       org-link-parameters)))))))

上で書いたコードもちょっと修正して [[ で自動補完が開始されるようにしましょう。あ、ソースコードブロック中の [[ にも反応しちゃうかな。まあいいや。

(defun my-corfu--auto-complete-deferred:around:for-org (oldfun &rest args)
  (let (;; org-modeで#+や[[が出たら即自動補完する
        (corfu-auto-prefix
         (if (and (derived-mode-p 'org-mode) ;;org-modeで……
                  (or
                   ;; <bol><spaces>#+<identifier>
                   (save-excursion
                     (and (skip-chars-backward "-A-Za-z0-9_")
                          (eq (char-before) ?+)
                          (eq (char-before (1- (point))) ?#)
                          (goto-char (- (point) 2))
                          (skip-chars-backward " \t")
                          (bolp)))
                   ;; [[<link-type>
                   (save-excursion
                     (and (skip-chars-backward "-A-Za-z0-9_+") ;;file+sysがある
                          (eq (char-before) ?\[)
                          (eq (char-before (1- (point))) ?\[)))
                   ;; (2024-02-18追記:見出しの補完を追加)
                   ;; [[*<heading>
                   (save-excursion
                     (and (skip-chars-backward "^*\t\n[")
                          (eq (char-before) ?*)
                          (eq (char-before (1- (point))) ?\[)
                          (eq (char-before (- (point) 2)) ?\[)))))
             0
           corfu-auto-prefix)))
    (apply oldfun args)))
(advice-add 'corfu--auto-complete-deferred :around
            #'my-corfu--auto-complete-deferred:around:for-org)
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へ移行して使わなくなったので削除。
  )