Recent Posts

2025-03-08

Emacsでキー入力を補助するためのツールバーを改善する

Emacs 30からmodifier-bar-modeが追加されました。これは修飾キーの入力ボタンを表示するグローバルマイナーモードです。

M-x modifier-bar-modeとタイプすると次のようなツールバーが表示されます(ツールバーの一種なので、先にtool-bar-mode等でツールバー自体も表示しておく必要があると思います)。

modifier-bar-mode
図1: modifier-bar-mode

見ての通りボタンはCtrl、Shift、Meta、Alt、Super、Hyperの六つです。例えばC-M-iと入力したければCtrlボタンとMetaボタンを押してからiを押せば良いということになります。

もちろん普通のキーボードを使っていれば必要になることはほとんど無いと思いますが、AndroidでCtrl等が無いソフトキーボードを使っているときは重宝するでしょう。PCでも左手でポテチをつまみながら右手でマウスを握りリラックスしながらポチポチやってるときには便利かもしれません。

とは言え、実際Androidスマホでこれを使ってみたところ、案外痒いところに手が届かないと言いましょうか、これじゃ全然足りないよ！　という気持ちになりました。

スマホで使用するソフトキーボードというのは本当にキーが小さくて押しづらいです。Hacker's Keyboardはちゃんと修飾キーも押せるソフトキーボードですが、Ctrl、xと押すだけでもキーが小さすぎて神経を使います。1キーでC-xまで入力させてほしいのです。他にも1ボタンで入力できれば便利なキーは沢山あります。

そこで、このmodifier-bar-modeを元に自分なりのキー入力補助ツールバーを作ってみました。それを有効にすると次のようになります。

my-tool-bar-mode
図2: my-tool-bar-mode
  • 修飾キーは C- S- M- の三つで簡素に表示します。
  • A- s- H- はスペースの都合で諦めました。どうせ使わないでしょう。
  • C-x C-c というプレフィックスはやはり1ボタンで入力したいところ。
  • 追加で C-x や C-c の後にさらに C- を続けるパターンもボタン化しました。
  • M-x はメニューのEdit→Execute Commandでも呼び出せますが、やはり1ボタンにしたいです。
  • C-g もなんだかんだ言って欲しくなります。
  • 矢印キーの上と下は普通の日本語IMEを使っているときに重宝します。GboardにせよATOKにせよ左右キーはあっても上下キーは無いからです。

というわけで以下ソースコード。 

(require 'tool-bar)

(defconst my-tool-bar-svg-alist
  '(("C-" . "<g><path d=\"M9.0 5.2C9.0 5.0 9.0 4.6 8.5 4.6 8.2 4.6 8.1 4.7 8.0 4.8 8.0 4.9 8.0 4.9 7.8 5.4 7.2 4.9 6.5 4.6 5.6 4.6 3.5 4.6 1.6 6.8 1.6 9.8 1.6 12.9 3.5 15.1 5.6 15.1 7.6 15.1 9.0 13.6 9.0 12.1 9.0 11.6 8.6 11.6 8.4 11.6 8.3 11.6 7.9 11.6 7.9 12.1 7.7 13.7 6.4 14.1 5.7 14.1 4.2 14.1 2.8 12.3 2.8 9.8 2.8 7.3 4.2 5.6 5.7 5.6 6.7 5.6 7.6 6.3 7.8 7.7 7.9 8.0 7.9 8.2 8.4 8.2 9.0 8.2 9.0 7.9 9.0 7.6Z\" /><path d=\"M16.7 10.4C16.9 10.4 17.5 10.4 17.5 9.8S16.9 9.2 16.7 9.2H11.4C11.2 9.2 10.6 9.2 10.6 9.8 10.6 10.4 11.2 10.4 11.4 10.4Z\" /></g>")
    ("S-" . "<g><path d=\"M5.9 10.3C6.3 10.4 7.7 10.8 7.7 12.2 7.7 13.1 7.0 14.0 5.7 14.0 5.2 14.0 4.4 14.0 3.7 13.5 3.0 13.1 3.0 12.4 3.0 12.1 2.9 11.8 2.9 11.5 2.4 11.5 1.8 11.5 1.8 11.9 1.8 12.2V14.4C1.8 14.6 1.8 15.1 2.3 15.1 2.7 15.1 2.8 14.8 2.9 14.3 3.6 14.8 4.6 15.1 5.7 15.1 7.6 15.1 8.8 13.6 8.8 12.1 8.8 11.1 8.2 10.4 8.0 10.1 7.3 9.5 6.9 9.4 5.6 9.1L4.2 8.8C3.5 8.6 2.9 8.0 2.9 7.2 2.9 6.3 3.7 5.5 4.9 5.5 6.9 5.5 7.1 7.1 7.2 7.6 7.3 8.0 7.4 8.1 7.8 8.1 8.4 8.1 8.4 7.7 8.4 7.4V5.2C8.4 4.9 8.4 4.5 7.9 4.5 7.5 4.5 7.4 4.8 7.2 5.3 6.6 4.7 5.7 4.5 4.9 4.5 3.1 4.5 1.8 5.8 1.8 7.3 1.8 8.4 2.6 9.5 4.0 9.9 4.0 9.9 5.6 10.3 5.9 10.3Z\" /><path d=\"M16.7 10.4C16.9 10.4 17.5 10.4 17.5 9.8S16.9 9.2 16.7 9.2H11.4C11.2 9.2 10.6 9.2 10.6 9.8S11.2 10.4 11.4 10.4Z\" /></g>")
    ("M-" . "<g><path d=\"M5.8 8.7C5.6 9.3 5.4 9.8 5.3 10.3H5.3C5.1 9.5 3.7 5.2 3.6 5.1 3.5 4.7 3.1 4.7 2.8 4.7H1.9C1.6 4.7 1.2 4.7 1.2 5.2 1.2 5.7 1.6 5.7 2.1 5.7V13.8C1.6 13.8 1.2 13.8 1.2 14.3 1.2 14.8 1.6 14.8 1.9 14.8H3.3C3.5 14.8 3.9 14.8 3.9 14.3 3.9 13.8 3.6 13.8 3.0 13.8V5.9H3.1C3.2 6.7 4.3 9.9 4.4 10.1 4.5 10.5 4.7 11.1 4.8 11.2 4.9 11.3 5.1 11.5 5.3 11.5 5.5 11.5 5.8 11.3 5.9 11.1 5.9 11.0 7.4 6.8 7.6 5.9H7.6V13.8C7.0 13.8 6.7 13.8 6.7 14.3 6.7 14.8 7.1 14.8 7.4 14.8H8.7C9.0 14.8 9.4 14.8 9.4 14.3 9.4 13.8 9.0 13.8 8.5 13.8V5.7C9.0 5.7 9.4 5.7 9.4 5.2 9.4 4.7 9.0 4.7 8.7 4.7H7.8C7.1 4.7 7.0 4.9 6.9 5.3Z\" /><path d=\"M16.7 10.3C16.9 10.3 17.5 10.3 17.5 9.8S16.9 9.2 16.7 9.2H11.4C11.2 9.2 10.6 9.2 10.6 9.8S11.2 10.3 11.4 10.3Z\" /></g>")
    ("A-" . "<g><path d=\"M6.2 5.1C6.1 4.5 5.8 4.4 5.3 4.4 4.8 4.4 4.6 4.4 4.4 5.1L2.4 13.8C2.2 13.8 1.8 13.8 1.7 13.8 1.5 13.9 1.4 14.1 1.4 14.3 1.4 14.8 1.8 14.8 2.1 14.8H3.8C4.1 14.8 4.5 14.8 4.5 14.3 4.5 13.8 4.2 13.8 3.6 13.8L4.0 12.1H6.7L7.0 13.8C6.4 13.8 6.1 13.8 6.1 14.3 6.1 14.8 6.5 14.8 6.8 14.8H8.5C8.8 14.8 9.2 14.8 9.2 14.3 9.2 14.1 9.1 13.9 8.9 13.8 8.8 13.8 8.5 13.8 8.2 13.8ZM5.3 5.8H5.3L6.4 11.1H4.2Z\" /><path d=\"M16.7 10.3C16.9 10.3 17.5 10.3 17.5 9.7S16.9 9.1 16.7 9.1H11.4C11.2 9.1 10.6 9.1 10.6 9.7S11.2 10.3 11.4 10.3Z\" /></g>")
    ("s-" . "<g><path d=\"M5.9 10.5C5.5 10.5 5.2 10.4 4.8 10.3 4.3 10.3 3.2 10.1 3.2 9.4 3.2 9.0 3.7 8.5 5.3 8.5 6.7 8.5 6.9 9.0 6.9 9.4 7.0 9.7 7.0 10.0 7.5 10.0 8.1 10.0 8.1 9.6 8.1 9.3V8.1C8.1 7.9 8.1 7.5 7.6 7.5 7.2 7.5 7.1 7.7 7.1 7.8 6.4 7.5 5.6 7.5 5.3 7.5 2.5 7.5 2.1 8.8 2.1 9.4 2.1 10.9 3.9 11.2 5.4 11.5 6.2 11.6 7.6 11.8 7.6 12.7 7.6 13.3 7.0 13.9 5.4 13.9 4.7 13.9 3.7 13.7 3.3 12.4 3.2 12.1 3.2 11.9 2.7 11.9 2.1 11.9 2.1 12.2 2.1 12.6V14.2C2.1 14.5 2.1 14.9 2.6 14.9 2.8 14.9 3.1 14.9 3.3 14.2 4.1 14.8 5.0 14.9 5.4 14.9 8.1 14.9 8.6 13.5 8.6 12.7 8.6 11.0 6.4 10.6 5.9 10.5Z\" /><path d=\"M16.7 10.3C16.9 10.3 17.5 10.3 17.5 9.7S16.9 9.1 16.7 9.1H11.4C11.2 9.1 10.6 9.1 10.6 9.7S11.2 10.3 11.4 10.3Z\" /></g>")
    ("H-" . "<g><path d=\"M8.2 5.6H8.6C8.9 5.6 9.3 5.6 9.3 5.1 9.3 4.6 8.9 4.6 8.6 4.6H6.7C6.4 4.6 6.0 4.6 6.0 5.1 6.0 5.6 6.4 5.6 6.7 5.6H7.1V9.0H3.5V5.6H4.0C4.2 5.6 4.6 5.6 4.6 5.1 4.6 4.6 4.2 4.6 4.0 4.6H2.0C1.7 4.6 1.3 4.6 1.3 5.1 1.3 5.6 1.7 5.6 2.0 5.6H2.4V13.7H2.0C1.7 13.7 1.3 13.7 1.3 14.2 1.3 14.7 1.7 14.7 2.0 14.7H4.0C4.2 14.7 4.6 14.7 4.6 14.2 4.6 13.7 4.2 13.7 4.0 13.7H3.5V10.0H7.1V13.7H6.7C6.4 13.7 6.0 13.7 6.0 14.2 6.0 14.7 6.4 14.7 6.7 14.7H8.6C8.9 14.7 9.3 14.7 9.3 14.2 9.3 13.7 8.9 13.7 8.6 13.7H8.2Z\" /><path d=\"M16.7 10.2C16.9 10.2 17.5 10.2 17.5 9.6S16.9 9.1 16.7 9.1H11.4C11.2 9.1 10.6 9.1 10.6 9.6S11.2 10.2 11.4 10.2Z\" /></g>")
    ("Mx" . "<g><path d=\"M5.8 8.6C5.6 9.2 5.4 9.6 5.3 10.1H5.3C5.1 9.3 3.7 5.0 3.6 4.9 3.5 4.5 3.1 4.5 2.8 4.5H1.9C1.6 4.5 1.2 4.5 1.2 5.0 1.2 5.6 1.6 5.6 2.1 5.6V13.7C1.6 13.7 1.2 13.7 1.2 14.2 1.2 14.7 1.6 14.7 1.9 14.7H3.3C3.5 14.7 3.9 14.7 3.9 14.2 3.9 13.7 3.6 13.7 3.0 13.7V5.8H3.1C3.2 6.5 4.3 9.7 4.4 9.9 4.5 10.3 4.7 10.9 4.8 11.1 4.9 11.2 5.1 11.3 5.3 11.3 5.5 11.3 5.8 11.2 5.9 10.9 5.9 10.8 7.4 6.6 7.6 5.8H7.6V13.7C7.0 13.7 6.7 13.7 6.7 14.2 6.7 14.7 7.1 14.7 7.4 14.7H8.7C9.0 14.7 9.4 14.7 9.4 14.2 9.4 13.7 9.0 13.7 8.5 13.7V5.6C9.0 5.6 9.4 5.6 9.4 5.0 9.4 4.5 9.0 4.5 8.7 4.5H7.8C7.1 4.5 7.0 4.8 6.9 5.2Z\" /><path d=\"M14.5 11.0 16.4 8.6H17.0C17.3 8.6 17.7 8.6 17.7 8.1 17.7 7.5 17.3 7.5 17.0 7.5H15.1C14.8 7.5 14.4 7.5 14.4 8.0 14.4 8.6 14.8 8.6 15.2 8.6L14.0 10.2 12.7 8.6C13.2 8.6 13.5 8.6 13.5 8.0 13.5 7.5 13.1 7.5 12.9 7.5H10.9C10.7 7.5 10.2 7.5 10.2 8.1 10.2 8.6 10.7 8.6 10.9 8.6H11.6L13.5 11.0 11.5 13.7H10.8C10.6 13.7 10.1 13.7 10.1 14.2 10.1 14.7 10.6 14.7 10.8 14.7H12.8C13.0 14.7 13.4 14.7 13.4 14.2 13.4 13.7 13.1 13.7 12.6 13.7L14.0 11.6 15.5 13.7C15.0 13.7 14.6 13.7 14.6 14.2 14.6 14.7 15.1 14.7 15.3 14.7H17.3C17.5 14.7 17.9 14.7 17.9 14.2 17.9 13.7 17.5 13.7 17.3 13.7H16.6Z\" /></g>")
    ("Cx" . "<g><path d=\"M9.0 5.0C9.0 4.7 9.0 4.3 8.5 4.3 8.2 4.3 8.1 4.5 8.0 4.6 8.0 4.7 8.0 4.7 7.8 5.1 7.2 4.7 6.5 4.3 5.6 4.3 3.5 4.3 1.6 6.6 1.6 9.6 1.6 12.6 3.5 14.9 5.6 14.9 7.6 14.9 9.0 13.4 9.0 11.9 9.0 11.3 8.6 11.3 8.4 11.3 8.3 11.3 7.9 11.3 7.9 11.8 7.7 13.4 6.4 13.8 5.7 13.8 4.2 13.8 2.8 12.1 2.8 9.6 2.8 7.1 4.2 5.3 5.7 5.3 6.7 5.3 7.6 6.1 7.8 7.5 7.9 7.7 7.9 8.0 8.4 8.0 9.0 8.0 9.0 7.7 9.0 7.3Z\" /><path d=\"M14.5 11.0 16.4 8.5H17.0C17.3 8.5 17.7 8.5 17.7 8.0 17.7 7.5 17.3 7.5 17.0 7.5H15.1C14.8 7.5 14.4 7.5 14.4 8.0 14.4 8.5 14.8 8.5 15.2 8.5L14.0 10.2 12.7 8.5C13.2 8.5 13.5 8.5 13.5 8.0 13.5 7.5 13.1 7.5 12.9 7.5H10.9C10.7 7.5 10.2 7.5 10.2 8.0 10.2 8.5 10.7 8.5 10.9 8.5H11.6L13.5 11.0 11.5 13.7H10.8C10.6 13.7 10.1 13.7 10.1 14.2 10.1 14.7 10.6 14.7 10.8 14.7H12.8C13.0 14.7 13.4 14.7 13.4 14.2 13.4 13.7 13.1 13.7 12.6 13.7L14.0 11.6 15.5 13.7C15.0 13.7 14.6 13.7 14.6 14.2 14.6 14.7 15.1 14.7 15.3 14.7H17.3C17.5 14.7 17.9 14.7 17.9 14.2 17.9 13.7 17.5 13.7 17.3 13.7H16.6Z\" /></g>")
    ("CxC" . "<g><path d=\"M9.0 5.0C9.0 4.7 9.0 4.3 8.5 4.3 8.2 4.3 8.1 4.5 8.0 4.6 8.0 4.6 8.0 4.7 7.8 5.1 7.2 4.6 6.5 4.3 5.6 4.3 3.5 4.3 1.6 6.5 1.6 9.5 1.6 12.6 3.5 14.8 5.6 14.8 7.6 14.8 9.0 13.3 9.0 11.8 9.0 11.3 8.6 11.3 8.4 11.3 8.3 11.3 7.9 11.3 7.9 11.8 7.7 13.4 6.4 13.8 5.7 13.8 4.2 13.8 2.8 12.0 2.8 9.5 2.8 7.1 4.2 5.3 5.7 5.3 6.7 5.3 7.6 6.1 7.8 7.4 7.9 7.7 7.9 8.0 8.4 8.0 9.0 8.0 9.0 7.6 9.0 7.3Z\" /><path d=\"M14.5 10.9 16.4 8.5H17.0C17.3 8.5 17.7 8.5 17.7 8.0 17.7 7.5 17.3 7.5 17.0 7.5H15.1C14.8 7.5 14.4 7.5 14.4 8.0 14.4 8.5 14.8 8.5 15.2 8.5L14.0 10.2 12.7 8.5C13.2 8.5 13.5 8.5 13.5 8.0 13.5 7.5 13.1 7.5 12.9 7.5H10.9C10.7 7.5 10.2 7.5 10.2 8.0 10.2 8.5 10.7 8.5 10.9 8.5H11.6L13.5 10.9 11.5 13.6H10.8C10.6 13.6 10.1 13.6 10.1 14.1 10.1 14.6 10.6 14.6 10.8 14.6H12.8C13.0 14.6 13.4 14.6 13.4 14.1 13.4 13.6 13.1 13.6 12.6 13.6L14.0 11.6 15.5 13.6C15.0 13.6 14.6 13.6 14.6 14.1 14.6 14.6 15.1 14.6 15.3 14.6H17.3C17.5 14.6 17.9 14.6 17.9 14.1 17.9 13.6 17.5 13.6 17.3 13.6H16.6Z\" /><path d=\"M26.5 5.0C26.5 4.7 26.5 4.3 26.0 4.3 25.7 4.3 25.6 4.5 25.5 4.6 25.5 4.6 25.5 4.7 25.3 5.1 24.7 4.6 23.9 4.3 23.1 4.3 20.9 4.3 19.1 6.5 19.1 9.5 19.1 12.6 20.9 14.8 23.1 14.8 25.0 14.8 26.5 13.3 26.5 11.8 26.5 11.3 26.1 11.3 25.9 11.3 25.7 11.3 25.4 11.3 25.3 11.8 25.2 13.4 23.9 13.8 23.2 13.8 21.7 13.8 20.2 12.0 20.2 9.5 20.2 7.1 21.7 5.3 23.2 5.3 24.2 5.3 25.1 6.1 25.3 7.4 25.4 7.7 25.4 8.0 25.9 8.0 26.5 8.0 26.5 7.6 26.5 7.3Z\" /></g>")
    ("Cc" . "<g><path d=\"M9.0 4.9C9.0 4.7 9.0 4.3 8.5 4.3 8.2 4.3 8.1 4.4 8.0 4.5 8.0 4.6 8.0 4.6 7.8 5.1 7.2 4.6 6.5 4.3 5.6 4.3 3.5 4.3 1.6 6.5 1.6 9.5 1.6 12.6 3.5 14.8 5.6 14.8 7.6 14.8 9.0 13.3 9.0 11.8 9.0 11.3 8.6 11.3 8.4 11.3 8.3 11.3 7.9 11.3 7.9 11.7 7.7 13.4 6.4 13.8 5.7 13.8 4.2 13.8 2.8 12.0 2.8 9.5 2.8 7.0 4.2 5.3 5.7 5.3 6.7 5.3 7.6 6.0 7.8 7.4 7.9 7.7 7.9 7.9 8.4 7.9 9.0 7.9 9.0 7.6 9.0 7.2Z\" /><path d=\"M17.4 12.8C17.4 12.3 17.0 12.3 16.9 12.3 16.6 12.3 16.4 12.4 16.3 12.7 16.2 12.9 15.9 13.7 14.7 13.7 13.2 13.7 12.0 12.5 12.0 11.0 12.0 10.2 12.5 8.3 14.8 8.3 15.1 8.3 15.8 8.3 15.8 8.4 15.8 9.0 16.1 9.3 16.5 9.3S17.2 9.0 17.2 8.5C17.2 7.3 15.5 7.3 14.8 7.3 11.9 7.3 10.9 9.5 10.9 11.0 10.9 13.0 12.5 14.7 14.6 14.7 16.9 14.7 17.4 13.1 17.4 12.8Z\" /></g>")
    ("CcC" . "<g><path d=\"M9.0 4.9C9.0 4.6 9.0 4.2 8.5 4.2 8.2 4.2 8.1 4.4 8.0 4.5 8.0 4.6 8.0 4.6 7.8 5.0 7.2 4.6 6.5 4.2 5.6 4.2 3.5 4.2 1.6 6.4 1.6 9.5 1.6 12.5 3.5 14.7 5.6 14.7 7.6 14.7 9.0 13.3 9.0 11.8 9.0 11.2 8.6 11.2 8.4 11.2 8.3 11.2 7.9 11.2 7.9 11.7 7.7 13.3 6.4 13.7 5.7 13.7 4.2 13.7 2.8 12.0 2.8 9.5 2.8 7.0 4.2 5.2 5.7 5.2 6.7 5.2 7.6 6.0 7.8 7.3 7.9 7.6 7.9 7.9 8.4 7.9 9.0 7.9 9.0 7.5 9.0 7.2Z\" /><path d=\"M17.4 12.8C17.4 12.3 17.0 12.3 16.9 12.3 16.6 12.3 16.4 12.3 16.3 12.7 16.2 12.9 15.9 13.7 14.7 13.7 13.2 13.7 12.0 12.5 12.0 11.0 12.0 10.2 12.5 8.3 14.8 8.3 15.1 8.3 15.8 8.3 15.8 8.4 15.8 9.0 16.1 9.2 16.5 9.2S17.2 8.9 17.2 8.5C17.2 7.2 15.5 7.2 14.8 7.2 11.9 7.2 10.9 9.5 10.9 11.0 10.9 13.0 12.5 14.7 14.6 14.7 16.9 14.7 17.4 13.0 17.4 12.8Z\" /><path d=\"M26.5 4.9C26.5 4.6 26.5 4.2 26.0 4.2 25.7 4.2 25.6 4.4 25.5 4.5 25.5 4.6 25.5 4.6 25.3 5.0 24.7 4.6 23.9 4.2 23.1 4.2 20.9 4.2 19.1 6.4 19.1 9.5 19.1 12.5 20.9 14.7 23.1 14.7 25.0 14.7 26.5 13.3 26.5 11.8 26.5 11.2 26.1 11.2 25.9 11.2 25.7 11.2 25.4 11.2 25.3 11.7 25.2 13.3 23.9 13.7 23.2 13.7 21.7 13.7 20.2 12.0 20.2 9.5 20.2 7.0 21.7 5.2 23.2 5.2 24.2 5.2 25.1 6.0 25.3 7.3 25.4 7.6 25.4 7.9 25.9 7.9 26.5 7.9 26.5 7.5 26.5 7.2Z\" /></g>")
    ("Cg" . "<g><path d=\"M9.0 4.9C9.0 4.6 9.0 4.2 8.5 4.2 8.2 4.2 8.1 4.3 8.0 4.5 8.0 4.5 8.0 4.6 7.8 5.0 7.2 4.5 6.5 4.2 5.6 4.2 3.5 4.2 1.6 6.4 1.6 9.4 1.6 12.5 3.5 14.7 5.6 14.7 7.6 14.7 9.0 13.2 9.0 11.7 9.0 11.2 8.6 11.2 8.4 11.2 8.3 11.2 7.9 11.2 7.9 11.7 7.7 13.3 6.4 13.7 5.7 13.7 4.2 13.7 2.8 11.9 2.8 9.4 2.8 7.0 4.2 5.2 5.7 5.2 6.7 5.2 7.6 6.0 7.8 7.3 7.9 7.6 7.9 7.9 8.4 7.9 9.0 7.9 9.0 7.5 9.0 7.2Z\" /><path d=\"M13.6 11.6C12.7 11.6 12.0 10.8 12.0 9.9 12.0 9.0 12.7 8.3 13.6 8.3 14.5 8.3 15.2 9.0 15.2 9.9 15.2 10.9 14.4 11.6 13.6 11.6ZM12.1 12.2C12.1 12.2 12.7 12.6 13.6 12.6 15.1 12.6 16.3 11.4 16.3 9.9 16.3 9.4 16.2 8.9 15.9 8.5 16.2 8.3 16.6 8.2 16.8 8.2 16.9 8.6 17.3 8.8 17.5 8.8 17.8 8.8 18.2 8.6 18.2 8.1 18.2 7.7 17.8 7.2 16.9 7.2 16.8 7.2 15.9 7.2 15.2 7.8 14.9 7.6 14.3 7.3 13.6 7.3 12.0 7.3 10.8 8.5 10.8 9.9 10.8 10.6 11.1 11.2 11.3 11.5 11.2 11.8 11.0 12.1 11.0 12.6 11.0 13.2 11.2 13.6 11.4 13.8 10.2 14.6 10.2 15.7 10.2 15.9 10.2 17.3 11.9 18.3 14.0 18.3 16.2 18.3 17.9 17.3 17.9 15.9 17.9 15.3 17.6 14.4 16.8 14.0 16.6 13.9 15.9 13.5 14.4 13.5H13.2C13.1 13.5 12.8 13.5 12.7 13.5 12.5 13.5 12.4 13.5 12.2 13.3 12.0 13.0 12.0 12.7 12.0 12.7 12.0 12.6 12.0 12.4 12.1 12.2ZM14.0 17.3C12.4 17.3 11.1 16.6 11.1 15.9 11.1 15.6 11.3 15.1 11.8 14.7 12.2 14.5 12.4 14.5 13.6 14.5 15.1 14.5 17.0 14.5 17.0 15.9 17.0 16.6 15.7 17.3 14.0 17.3Z\" /></g>")
    ("Up" . "<path d=\"M10 1 5.5 10H9V19H11V10H14.5Z\" />")
    ("Do" . "<path d=\"M10 19 5.5 10H9V1H11V10H14.5Z\" />")))

(defun my-tool-bar-image (text)
  "TEXTに対応する画像(Image Descriptor)を返す。"
  (when-let* ((svg (alist-get text my-tool-bar-svg-alist nil nil #'equal)))
    (list 'image
          :type 'svg :data
          (concat
           (format "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"%s\" height=\"%s\" fill=\"#000\" viewBox=\"0 0 %s %s\" >"
                   ;; 押しづらいのでサイズを調整
                   ;; 元のSVGは1文字が高さ20、幅が10弱くらいの枠内に収まるように書いてある
                   (* (length text) 16) 28
                   (* (length text) 10) 20)
           svg "</svg>")
          :scale 'default)))

(define-minor-mode my-tool-bar-mode
  "私だけの特別なツールバー。"
  :init-value nil
  :global t
  :group 'tool-bar
  (if my-tool-bar-mode
      (setq secondary-tool-bar-map
            (let ((km (make-sparse-keymap)))
              (dolist (key (reverse '("C-" "S-" "M-" ;; "A-" "s-" "H-"
                                      "Mx" "Cx" "CxC" "Cc" "CcC"
                                      "Cg" "Up" "Do")))
                (my-tool-bar-add-prefix-item km key))
              km))
    (setq secondary-tool-bar-map nil))
  ;; Update the mode line now.
  (force-mode-line-update t))

(defun my-tool-bar-decode-C- (_prompt)
  (modifier-bar-button '(control)))

(defun my-tool-bar-decode-S- (_prompt)
  (modifier-bar-button '(shift)))

(defun my-tool-bar-decode-M- (_prompt)
  (modifier-bar-button '(meta)))

(defun my-tool-bar-decode-A- (_prompt)
  (modifier-bar-button '(alt)))

(defun my-tool-bar-decode-s- (_prompt)
  (modifier-bar-button '(super)))

(defun my-tool-bar-decode-H- (_prompt)
  (modifier-bar-button '(hyper)))

(defun my-tool-bar-decode-Mx (_prompt)
  (kbd "M-x"))

(defun my-tool-bar-decode-Cx (_prompt)
  (kbd "C-x"))

(defun my-tool-bar-decode-CxC (_prompt)
  (vconcat
   (kbd "C-x")
   (modifier-bar-button '(control))))

(defun my-tool-bar-decode-Cc (_prompt)
  (kbd "C-c"))

(defun my-tool-bar-decode-CcC (_prompt)
  (vconcat
   (kbd "C-c")
   (modifier-bar-button '(control))))

(defun my-tool-bar-decode-Cg (_prompt)
  (kbd "C-g"))

(defun my-tool-bar-decode-Up (_prompt)
  (kbd "<up>"))

(defun my-tool-bar-decode-Do (_prompt)
  (kbd "<down>"))

(defun my-tool-bar-add-prefix-item (km key-str)
  (let* ((modifier (alist-get key-str
                              '(("C-" . control) ("S-" . shift)
                                ("M-" . meta) ("A-" . alt)
                                ("s-" . super) ("H-" . hyper))
                              nil nil #'equal))
         (key-sym (or modifier
                      (intern key-str)))
         (decode-fun (intern (format "my-tool-bar-decode-%s" key-str))))
    (define-key km (vector key-sym)
                (list
                 'menu-item key-str #'ignore
                 :image (my-tool-bar-image key-str)
                 :help (if modifier
                           (format "Add %s to the following event" key-str)
                         key-str)
                 :enable (if modifier
                             `(modifier-bar-available-p (quote ,modifier))
                           t)))
    (define-key input-decode-map (vector 'tool-bar key-sym) decode-fun)))

実装の一部は modifier-bar-mode のコードを呼び出しています。

入力イベントに修飾キーを付加するのにinput-decode-mapというのを利用しているみたいです。そこから呼び出される関数modifier-bar-buttonにread-eventのループがあって、そこで入力された後続のイベントに修飾キーを付加して返すと、それが代わりの入力結果になるという流れのようです。

ツールバーへのボタンの表示はsecondary-tool-bar-mapにメニュー項目を追加することで行います。

ただし、項目文字列が表示されることは無く、代わりに画像を指定してやる必要があります。modifier-bar-modeのCtrlやらShiftやらの文字がどうも汚いなと思っていましたが、これはテキストでは無く画像で用意されています。image-load-path (etc/images/) の下に ctrl.pbm や shift.pbm といったファイル名で存在しています。

わざわざ画像を用意するのは億劫だなと思いましたが、試してみたところSVG画像でも表示できるようでした(WindowsとAndroidの両方で確認)。

しかしここで残念なお知らせが。

現在のAndroid版EmacsはSVGでtext要素が表示できません。

最初はフォントが見つけられないだけかなとも思ったのですが、 java/INSTALL の中に次のような記述を見つけました。 

LIBRSVG

Librsvg 2.40.21, the final release in the librsvg 2.40.x series, the
last to be implemented in C, is provided as:

  librsvg-2.40.21-emacs.tar.gz

and has been lightly edited for compatibility with environments where
Pango cannot provide fonts, with the obvious caveat that text cannot be
displayed with the resulting librsvg binary.  Among numerous
dependencies are PCRE, and:

  libiconv-1.17-emacs.tar.gz
  libffi-3.4.5-emacs.tar.gz
  pango-1.38.1-emacs.tar.gz
  glib-2.33.14-emacs.tar.gz
  libcroco-0.6.13-emacs.tar.gz
  pixman-0.38.4-emacs.tar.gz
  libxml2-2.12.4-emacs.tar.gz
  gdk-pixbuf-2.22.1-emacs.tar.gz
  giflib-5.2.1-emacs.tar.gz
  libjpeg-turbo-3.0.2-emacs.tar.gz
  libpng-1.6.41-emacs.tar.gz
  tiff-4.5.1-emacs.tar.gz
  cairo-1.16.0-emacs.tar.gz

which must be individually unpacked and their contents provided on the
command line, as with other dependencies.  They will introduce
approximately 8 MiB's worth of shared libraries into the finished
application package.  It is unlikely that later releases of librsvg will
ever be ported, as they have migrated to a different implementation
language.

No effort has been expended on providing the latest and greatest of
these dependencies either; rather, the versions chosen are often the
earliest versions required by their dependents, these being the smaller
of all available versions, and generally more straightforward to port.

よく分かりませんが、テキストが表示できないのは仕様ということなのでしょうか？ librsvg-2.40自体もかなり古いものなのでサポートしていないSVGの機能やバグが沢山あるはずです。 残念ですがとりあえずSVGでtext要素を使うのは諦めるよりありません。

というわけで上のソースコードにはLaTeXで生成した文字のパスデータが長々と並んでいるわけです。

2025-03-07

Emacsからssh-agentを起動する

ssh-agentというのは基本的にはEmacsが起動する前に実行しておくものだと思います。しかしAndroid版の場合、(Termuxの(非GUIの)Emacsパッケージだったりrootを取って色々したりしない限り)普通はそんなことは不可能です。ダイレクトにEmacsが起動してしまうので。

Android版のEmacsはTermuxと連携させればsshが使用できます。Magitも動作します(なぜかWindowsバリに遅いですが)。でもssh-agentが起動していなければ毎回パスフレーズを入力しなければなりません(設定しているのなら。Trampに限ってはauthinfoに記録させる方法もありますが)。

となると、Emacsからssh-agentを起動するという方法が浮かんできます。

やることは簡単。ssh-agentを起動して出力される環境変数(SSH_AUTH_SOCK と SSH_AGENT_PID)をEmacs自体に反映してやれば良いのです。後はssh-addを起動してパスフレーズを入力してもらいます。

ということでcall-process関数を使用して ssh-agent を起動しようとしたのですが、なぜが処理が返ってきません。 (call-process "ssh-agent" nil t) のように書いて評価すると何秒経っても終了しません。C-gで中断することはできます。Windows上で試すとちゃんとすぐに処理が帰ってきます。call-processが必ず帰ってこないわけではありません。 ls のようなものは大丈夫ですし、 ssh-agent -k のようなものもすぐに帰ってきます。

shell-commandもダメでした(&を付けて非同期にするのは試していません)。内部でcall-processを呼んでいるからでしょう。

EShellのeshell-commandはすぐに帰ってきました。とは言えその後 ssh-add するときにキーフレーズを入力する方法が分からず諦めました。

というわけで、非同期的にプロセスを実行するstart-process関数を使って書くことにしました。 

(defun my-ssh-setup ()
  "ssh-agentとssh-addを起動します。"
  (interactive)
  (my-ssh-agent-start)
  (my-ssh-add))

(defun my-ssh-call-process (program &optional args body on-exit)
  "PROGRAMを実行して終了するまで待ちます。

ARGSはPROGRAMの引数です。

終了するまでの間にBODYに指定した関数を不定期的に呼び出します。
関数に引き渡される引数はプロセスオブジェクト一つです。

終了した後にON-EXITに指定した関数を呼び出します。
関数に引き渡される引数はPROGRAMの終了ステータスコードです。

BODYやON-EXITを呼び出す際のカレントバッファはプロセスの出力を保持するバッ
ファです。それぞれのタイミングでPROGRAMが出力したテキストを調べることが
出来ます。"
  (let ((buffer (get-buffer-create "*ssh-agent*")))
    (with-current-buffer buffer
      (erase-buffer)
      (let ((process (apply #'start-process
                            program buffer
                            program args)))
        (set-process-sentinel
         process
         (lambda (process _event)
           (when (memq (process-status process)
                       '(exit signal))
             (process-put process :my-ssh-finished t))))
        (while (not (process-get process :my-ssh-finished))
          (when (input-pending-p)
            (discard-input)
            ;; Androidではdiscard-inputしてもread-eventで少し待たない
            ;; とsit-forが即時リターンしてsentinelが呼び出されないこと
            ;; がある。
            (read-event nil nil 0.2))
          (sit-for 0.1) ;; ここでsentinelが呼び出されるかも
          (when body
            (funcall body process)))
        (when on-exit
          (funcall on-exit (process-exit-status process)))
        (process-exit-status process)))))

(defun my-ssh-agent-start ()
  "ssh-agentを開始します。"
  (interactive)
  (if (getenv "SSH_AGENT_PID")
      (message "SSH_AGENT_PID is already set")
    (my-ssh-call-process
     "ssh-agent" nil nil
     (lambda (status)
       (unless (zerop status)
         (error "ssh-agent failed"))
       (let ((vars
              (mapcar
               (lambda (var)
                 (goto-char (point-min))
                 ;; Error if not found
                 (re-search-forward (concat var "=\\([-_a-zA-Z0-9./]+\\)"))
                 (list var (match-string 1)))
               '("SSH_AUTH_SOCK" "SSH_AGENT_PID"))))
         (dolist (vv vars) (apply #'setenv vv))
         (message "ssh-agent vars=%s" vars))))))

(defun my-ssh-agent-stop ()
  "ssh-agentを停止します。"
  (interactive)
  (call-process "ssh-agent" nil nil nil "-k")
  (setenv "SSH_AGENT_PID"))

(defun my-ssh-add ()
  "ssh-addを起動してパスフレーズを入力・記録します。"
  (interactive)
  (let ((read-pos nil))
    (my-ssh-call-process
     "ssh-add" nil
     (lambda (process)
       (save-excursion
         (goto-char (or read-pos (point-min)))
         ;; Enter passphrase ... が現れたらパスフレーズを入力させてそ
         ;; れをプロセスへ送信する。
         (when (re-search-forward "^Enter .*: *" nil t)
           (let ((prompt (match-string 0)))
             (process-send-string
              process
              (concat (read-passwd prompt) "\n")))
           (setq read-pos (point))))))))


;; 以下おまけ

(defun my-ssh-ensure ()
  "環境変数SSH_AGENT_PIDが設定されていなければ`my-ssh-setup'を呼び出します。
設定されているなら何もしません。"
  (interactive)
  (unless (getenv "SSH_AGENT_PID")
    (my-ssh-setup)))

(defun my-ssh-init ()
  "適当なタイミングでパスフレーズを入力するよう準備します。
これをinit.elから呼び出しておけば、MagitやVC、Trampのパスフレーズが必要
そうなタイミングで自動的に`my-ssh-ensure'が呼び出されます。
あまり細かい条件は見ていないので必要に応じて修正してください。"
  ;; Magitのpushまたはpull
  (defun my-ssh-agent-init-on-magit-start-git (_input &rest args)
    (with-demoted-errors "Error my-ssh-agent: %s"
      (when (member (flatten-tree args) '("push" "pull"))
        (my-ssh-ensure))))
  (advice-add #'magit-start-git :before
              #'my-ssh-agent-init-on-magit-start-git)

  ;; VCのgitのpushまたはpull
  (defun my-ssh-agent-init-on-vc-git--pushpull (&rest _)
    (with-demoted-errors "Error my-ssh-agent: %s"
      (my-ssh-ensure)))
  (advice-add 'vc-git--pushpull :before
              #'my-ssh-agent-init-on-vc-git--pushpull)

  ;; Trampのssh等
  (defun my-ssh-agent-init-on-tramp-ssh-controlmaster-options (vec)
    (with-demoted-errors "Error my-ssh-agent: %s"
      (when (seq-find (lambda (hop)
                        (member (tramp-file-name-method hop)
                                '("ssh" "sshx" "scp" "scpx")))
                      (tramp-compute-multi-hops vec))
        (my-ssh-ensure))))
  (advice-add #'tramp-ssh-controlmaster-options :before
              #'my-ssh-agent-init-on-tramp-ssh-controlmaster-options))

少し試した限りうまく行っているようです。

他の方法について。

非同期プロセスの処理を書くのは面倒なのでeshellをうまく利用して何とかならないかなと思ったのですが、私にはあまりうまく出来ませんでした。ssh-agentが出力するスクリプトをそのまま評価できれば良かったのですが。環境変数(process-environment変数)はデフォルトだとバッファローカルになりますがeshell-modify-global-environment変数を変えれば行けそう。最終的にはssh-addの入力部分をどうしたらよいのか分かりませんでした。無理矢理実現するなら大人しく上のように書いてしまった方が良いのかなと。

Magitだけを通すならおそらく magit-process-password-prompt-regexps と magit-process-find-password-functions をいじれば(そもそもssh-agentを起動しなくても)何とかなりそうな気もします。どこかにパスフレーズを保存しておく方法に限らず、Emacsがssh-agentのようにパスフレーズを一時的に覚えておくことも出来るかもしれません。とは言えsshを使うのがMagitに限らないのであれば、大人しくssh-agentを起動してしまった方が良いでしょう。

AndroidではOSが無駄なプロセスを自動的に削除してしまうことがあるらしいので、そこは注意が必要かもしれません。

2025-03-05

モードラインをドラッグしてウィンドウを消す

Emacsではモードラインをマウスでドラッグすると、分割されているウィンドウのサイズ(境界線)が調整できます(実際にはモードラインに限らずヘッダーライン等でもできるみたいです)。

しかし出来るのはそこまで。フレームの端までドラッグしてもウィンドウが閉じたりはしません。「これ以上リサイズできるウィンドウは無いよ！」といった悲鳴(エラー)が発せられるだけです。

まぁそんなものか……とC-x 1やC-x 0を押せば済む話。……本当に？　その時そこにキーボードがあるとは限らないのです。そう、Androidなら。

もちろんHacker's Keyboardを使ってC-x 1と押すことは出来ます。メニューバーのFileを押しメニューを下にスクロールしてRemove Other Windowsを選択しても良いです。ツールバーか何かにウィンドウを閉じるボタンを配置しても良いかもしれません。ちなみにマウスではモードラインを右クリックすればウィンドウが閉じますが、デフォルトのタッチ操作では右クリックは再現できないようです。

でもやっぱり境界のドラッグやスワイプで閉じられた方が自然ではありませんか？

調査と実装

端までドラッグすると次のようなエラーメッセージがログに記録されます。 

adjust-window-trailing-edge: No resizable window below this one

adjust-window-trailing-edge という関数が実際にウィンドウのサイズを調整しています。 

(defun adjust-window-trailing-edge (window delta &optional horizontal pixelwise)

この関数はウィンドウの右辺あるいは下辺の位置を調整します。

引数windowにドラッグ中のモードラインを持つウィンドウが渡されるようです。deltaはサイズの変化量(正の時は右または下へ移動、負の時は左または上へ移動)。horizontalは非nilの時右辺を移動し、nilの時下辺を移動します。

コードの中身を見ると案外複雑なのですが、これは実際に沢山のウィンドウを並べてからモードラインをドラッグしてみれば納得できるでしょう。

例えば次図で黒い矢印の場所をドラッグしたら、実際には赤い矢印の場所を移動しなければなりません。その下にあるウィンドウがこれ以上小さく出来ない場合はさらに外側(青色)を移動する必要もあります。

このウィンドウのモードラインをドラッグするこのウィンドウの下辺を変更する必要がある

ちなみに、ウィンドウの構造は基本的に次のような状態にはならないようです(同じ向きで入れ子になる状態。垂直方向も同様)。

横並び親も横並び

これは次のような状態になります。おそらく分割や削除を行ったときに不要な包含ウィンドウを削除して中身を展開しているのだと思います。

一つの横並び

モードラインを持つwindowから実際にリサイズするウィンドウを求める処理はadjust-window-trailing-edgeの比較的最初の方にあります。 

    ;; Find the edge we want to move.
    (while (and (or (not (window-combined-p right horizontal))
                    (not (window-right right)))
                (setq right (window-parent right))))

注:

  • window-combined-pは、window(ここではright)がhorizontalで指定した方向に並んだウィンドウのうちの一つかどうかを判定します。方向が合わないならnilを返します。
  • window-rightは次の兄弟を返します。rightとありますが下かもしれません。方向は先にwindow-combined-pによって確認しています。window-next-siblingとは違いwindowにはnilを指定出来ず、エコーエリアを返すこともありません。

この処理は後で使うことになるので関数化しておきます。 

(defun my-window-right-edge (window horizontal)
  (while (and (or (not (window-combined-p window horizontal))
                  (not (window-right window)))
              (setq window (window-parent window))))
  window)

adjust-window-trailing-edgeはその後実際にリサイズできる余地があるのかを調べるのですが、そこで余地がなければ「これ以上リサイズできない！」と件のエラー(悲鳴)を発するわけです。

なので、この関数の外側でエラーを監視し、そのエラーを検出したらリサイズではなく削除を行ってみてはどうでしょうか。 

(defun my-adjust-window-trailing-edge:around (old-fun
                                              window delta
                                              &optional horizontal pixelwise)
  (condition-case err
      ;; 元の関数を呼び出す
      (funcall old-fun window delta horizontal pixelwise)
    ;; user-errorをトラップ
    (user-error
     (pcase (error-message-string err) ;; エラーメッセージで分岐する
       ;; 左または上にリサイズ可能なウィンドウが無い場合
       ((or "No resizable window on the left of this one"
            "No resizable window above this one")
        (delete-window
         ;; 削除するのは境界を持つウィンドウ(WINDOWを含む！)
         (my-window-right-edge window horizontal)))
       ;; 右または下にリサイズ可能なウィンドウが無い場合
       ((or "No resizable window on the right of this one"
            "No resizable window below this one")
        (delete-window
         ;; 削除するのは下または右隣のウィンドウ(WINDOWは維持される)
         (window-right
          (my-window-right-edge window horizontal))))
       ;; その他のエラーは再送
       (_ (signal (car err) (cdr err)))))))

(advice-add #'adjust-window-trailing-edge :around #'my-adjust-window-trailing-edge:around)
;; ↓で解除
;; (advice-remove #'adjust-window-trailing-edge #'my-adjust-window-trailing-edge:around)

これだけでもちゃんとドラッグでウィンドウが消えてくれます。

しかし上や左にドラッグしてウィンドウを消すと、次のようなエラーメッセージが表示されます。 

Wrong type argument: window-valid-p, #<window 349>

ウィンドウを削除してもドラッグ状態はまだ続いているので、動かすたびに削除したwindowにアクセスしてこのエラーが発生してしまいます。右や下にドラッグした場合はドラッグ中のwindowは消えないのでエラーは発生しません。

また、下や右へドラッグしたときは継続して複数のウィンドウを消せますが、左や上へドラッグしたときはそれ以上消せません。

この問題を真面目に修正することも可能ですが、元のソースコードを修正せずにadvice等を使って外から直すのは面倒です。煩雑なコードをinit.elに入れるほどの価値は無いと思ったので、適当にエラーを黙らせることにしました(実際には他のelファイルに入っていてinit.elにあるのはautoloadと最初のadvice-addだけですが)。

コード

というわけで最終的なコードは次のようになりました。 

;; ドラッグ開始時の処理が呼ばれるようにする。
;; (autoload 'my-mouse-drag-line--begin "my-mouse-drag-line")
(advice-add #'mouse-drag-line :after #'my-mouse-drag-line--begin)

(defun my-mouse-drag-line--begin (&rest _)
  "ドラッグ開始時の処理。"
  ;; ドラッグ中、adjust-window-trailing-edgeの動作を変えて、リサイズで
  ;; きないときは削除する。
  (advice-add #'adjust-window-trailing-edge :around
              #'my-mouse-drag-line--adjust-window-trailing-edge)
  ;; 一時キーマップが終了するタイミングを検出する方法がここくらいしか
  ;; 見当たらなかったので。これがダメならタイマーやpost-command-hookを
  ;; 使うくらいしか？
  (advice-add #'internal-pop-keymap :after
              #'my-mouse-drag-line--end))

(defun my-mouse-drag-line--end (&rest _)
  "ドラッグ終了時の処理。"
  ;; 元に戻す。
  (advice-remove #'adjust-window-trailing-edge
                 #'my-mouse-drag-line--adjust-window-trailing-edge)
  (advice-remove #'internal-pop-keymap
                 #'my-mouse-drag-line--end))

(defun my-window-right-edge (window horizontal)
  "WINDOWと右辺または下辺を共有する一番上のウィンドウを返す。"
  (while (and (or (not (window-combined-p window horizontal))
                  (not (window-right window)))
              (setq window (window-parent window))))
  window)

(defun my-mouse-drag-line--adjust-window-trailing-edge
    (old-fun window delta &optional horizontal pixelwise)
  "ドラッグ中にadjust-window-trailing-edgeが呼ばれたときの処理。
リサイズできなかった場合はウィンドウを削除する。"
  (condition-case err
      (funcall old-fun window delta horizontal pixelwise)
    (user-error
     (pcase (error-message-string err)
       ;; 左または上にリサイズ可能なウィンドウが無い場合。
       ;; ドラッグしている(モード行がある)ウィンドウを削除する。
       ((or "No resizable window on the left of this one"
            "No resizable window above this one")
        (delete-window (my-window-right-edge window horizontal))
        ;; 無理矢理drag-mouse-1イベントを起こして終了させる。
        ;; ここは (funcall (lookup-key overriding-terminal-local-map
        ;; [drag-mouse-1])) とかでも良いのかもしれない。
        ;; mouse-drag-lineを参照。exitfunを呼ぶ方法が限られる。
        (push 'drag-mouse-1 unread-command-events)
        ;; よく分かってないけどnilにしておけばエラーを回避できる。
        ;; (Emacs 30.1以降でタッチスクリーンを使用した場合)
        (setq touch-screen-current-tool nil))

       ;; 右または下にリサイズ可能なウィンドウが無い場合。
       ;; ドラッグしている(モード行がある)ウィンドウの次を削除する。
       ((or "No resizable window on the right of this one"
            "No resizable window below this one")
        (delete-window (window-right
                        (my-window-right-edge window horizontal))))

       ;; その他のエラーは再送する。
       (_ (signal (car err) (cdr err)))))))

;; ドラッグが終了した後にエラーが発生するようなので握りつぶす。
;; あまり常時エラーを握りつぶしたくないけどmouse関連だからまあいいか。
(defun my-mouse-select-window:around (old-fun click)
  (when (window-live-p (posn-window (event-start click)))
    (funcall old-fun click)))
(advice-add #'mouse-select-window :around #'my-mouse-select-window:around)

ちょっと適当な所もありますが、とりあえずマウスによるドラッグでもタッチ操作でもウィンドウを閉じられるようになりました。

タッチ操作の場合は touch-screen.el の作用によって、タッチイベントがマウスイベントに変換されて動作します。ドラッグも再現してくれるおかげでマウス用に書かれたコードがそのままで動作してくれます。ただ、この変換部分にもタッチしたwindowを記録して保持する部分が存在しているため、ドラッグ中に削除するとエラーが発生します。それを抑制しているのが (setq touch-screen-current-tool nil) の部分です。この辺りはあまりちゃんとコードを読んでいないので、操作によっては正しく動かない場合もあるかもしれません。複雑なタッチ操作を行おうとした場合とか？　モードラインのドラッグ程度ならおそらく大丈夫だと思いますが。

2025-02-28

Android版のEmacsを試す

Android版のEmacsがリリースされたので初めて使ってみた。

参考資料

apkのダウンロード

端末や使い方によってダウンロードするapkが異なる(今回私が使った端末はPixel7/Android 15なので -29-arm64-v8a を選ぶ)。

Emacsを単体で使う場合:

Emacsと一緒に配布されているtermux-appと連携させる場合:

GitHub版のtermux-appと連携させる場合(再署名が必要):

上記リンクはこの記事を書いた時点でのものなので、最新の状況はSourceForgeのfilesページ(Emacs)やGitHubのリリースページ(termux-app)を確認すると良い。

(追記: GNU公式サイト https://ftp.gnu.org/gnu/emacs/android/ からもダウンロードできるようになった)

再署名

EmacsとTermuxを連携させたいなら(お互いのファイルにアクセスできるようにしたいなら)両者のapkを同じ鍵で署名する必要がある。

Emacsと一緒に配布されているtermux-app(termux-app_apt-android-7-release_universal.apk) を使う場合はすでに同じ鍵で署名されているので再署名は不要。

それ以外から入手したtermux-app(GitHub版の最新版や自分でビルドしたもの)を使う場合は再署名するのが手っ取り早い(正直Android版Emacsのビルドはやりたくないので)。

手順:

  • 注1: 既に私のPCに入っていたAndroid Studio(とSDK)を使用。
  • 注2: 署名に使う鍵は既に作成済み。
  • 注3: 以下はMSYS2のBash上でのコマンドライン。環境毎に適宜読み替えること。

  1. 署名の削除 

    zip -d emacs-30.1-29-arm64-v8a.apk "META-INF/*"

    (unzipしてからzipしてもよい？)

    (termux-app_v0.118.1+github-debug_arm64-v8a.apkの方は削除しなくてもよい？)

  2. zipalign 

    c:/Users/****/AppData/Local/Android/Sdk/build-tools/35.0.1/zipalign.exe -v -p 4 emacs-30.1-29-arm64-v8a.apk emacs-30.1-29-arm64-v8a-aligned.apk
c:/Users/****/AppData/Local/Android/Sdk/build-tools/35.0.1/zipalign.exe -v -p 4 termux-app_v0.118.1+github-debug_arm64-v8a.apk termux-app_v0.118.1+github-debug_arm64-v8a-aligned.apk

  3. 署名

    予め鍵を生成して <keystore-path> と <key-alias> の部分に情報を埋めること。 

    export JAVA_HOME="c:/Program Files/Android/Android Studio/jbr"
c:/Users/****/AppData/Local/Android/Sdk/build-tools/35.0.1/apksigner.bat sign --ks <keystore-path> --ks-key-alias <key-alias> --out emacs-30.1-29-arm64-v8a-signed.apk emacs-30.1-29-arm64-v8a-aligned.apk
c:/Users/****/AppData/Local/Android/Sdk/build-tools/35.0.1/apksigner.bat sign --ks <keystore-path> --ks-key-alias <key-alias> --out termux-app_v0.118.1+github-debug_arm64-v8a-signed.apk termux-app_v0.118.1+github-debug_arm64-v8a-aligned.apk

インストール

署名が異なるTermux関連アプリが既にインストールされている場合は先に全てアンインストールする。もちろん必要に応じてバックアップを取ること。

Android上でダウンロードしたapkをブラウザから直接インストールするか、再署名したのであればPCからadbでインストールするかAndroid上で動くファイル管理ソフト(MiXplorer等)を使ってコピーしてインストールする。先に身元不明のアプリをインストールできるようにする設定が必要かも。

基本的にストアを介さない野良アプリ扱いなので色々警告が出るが自己責任で。気になるなら専用端末に入れた方が良いかもしれない。どちらかと言えばTermuxの方が不安かも。Termuxが使いたくなければネットワーク越しのやりとりは全部Emacs Lisp(url-retrieve等)で書けば良いと思う。

仮想キーボードのインストール

既に入っていたHacker's Keyboardを使用したが、こういうCtrl+何かのキーが押せるキーボードが無いとつらい。

もしくは物理キーボードを繋げるか。それはそれで配列のカスタマイズがつらい。(追記: 実際に繋げてみたが日本語IMEの起動方法が分からない)

Termuxの設定

pkg update
pkg upgrade

SSH越しのGitリポジトリにアクセスするなら: 

pkg install openssh
pkg install git
ssh-keygen -t ed25519 -C "your_name@example.com"
  • ~/.ssh/id_ed25519.pub をサーバにセット
  • .bashrcに . source-ssh-agent と書いておくと良いかも
  • GitリポジトリからEmacsの設定を取り出したり色々できる

Termuxから /sdcard にアクセスするなら: 

termux-setup-storage

Emacsの設定

/sdcardへのアクセス

Emacsから /sdcard にアクセスできないようなら「設定→アプリ→特別なアプリアクセス→Emacs」が必要かも？　

もしくは M-x android-request-storage-access ？　(何回か入れ直したのでよく分からなくなってる)

Android判定

Emacs LispからAndroid版のEmacsで動いているかを判定するには次の式を使う。 

(eq system-type 'android)

この式を使って、普段使っているearly-init.elやinit.elにAndroid専用の設定を追加していく。

環境変数の設定

Termux側のbinへPATHを通す。 

(when (eq system-type 'android) ;; Android版のとき
  (let ((termux-bin "/data/data/com.termux/files/usr/bin"))
    (when (file-directory-p termux-bin) ;; 一応アクセスできるか確認する
      (setenv "PATH" (concat termux-bin ":" (getenv "PATH")))
      (push termux-bin exec-path))))

これによって M-x shell から様々なコマンドが使えるようになった。gitも実行できるのでMagitも使えた(やけに遅かったけど)。

ちなみにHOMEの位置は:

  • Termux側: /data/data/com.termux/files/home
  • Emacs側: /data/data/org.gnu.emacs/files

同じ鍵で署名してあれば双方どちらにもアクセスできるはず。

ツールバーの表示

タッチスクリーンのみで操作するのは大変なので、押せるものは何でも欲しい。

私は普段ツールバーを消していたので消さないようにした。 default-frame-alist や tool-bar-mode の設定変更で可能。

メニューバーは元々消さずに使っているが、Androidでは絶対あった方が良いと思う。「Buffers」を押すだけでバッファリストが出る。

default-frame-alist をいじるついでに left-fringe と right-fringe を大きくしても良いかも。なぜか滅茶苦茶細いので。

ツールバーからcontrolやmeta等の装飾キーが押せるmodifier-bar-modeなんてのも追加されたらしい。これはsecondary-tool-barという仕組みを使っているらしい。M-xやC-x、C-x C-、C-cなんかもワンボタンで押せると良いんだけど。その辺りは追々。さらにウィンドウ毎にツールバーを表示するglobal-window-tool-bar-modeなんてものもあるらしい。

フォント

~/fonts/ (/data/data/org.gnu.emacs/files/fonts/) に.ttfファイルを置くとそれを使えるようになる。認識していれば (font-family-list) の評価結果に現れる。そのフォント名で (set-frame-font "<family-name>-<size>") とするか、early-init.elあたりで default-frame-alist に (font . "<family-name>-<size>") として指定してやるか(例えば (add-to-list 'default-frame-alist '(font . "NantokaFont-16")))。

~/fontsディレクトリを表示しているところ(dired-details-rとnerd-icons-dired)
図1: ~/fontsディレクトリを表示しているところ(dired-details-rとnerd-icons-dired)

nerd-icons も M-x nerd-icons-install-fonts でこのディレクトリにインストールすれば普通に使える。

ただしSVG内のtext要素からはこれらのフォントを参照できない気がする。というかSVGのtext要素自体が一切表示されないような気が。

仮想キーボードの表示

デフォルトだと読み取り専用の場所で仮想キーボードが消えてしまう。Dired等でHacker's Keyboardによる操作ができなくなってしまう。 

(when (eq system-type 'android)
  (setq touch-screen-display-keyboard t))

これで常に表示されるようになるが、戻るボタンを押せば消せるのであまり邪魔にはならないと思う。とは言えスクロールして読むだけのバッファなら非表示の方が良いと思うので、モードによって切り替えた方が良いのかもしれない。

通常の日本語IMEとの切り替えは画面右下に切り替えボタンが出るのでそれで十分かなと(端末に依って異なるかも)。

おしまい

子フレームで補完候補を表示しているところ(ちなみにこの補完候補はタッチで選択出来ない)
図2: 子フレームで補完候補を表示しているところ(ちなみにこの補完候補はタッチで選択出来ない)

というわけで普段PCで使っているのとほとんど同じ物がAndroid上に現れてしまいました。GUI版のEmacsがそのまま動いているのはすごいですね。設定もPCで使っている物からほとんど変えていません。

後はどうやって使いやすくするか、あるいは慣れるか。

私としては今は軽いノートPCを持っているのでわざわざキーボードを繋げて使うことはあまりないと思います。あくまでタッチ操作で色々出来るようにしたいところ。

とりあえずタッチイベントを調べてみようかな。

作図ツール(少し問題あり)
図3: 作図ツール(少し問題あり)
2025-02-24

Emacs 30.1の設定(MS-Windows)

リリースされたので入れ替え。と言っても最近は30.0.9xをずっと使っていたのでトラブルなど無く、例によってネイティブコンパイルまわりの対処くらい。

1. ダウンロード

https://ftp.gnu.org/gnu/emacs/

  • emacs-30.1.zip
  • emacs-30.1.tar.xz (展開してfind-function-C-source-directory変数に指定し、describe-functionからソースコードを追えるようにするため)

2. zipを展開して適当な場所に置く

3. 起動してみる

パッと見問題なし。

4. 補う必要のあるファイルを確認する

  • 相変わらず libgccjit 関連のファイルは含まれていないのでネイティブコンパイルはそのままでは出来ない((native-comp-available-p) はnilを返す)
  • gdk_pixbuf関連のファイルはlibrsvgが自前のデコーダを持つようになったので不要

5. MSYS2で必要なファイルを取り寄せる

pacman -S mingw-w64-x86_64-libgccjit

MSYS2自体もアップデートして最新にした。

(ちなみにMSYS2のEmacsパッケージを使っていないのは、以前MSYS2版だけCPU100%不具合があったから。その時ノートPCでだけMSYS2版を使っていたのだけど、その不具合でファンがきゅいーん！と鳴ってうるさかった。多分もう直っているので、そもそも楽に使いたければMSYS2版を使った方が良いと思う。あ、それとテストのために古いバージョンのEmacsをいつでも使えるようにしておきたいという理由もある)

6. ネイティブコンパイルできるようにする

次のファイルをコピー。

  • emacs-30.1/binへ
    • msys64/mingw64/binから
      • libgccjit-0.dll
  • emacs-30.1/lib/gccへ
    • msys64/mingw64/binから
      • as.exe
      • ld.exe
    • msys64/mingw64/libから
      • crtbegin.o
      • crtend.o
      • dllcrt2.o
      • libadvapi32.a
      • libgcc_s.a
      • libkernel32.a
      • libmingw32.a
      • libmingwex.a
      • libmoldname.a
      • libmsvcrt.a
      • libpthread.a
      • libshell32.a
      • libuser32.a
    • msys64/mingw64/lib/gcc/x86_64-w64-mingw32/14.2.0/から
      • libgcc.a

libgccjit-0.dll以外のdllはemacs-30.1.zipの中に既に含まれていた。

.aや.oは全部必要なのか、また、(何かの条件で)不足するものが無いのかは確認していない。

~/.emacs.d/early-init.el には次の設定を入れている。 

(when (and (eq system-type 'windows-nt) ;; Windowsの場合
           (fboundp #'native-comp-available-p) ;; emacs-28以降
           (native-comp-available-p)) ;; libgccjitが使える
  ;; -B で emacs-??/lib/gcc/ ディレクトリを指定する。
  (let ((gcc-dir (expand-file-name
                  (file-name-concat invocation-directory "../lib/gcc"))))
    (when (file-directory-p gcc-dir)
      (setq native-comp-driver-options (list "-B" gcc-dir)))))

この設定が無くても PATH を最小限にして runemacs -Q で起動して試したらちゃんとネイティブコンパイルが成功していたので不要かと思ったが、普段使っている環境だと大量にエラーが出たのでこの設定を入れた。ucrt64環境のldやasが参照された？

パッケージディレクトリの切り替え

バージョンが変わるとバイトコンパイルされたEmacs Lispで色々問題が起きるので、最近は次のような設定を入れている。 

;; Emacsのバージョン毎にパッケージ格納先を切り替える。
;; ~/.emacs.d/elpa/30 のようにする。
;; `package-enable-at-startup'が非nil(デフォルト)のとき、early-init.el
;; の後、init.elの前にパッケージの初期化が行われるので、early-init.el
;; で切り替えておく必要がある。
(when (boundp 'package-user-dir)
  (setq package-user-dir
        (locate-user-emacs-file (format "elpa/%d" emacs-major-version))))
2025-02-21

Emacsでメールファイル(.eml等)をそのまま読む

昔から疑問に思っていて未だによく分かっていないことなのですが、Emacsから1件のメールのデータが入ったファイルを開いてその内容を読むにはどうしたら良いのでしょうか。

Web検索でちょっと調べてみても、既存のメールを取り扱うEmacs用のシステムに取りこんで読めというようなことばかりが引っかかり、単純に1件のメールだけが入ったファイルを普通のファイルを開くように読む方法がなかなか出てこないんですよね。

ここで言うメールが入ったファイルというのは沢山のメールが一つに詰め込まれたmbox形式とかではなくて、一般的なメールクライアントがメッセージを外部ファイルとして保存するときに.emlという拡張子を付けて出力するような先頭にメールヘッダーが入っているようなファイルのことです(ええと何形式というんだっけ)。内容はMIMEでエンコードされていて普通はそのままでは読めません(……ひょっとしてASCII言語圏ではそのまま読めるのでしょうか？　だからあまり問題になっていない？)。

私は普段Emacs上ではWanderlustを使っているのですが、それが依存しているsemiというライブラリにMIMEエンコードされたバッファをプレビューするコマンドが含まれています。

その名もmime-view-buffer。メールファイルを開いて M-x mime-view-buffer を実行すれば、メールの内容が 別バッファに 人間が読める状態で表示されます。素晴らしい。

ちなみに検索して見つかった別の方法としては次のものがあります。これはGnusの関数(gnus-article-prepare-display)を使います。

Any way to just render an email file on disk? : r/emacs 

(defun my/render-mime-message ()
  "Render the current buffer as a Gnus article."
  (interactive)
  (gnus-article-prepare-display))

これで読めると言えば読めるのですが、どうにも釈然としません。普通にEmacsからファイルを開く要領で読めるようにならないのでしょうか。要するにfind-fileで画像ファイルやpdfファイルを開いたら中身のバイナリではなく人間が読めるようなものが出るのと同じようにしたいわけです。

と、今更そのようなことを言い出したのは、先日いくつかのメールへのリンクをorg-mode文書に書きたくなって久しぶりにol-wl.elを使ったのがきっかけでした。メールへのリンクをorg-mode文書に書きたくなることはほとんどなく、近年はorg-contribが別パッケージに分かれたこともあってインストールすらされていませんでした。ol-wl.elを使うと wl: リンクタイプが追加されるのですが、そのパスにはWanderlustが管理するフォルダ表記とメッセージIDを指定します(例: wl:+inbox#somemessageid@example.jp)。そのリンクをC-c C-oで開くとWanderlustが起動してその中でメールの内容が表示されます。それを見て、単純に file: リンクタイプでメールが入っているファイルへリンクしたらダメなのかな？　と思ったわけです(例: file:~/my-wl-mail-dir/inbox/123)。

画像やPDFを開くノリでできないかと思ったのですが、あれはバッファ全体をdisplayテキストプロパティ(またはオーバーレイプロパティ)で画像に置き換えることで実現しています。今回やりたいのは画像では無くテキストで置き換えること。displayプロパティで別のテキストに置き換えるとそのテキストの中にポイントを置けないのであまり望ましくないでしょう。なので、どちらかと言えばhexl-modeがファイルの中身をHEXダンプに置き換える時に使っている手法が近そうです。

ただ、これはちゃんと実装しないと置き換えた後のテキストで元のファイルを上書きしてしまうリスクがあります。

とりあえず今回必要だったのはorg-modeからリンクを張っていつでも中身を見られるようにすることだけなので、必ずしも律儀にそのファイルに関連付けられたバッファで開く必要はありません。org-modeではリンクを開くときの動作を条件毎にカスタマイズできるようになっているので、そこでmime-view-bufferで開くような関数を指定してしまえば良いのです。 

(defun my-mime-view-file (file _original-link-path)
  "mime-view-bufferを使ってメールFILEのプレビューを開く。"
  (with-temp-buffer
    ;; PreviewバッファのカレントディレクトリはFILEがある場所にする。
    (setq default-directory
          (file-name-directory (expand-file-name file)))
    (insert-file-contents file)
    (mime-view-buffer
     nil
     ;; バッファ名にファイル名を入れる。
     (format "*MIME View: %s*" (file-name-nondirectory file)))))

;; Wanderlust用のメールが格納されているディレクトリにあるファイルを開
;; くときは my-mime-view-file を使う(例)。
(add-to-list 'org-file-apps '("c:/my-wl-mail-dir/" . my-mime-view-file)))

後は [[file:c:/my-wl-mail-dir/inbox/123]] のようなリンクを書けば、それをC-c C-oで開こうとすると上の関数の働きによって人間が読めるものがすぐに開くというわけです。

とりあえずこれでお茶を濁しておきますが、そのうちhexl-mode的な手法で内容を表示するmajor-modeを作りたい所。

メールが入ったファイルを読むだけのことがなんでこんなに面倒なんだろう。

2025-02-20

nerd-icons-diredへ移行

新PCへの移行に伴いこれまで使っていたall-the-icons-dired(を少し修正したもの)からnerd-icons-diredへ移行したのですが、いくつか気になった点があったので修正。

と、ソースコードを見たら、あれ、これall-the-icons-diredとほとんど同じですね。all-the-icons-diredを元にnerd-iconsを使うように修正した物っぽい？　なのでこれまでall-the-icons-dired向けに修正したのがほとんどのそのまま適用出来ます。

まずはhl-line-mode(現在の行をハイライトしてくれるマイナーモード)でアイコン部分がハイライトされない問題。アイコンの背景が黒いままになってしまいます。これは以前「before-stringに別のオーバーレイのfaceが適用されない」で書いた現象が原因で、そこにも書きましたが回避策はbefore-stringやafter-stringに直接テキスト(アイコン)を書くのではなく、before-stringやafter-stringにdisplayプロパティを指定した文字列を指定して、そのdisplayプロパティでテキスト(アイコン)を表示すると、その部分にはオーバーレイのfaceが適用されるようになります。つまり、次のようにします。 

 (defun nerd-icons-dired--add-overlay (pos string)
   "Add overlay to display STRING at POS."
   (let ((ov (make-overlay (1- pos) pos)))
     (overlay-put ov 'nerd-icons-dired-overlay t)
-    (overlay-put ov 'after-string string)))
+    (overlay-put ov 'after-string (propertize string 'display string))))

次に気がついたのはファイルが消えたのにアイコンが消えない場合があるということです。手っ取り早い対処法の一つはオーバーレイのevaporateプロパティをtにすることです。こうするとファイルの行が削除されたときに一緒にオーバーレイも消えてくれます。上で修正した場所のすぐ下にevaporateプロパティの設定を追加。 

 (defun nerd-icons-dired--add-overlay (pos string)
   "Add overlay to display STRING at POS."
   (let ((ov (make-overlay (1- pos) pos)))
     (overlay-put ov 'nerd-icons-dired-overlay t)
-    (overlay-put ov 'after-string (propertize string 'display string))))
+    (overlay-put ov 'after-string (propertize string 'display string))
+    (overlay-put ov 'evaporate t)))

そもそもDiredバッファの変化を検出するために沢山のadviceを追加していますが、おそらくdired-after-readin-hookでやった方が簡単だと思います。多分。注意点としては、このフックは変更箇所をnarrowingしてから呼び出されるということがあります。なのでこれを使うなら不用意にwidenして全体を処理してはいけません。次のように修正してみました。 

   "Get nerd-icons-dired overlays at POS."
   (apply #'nerd-icons-dired--overlays-in `(,pos ,pos)))
 
-(defun nerd-icons-dired--remove-all-overlays ()
-  "Remove all `nerd-icons-dired' overlays."
+(defun nerd-icons-dired--remove-all-overlays-from-whole-buffer ()
+  "Remove all `nerd-icons-dired' overlays from the whole buffer."
   (save-restriction
     (widen)
-    (mapc #'delete-overlay
-          (nerd-icons-dired--overlays-in (point-min) (point-max)))))
+    (nerd-icons-dired--remove-all-overlays)))
+
+(defun nerd-icons-dired--remove-all-overlays ()
+  "Remove all `nerd-icons-dired' overlays within the narrowed region."
+  (mapc #'delete-overlay
+        (nerd-icons-dired--overlays-in (point-min) (point-max))))
 
 (defun nerd-icons-dired--refresh ()
-  "Display the icons of files in a Dired buffer."
+  "Display the icons of files within the narrowed region of the Dired buffer."
   (nerd-icons-dired--remove-all-overlays)
   (save-excursion
     (goto-char (point-min))
@@ -110,40 +114,22 @@
       (nerd-icons-dired--refresh))
     result)) ;; Return the result
 
+(defun nerd-icons-dired--after-readin-hook ()
+  (when nerd-icons-dired-mode
+    (nerd-icons-dired--refresh)))
+
 (defun nerd-icons-dired--setup ()
   "Setup `nerd-icons-dired'."
   (when (derived-mode-p 'dired-mode)
     (setq-local tab-width 1)
-    (advice-add 'dired-readin :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-revert :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-internal-do-deletions :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-insert-subdir :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-create-directory :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-do-redisplay :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-kill-subdir :around #'nerd-icons-dired--refresh-advice)
-    (advice-add 'dired-do-kill-lines :around #'nerd-icons-dired--refresh-advice)
-    (with-eval-after-load 'dired-narrow
-      (advice-add 'dired-narrow--internal :around #'nerd-icons-dired--refresh-advice))
-    (with-eval-after-load 'dired-subtree
-      (advice-add 'dired-subtree-toggle :around #'nerd-icons-dired--refresh-advice))
-    (with-eval-after-load 'wdired
-      (advice-add 'wdired-abort-changes :around #'nerd-icons-dired--refresh-advice))
+    (add-hook 'dired-after-readin-hook #'nerd-icons-dired--after-readin-hook nil t)
     (nerd-icons-dired--refresh)))
 
 (defun nerd-icons-dired--teardown ()
   "Functions used as advice when redisplaying buffer."
-  (advice-remove 'dired-readin #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-revert #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-internal-do-deletions #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-narrow--internal #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-subtree-toggle #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-insert-subdir #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-do-kill-lines #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-create-directory #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-do-redisplay #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'dired-kill-subdir #'nerd-icons-dired--refresh-advice)
-  (advice-remove 'wdired-abort-changes #'nerd-icons-dired--refresh-advice)
-  (nerd-icons-dired--remove-all-overlays))
+  (kill-local-variable 'tab-width)
+  (remove-hook 'dired-after-readin-hook #'nerd-icons-dired--after-readin-hook t)
+  (nerd-icons-dired--remove-all-overlays-from-whole-buffer))
 
 ;;;###autoload
 (define-minor-mode nerd-icons-dired-mode

これで私の使い方では問題が無いのですが、使い方によってはおかしいこともあるかもしれません。

次にリモート(Tramp経由)のディレクトリで使ったときに遅かったので次のように修正(この辺りはall-the-icons-diredを使っているときに気がついて修正したのを移植したもので、nerd-iconsになってからはあまりテストしていません)。ファイル毎にリモートアクセスが必要な処理をしているのでそれを排除しました。 

 (defun nerd-icons-dired--refresh ()
   "Display the icons of files within the narrowed region of the Dired buffer."
   (nerd-icons-dired--remove-all-overlays)
   (save-excursion
     (goto-char (point-min))
     (while (not (eobp))
       (when (dired-move-to-filename nil)
-        (let ((file (dired-get-filename 'relative 'noerror)))
+        (let ((file (dired-get-filename nil 'noerror))) ;; Full path
           (when file
-            (let ((icon (if (file-directory-p file)
-                            (nerd-icons-icon-for-dir file
-                                                     :face 'nerd-icons-dired-dir-face
-                                                     :v-adjust nerd-icons-dired-v-adjust)
+            (let ((icon (if ;; Avoid using `file-directory-p' as it will
+                            ;; cause remote access.
+                            (save-excursion (forward-line 0)
+                                            (looking-at-p dired-re-dir))
+                            (if (file-remote-p file)
+                                ;; Avoid file-*-p functions
+                                (nerd-icons-sucicon "nf-custom-folder_oct"
+                                                    :face 'nerd-icons-dired-dir-face
+                                                    :v-adjust nerd-icons-dired-v-adjust)
+                              (nerd-icons-icon-for-dir file
+                                                       :face 'nerd-icons-dired-dir-face
+                                                       :v-adjust nerd-icons-dired-v-adjust))
                           (nerd-icons-icon-for-file file :v-adjust nerd-icons-dired-v-adjust)))
                   (inhibit-read-only t))
-              (if (member file '("." ".."))
+              (if (string-match-p "\\(?:\\`\\|[/\\\\]\\)\\.\\.?\\'" file) ;; . or ..
                   (nerd-icons-dired--add-overlay (dired-move-to-filename) "  \t")
                 (nerd-icons-dired--add-overlay (dired-move-to-filename) (concat icon "\t")))))))
       (forward-line 1))))

最後にファイル数が多いときにアイコンを表示しないようにしてみました。 

+(defcustom nerd-icons-dired-max-lines 1000
+  "The maximum number of lines in the buffer in which icons will be displayed.
+Performance can be improved by hiding icons when there are a large
+number of files."
+  :group 'nerd-icons
+  :type '(choice (integer)
+                 (const :tag "No limit" nil)))
+
 (defvar nerd-icons-dired-mode)
 
 (defun nerd-icons-dired--add-overlay (pos string)
@@ -88,6 +96,13 @@
         (nerd-icons-dired--overlays-in (point-min) (point-max))))
 
 (defun nerd-icons-dired--refresh ()
+  (if (and nerd-icons-dired-max-lines
+           (> (line-number-at-pos (point-max) t) nerd-icons-dired-max-lines))
+      ;; If there are many files, it will be very slow, so disable icons.
+      (nerd-icons-dired--remove-all-overlays-from-whole-buffer)
+    (nerd-icons-dired--refresh--internal)))
+
+(defun nerd-icons-dired--refresh--internal ()
   "Display the icons of files within the narrowed region of the Dired buffer."
   (nerd-icons-dired--remove-all-overlays)
   (save-excursion

これらを合わせてnerd-icons-dired/nerd-icons-dired.el at misohena · misohena/nerd-icons-diredに置いてあります。

ちなみにall-the-iconsからnerd-iconsへ移行した理由ですが、私はall-the-iconsが使用するフォントの幅をFont Forgeで無理矢理揃えたものを使用していて、Emacs以外の用途で使うときに困るよなぁ……と前々から心配していたからです。新PCに移行したときに、この書き替えたフォントをインストールするのに躊躇しました。フォント名もちゃんと変えてall-the-icons.elも変えれば良いのかもしれませんが、面倒なので今回はnerd-iconsを使ってみることにしたわけです。

2025-02-17 ,

Emacs用のカラーピッカーに対する最近の変更

最近はまた作図ツールのカラーピッカー部分を色々直していました。

misohena/el-easydraw: Embedded drawing tool for Emacs

先日久しぶりに使ったら変なところが見つかったので、この際溜まっていた改良点をいくつか潰そうと思ったわけです。

特に単独利用、つまり(作図エディタから使うのではなく)任意のバッファ内で色を表すテキストを置き換えたり挿入したりする使い方を中心に直しました。

カラーピッカーを使ってcss-mode内の色テキストを置き換えているところ
図1: カラーピッカーを使ってcss-mode内の色テキストを置き換えているところ

以下修正点:

一時キーマップの不具合を修正
まずはきっかけとなった不具合の修正。カスタマイズバッファ(Custom-mode)内で使ったらエラーが出たので何かなと思ったら、どうも色を決定した後でも一時キーマップが終了していないようでした。なので、C-c C-cやOKボタンで色を決定した後、その次のキー入力が一時キーマップに食われてしまいます。その時C-c C-cでカスタマイズの反映をしようとすると、既に閉じてしまったカラーピッカーのOKボタンが押されてカスタマイズバッファ内の色テキストを置き換えようとし、その場所がすでに編集可能な範囲を外れているとエラーが出るということでした。一時キーマップの使い方を色々見直しました。
子フレームが外に出て一部が見えなくなる問題を修正
表示する位置の計算を調整しました。
別ウィンドウをクリックしてカラーピッカーを出したときの問題を修正
これEmacsでマウスを使うコマンドを書くとよくやっちゃうんですよね。マウスだとカレントバッファや選択中ウィンドウ以外を操作対象に出来るので。
導入を簡単にするマイナーモードを作成
edraw-color-picker-mode と edraw-color-picker-global-mode を追加しました。自分でフックか何かを書いてコマンドを好きなキーに割り当てる人には必要ないのですが、初期設定を簡単にするためのマイナーモードを作成しました。Emacs全体で使えるようにするにはグローバルマイナーモードである edraw-color-picker-global-mode を有効にするだけです。キー割り当てや有効にするメジャーモードは M-x customize-group edraw-color-picker-mode から設定できます。メジャーモード毎にキー割り当てを変えられるようにするため少々苦労しました(バッファーローカルマイナーモードキーマップ)。context-menu-modeが有効な場合はコンテキストメニューにも項目が追加されます。
CSS Color Module Level 4までの各種構文に対応
今のところcolor関数以外のhsl、hwb、lab、lch、oklab、oklchに対応しています。
元の書き方に合わせた置換
置き換える前の色テキストを解析して、使用している構文、単位、空白の入れ方等を置換後のテキストにも反映させました。
出力書式の設定の増強
出力する形式をカスタマイズするためのプロパティも沢山追加しました。が、この辺りはまだまだ整理が必要です。UIもありません。
メニューを追加

メニューから出力形式をある程度選べるようになりました。また、色成分の直接入力や矢印キーによる値の変更など、存在に気がつきにくいコマンドを載せてあります。

メニューでCSSの出力書式を選んでいるところ(日本語環境の場合)
図2: メニューでCSSの出力書式を選んでいるところ(日本語環境の場合)
バッファへの即時反映
デフォルトでは、カラーピッカー使用中に挿入・置換結果が逐一バッファへ反映されるようになりました。css-mode等でバッファ内のテキストに色を付けている場合にはそれも自動的に更新されるというわけです。……しかしテストしてみるとcss-modeやweb-modeだと対応している(色を付けてくれる)構文って結構限られているんですね。
固定パレットの追加
少々見た目が煩雑になってしまいますが、下部に順番固定のパレットを配置しました。エントリーを右クリックするとメニューが出るので、現在選択中の色をそこへ設定できます。パレット全体をファイルへ保存したり読み込んだりも出来ます。作図エディタから使うとパレットの状態は自動的に保存されるのですが、他から使う場合は明示的に保存する必要があります。
M-p/M-nで履歴選択
M-pやM-nで最近使った色を選べるようになりました。
最後に選択した色相を維持
これまでは初期色が無彩色の場合、赤(色相0度)がから始まっていましたが、最後に選択したときの色相から再開するようにしました。ちゃんとやるならもっと色々工夫をしなければならないのですが、とりあえず最低限。
現在の色の表示
エコーエリアに色の情報を表示するようにしました。
デフォルトの大きさを調整
小さいと使いづらいのでデフォルトの大きさ(edraw-color-picker-near-point-scale)を1.0にしました。この辺りはお好みで。

まだまだ直した方が良いところは尽きませんが、少しはマシになったかもしれません。

作図エディタの方も色々改良していますが、それはまたいずれ。

というわけでEmacsのcss-modeやcustomize-face等でカラーピッカーを使う設定の続きでした。その記事を書いてからもう大分経ちましたね。ボヤボヤしていると1年2年あっという間に過ぎてしまうのでホント嫌になってしまいます。

2024-12-12

which-key.elとメニューの定義

Emacs 30からwhich-key-modeが追加されます。which-key-mode自体は何年も前からある(github.com/justbur/emacs-which-key)ようですが、それがEmacsに組み込まれたということのようです。私はこれまで使ったことはありませんでしたが、手元のEmacs 30.0.92に入っていたので使ってみました。

そもそもwhich-key-modeは何かというと、次に押すべきキーを教えてくれる、というと抽象的で分かりづらいでしょうか。一言で言うと、自動的にキーメニューを表示してくれる(グローバルマイナー)モードです。例えばC-xと入力して少し待つ(次に打つべきキーを迷っている)とC-xで始まるキー割り当ての一覧が表示されます。もちろんC-xだけでなく複数のキーストロークが必要な場面では自動的にメニューが出ます。

which-key-modeを有効にしてC-xを押したところ
which-key-modeを有効にしてC-xを押したところ

キーメニューというとHydraやTransientを思い出しますが、これらは基本的には明示的にメニューを定義した上で使うものだと思います。自分で使いやすいようにメニューを設計できますが、逆に言えばそのような手間をかけなければなりません。一方which-key-modeは現在のキーマップから自動的にメニューを作成してくれます。

which-key-modeは事前の定義が不要な分手軽で広範囲で使用できますが、表示されるのは無味乾燥なコマンド名の羅列……と言いたいところですが、そこにはちゃんと対策が用意されています。

次の関数を使うと特定のキー割り当てに対して表示される説明を好きなように変更(置き換え)できます。

後者二つはwhich-key-replacement-alist等のwhich-key専用の変数に置き換えルールを記録しますが、興味深いのは一つ目の特定のKEYMAPに対する説明の置き換えです。which-key-add-keymap-based-replacementsの実装を見れば分かりますが、その情報は指定されたKEYMAPそれ自体に保存されます。説明(replacement)に文字列が指定された場合を追ってみると、最終的には (define-key keymap (kbd key) (cons replacement 元の割り当て)) が実行されていることが分かります。これはいったいどういうことでしょうか？

元々Emacsのキーマップというのはメニューを記述する役割を兼ねています。そのためキーマップにはメニュー項目用の文字列を埋め込めるようになっています。キーマップの書式(Format of Keymaps (GNU Emacs Lisp Reference Manual))にある item-name というがそれです。つまりwhich-key-add-keymap-based-replacementsがやっていることは実質的にはメニューを構築しているようなものです。そしてwhich-key-modeはそのメニューの項目用の文字列をコマンド名の代わりに表示してくれるというわけです。

ということはつまり、わざわざwhich-key-add-keymap-based-replacementsを使わずともキーマップに項目文字列を最初から設定しておけばwhich-key-modeのキーメニューをよりわかりやすく出来るということです。

キーマップを作成するには例えば次のようなコードがよく使われてきました(<Emacs29)。 

(let ((km (make-sparse-keymap)))
  (define-key km (kbd "C-c h c") 'hello-cat)
  (define-key km (kbd "C-c h d") 'hello-dog)
  (define-key km (kbd "C-c h f") 'hello-flog)
  km)

これを次のようにするだけでwhich-key-modeのメニューをよりわかりやすくすることが出来ます。 

(let ((km (make-sparse-keymap)))
  (define-key km (kbd "C-c h") (cons "Hello Animals" (make-sparse-keymap)))
  (define-key km (kbd "C-c h c") '("Cat" . hello-cat))
  (define-key km (kbd "C-c h d") '("Dog" . hello-dog))
  (define-key km (kbd "C-c h f") '("Flog" . hello-flog))
  km)

(注: 最近(>=Emacs29)ではdefine-keyはレガシー扱いとなりkeymap-setやdefine-keymapが追加されていますが、いずれにせよ項目文字列を指定する方法は用意されています)

マイナーモードならこんな感じでしょうか。 

(define-minor-mode hello-animals-mode
  "Hello Animals"
  :keymap
  `((,(kbd "C-c h") . ("Hello Animals" . ,(make-sparse-keymap)))
    (,(kbd "C-c h c") . ("Cat" . hello-cat))
    (,(kbd "C-c h d") . ("Dog" . hello-dog))
    (,(kbd "C-c h f") . ("Flog" . hello-flog))))

実際に有効にして C-c h を押してみたところ、次のように表示されました。

マイナーモードのキーマップに項目名を入れて使ってみた所
マイナーモードのキーマップに項目名を入れて使ってみた所

複雑なキーマップを分かりやすくしたい、でもHydraやTransientを使うのは面倒という場合はこのような工夫をしてみてはどうでしょうか。

余談:

ちなみにキーマップをキーボードで操作できるメニューにしたいのであれば tmm-prompt を使うという方法もあります。 

(defun hello-cat () (interactive) (message "Nya"))
(defun hello-dog () (interactive) (message "Wan"))
(defun hello-flog () (interactive) (message "Geko"))

(let ((km (make-sparse-keymap)))
  (define-key km (kbd "C-c") (cons "C-c" (make-sparse-keymap)))
  (define-key km (kbd "C-c h") (cons "Hello Animals" (make-sparse-keymap)))
  (define-key km (kbd "C-c h c") '("Cat" . hello-cat))
  (define-key km (kbd "C-c h d") '("Dog" . hello-dog))
  (define-key km (kbd "C-c h f") '("Flog" . hello-flog))
  (tmm-prompt km)) ;; (x-popup-menu t km))だとマウスで操作するメニューになる

HydraやTransientは良くも悪くも独特の世界観を作ってしまっているところが欠点ではありますよね。で、作り込んでみてもキー操作を覚えてしまえば見なくなるわけですし。それに一つのメニューの中に沢山のコマンドを表示してしまうと探すのが大変でむしろM-xでミニバッファから補完した方が探しやすいということにもなりかねません。Magitでたまにしか使わないコマンドのキーがメニューから見つけられないことが私は良くあります。いや、MagitはそもそもGitのコマンド体系自体が(以下略

2024-12-11 ,

Diredでファイルの右側に好きな情報を追加する

いやぁ、やっぱりSVGっていいですよね。先日から作っているel-xmpですが、レーティングの表示が単なる数字なのがつまらないのでSVGで描いてみました。ひょっとしたらUnicodeやアイコンフォントで作れるのかなとも思いましたが、よく分かりませんし出来たとしてもフォントへの依存は避けられないと思ったのでSVGでいいや。それで色々調整してこんな感じで生成できました。

2024-12-11-svg-rating-text.png

何がいいって、こういう風にエディタの中に直接結果が挿入されるところですよね。私は80年代のBASICからプログラムを始めた人間ですが、あれもこんな風にコードを書いて実行したらその画面の中の好きな位置に結果が出力されるような環境でした(末尾では無く好きな位置にというのが結構重要だと思っています)。グラフィックスは別プレーンに描いてから無限ループで止めておかなければならなかったりもしましたが、時代が進むとテキストの後ろに合成表示されるようになったりもしました。私はEmacs Lispをいじっているとよくあの頃の感覚を思い出します。

それで気を良くして実際にdiredの中にレーティングを表示させてみたところ……

2024-12-11-dired-with-rating-1.png

あれ、数字のままだ。何でだ？？？

……ああ、私はファイルの詳細情報を右側に表示するためにdired-details-rを使用していたのでした。こいつはオーバーレイ(またはファイル数が多いときはテキストプロパティ)を使用して詳細情報をファイル名の右側に表示します。そしてオーバーレイ(またはテキストプロパティ)のdisplayプロパティを使用してファイル名前後の文字を詳細情報込みの文字列に置き換えることで無理矢理詳細情報を好きな位置に表示させているのでした。

で、SVG画像もまたdisplayプロパティを必要とします。もちろん画像を含めて全てのテキストプロパティをコピーして右側に持ってきているのですが、displayプロパティの中のdisplayプロパティはEmacsの仕様では無視されるため、SVG画像としてでは無く元の数字文字列として表示されてしまうわけです。

なのでいったんdired-details-rを切れば表示されます。

2024-12-11-dired-with-rating-2.png

この通り。

うーん、どうしよう。オーバーレイプロパティのbefore-stringやafter-stringを使えば回避できなくもないけれど、ファイル数が多いときにはテキストプロパティを使いたいので却下。

と、ここで思い出すのは前々回書いたDiredに好きなファイル情報を追加する話。

そこではファイル名の左側に情報を挿入しましたが、ファイルの右側にも情報を挿入できるのでしょうか。

そこでも触れましたが、Diredバッファ内のファイル名が書かれている範囲には dired-filename というテキストプロパティが設定されています。そのためファイル名の前後に何か余計なテキストが挿入されてもファイル名を見失うことはありません。なのでその点だけ見れば大丈夫なはずです。……本当にそうでしょうか？

ファイル名の右側に情報を追加してみる

前と同じサンプルを使って試してみましょう。

ファイルのスコアを書いた.file-score.csvファイル(前と同じ): 

muscat.html,230
melon.html,140
grape.html,185
cherry.html,210
strawberry.html,153

これを読む関数(前と同じ): 

(defun my-dired-sort-read-file-score (dir)
  (ignore-errors
    (with-temp-buffer
      (insert-file-contents (file-name-concat dir ".file-score.csv"))
      (goto-char (point-min))
      (cl-loop until (eobp)
               for (file score) = (split-string (buffer-substring (point) (line-end-position)) ",")
               collect (cons (expand-file-name file dir)
                             (string-to-number score))
               do (forward-line)))))

一つのディレクトリの中のファイルリストの範囲を特定する関数(前と同じ): 

(defun my-dired-next-dir-files-region ()
  ;; ファイル名が無いところをスキップ
  (while (and (null (dired-move-to-filename))
              (= (forward-line) 0)))
  (unless (eobp)
    (let ((beg (line-beginning-position)))
      ;; ファイル名があるところをスキップ
      (while (and (dired-move-to-filename)
                  (= (forward-line) 0)))
      (cons beg (line-beginning-position)))))

で、肝心の追加するところは関数名は同じままで少し変更してみます。 

(defun my-dired-add-file-score-to-region (beg end)
  ;; (↓when-let/if-let廃止するとか言ってるの超うざくね？　アホか)
  (when-let* ((file-score-alist
               (my-dired-sort-read-file-score (dired-current-directory))))
    (goto-char beg)
    (while (< (point) end)
      ;; 各行について (★この辺から変更)
      (when-let* ((file (dired-get-filename nil t)) ;; ファイル名の取得
                  (score (alist-get file file-score-alist nil nil #'string=))) ;; スコアの取得
        ;; 両者取得できたら
        ;; 行末へ(つまりファイル名の右へ)
        (end-of-line)
        ;; スコアを挿入
        (insert (format "  %4d" score)))
      ;; 次の行へ
      (forward-line))))

最後のコマンドの部分(前と同じ): 

(defun my-dired-add-file-score ()
  (interactive nil dired-mode)
  (widen)
  (goto-char (point-min))
  (let ((inhibit-read-only t))
    (while-let ((files-region (my-dired-next-dir-files-region)))
      (let ((beg (car files-region))
            (end (copy-marker (cdr files-region))))
        (my-dired-add-file-score-to-region beg end)
        (goto-char end)
        (set-marker end nil)))))

実際に試してみる

サンプルファイルがあるディレクトリで M-x my-dired-add-file-score したところ、次のような見た目が得られました。 

c:/home/user/tmp/my-dired:
drwxrwxrwx  1 user user 4096 24-12-09 21:44 .
drwxrwxrwx  1 user user 4096 24-12-11 17:38 ..
-rw-rw-rw-  1 user user   87 24-12-09 18:45 .file-score.csv
-rw-rw-rw-  1 user user    8 24-12-09 18:46 cherry.html   210
-rw-rw-rw-  1 user user    7 24-12-09 18:46 grape.html   185
-rw-rw-rw-  1 user user    7 24-12-09 18:46 melon.html   140
-rw-rw-rw-  1 user user    8 24-12-09 18:46 muscat.html   230
-rw-rw-rw-  1 user user   14 24-12-09 18:47 strawberry.html   153

数字の位置がずれているのはご愛敬。揃える処理を入れていないので。問題はDiredとしてちゃんと動作するのかどうか。

少し試したくらいだと問題ないように見えます。wでコピーできるファイル名は正しいものですし、ファイルを開いたりも出来ます。

問題点と原因

しかししばらくいじっているとおかしな所も見つけました。

  • ~ (dired-flag-backup-files) や # (dired-flag-auto-save-files) によるマークができない(バックアップファイルや自動保存ファイルが検出されない)
  • 色付け(fontify、font-lock)がおかしい
    • バックアップファイルなどに色が付かない
    • マークやフラグが付いた行はファイル名だけでなくその右側のスコア部分まで色が付く

調べてみるとやはり行の末尾がファイル名の末尾であることを前提にしたコードが存在していることが分かりました。まぁ、そういうのが嫌なのでdired-details-rはオーバーレイやテキストプロパティを使っていた訳なので、案の定と言ったところです。

マークができない原因は、マークする関数が各ファイル行においてend-of-lineで行末へ飛んでからpreceding-charでその前の文字を取得・チェックしている(~や#であるかどうかをチェックしている)からでした。付近のコメントも読んでみた限り、どうも高速化のためにあえてそのようにしているフシがあります。

色付けについては、font-lockの色付けルール(dired-font-lock-keywords)が全般的に行の末尾がファイル名の末尾であることを前提にして書かれてしまっていることが原因です。例えば一番分かりやすいのが正規表現 $ をファイル名の末尾として使ってしまっている所。 $ の前には拡張子とマッチする正規表現が先行します。なので、ファイル名の後に何か情報を追加すると(その追加した情報の末尾がたまたまマッチしない限り)マッチしなくなってしまいます。

dired-details-rの改善

これらの調査を踏まえた上で、右側に詳細情報を表示したときにSVG画像が反映されない問題は結局はdired-details-rの問題なので、そちらを修正することにしました。

まずは詳細情報の表示を(オーバーレイやテキストプロパティでは無く)テキストの挿入によって行うオプションを追加。これまでにも表示方式を指定するカスタマイズ変数はあったので、そこにテキスト挿入によって表示を行う指定値(text)を追加。そしてオーバーレイやテキストを更新する所では、設定値によって代わりにテキスト挿入や削除を行うように変更。

そして今回見つけたいくつかの弊害に対処。マークの問題は関数を丸丸置き換えるしか無さそう。色付けは問題があるfont-lock-keywordsルールを置き換える関数を作成し、dired-mode-hookで実行。どちらもかなり無理矢理。もちろんまだ見つけていない問題がどこかにあるかもしれませんが、それは見つけたらその都度直しましょう。

というわけで、これによって次のように詳細情報をファイル名の右に表示しつつSVGで描かれたレーティングの星マークも表示できました。

2024-12-11-dired-with-rating-3.png

el-xmpの進捗

el-xmpの方はとりあえず、すぐにやりたいことは一通りやったので一段落といった所でしょうか。まだまだやれることはいくらでもありますがキリがないので。

そうそう、ISO base media file formatというのを解析してメタデータを抽出できるようにしたんですよ(規格書が日本円で3～4万円くらいしててドン引き)。QuickTimeから始まってMPEG4(mp4、m4a)とかJPEG2000なんかもだいたい同じ形式みたいです。基本的な構造はボックスと呼ばれるサイズとタイプのヘッダーから始まるデータブロックの羅列です。ボックスの中にボックスが入れ子になる事が良くあるのでツリーのような構造とも言えますが、それほど自己記述性は無くボックスタイプ毎に定義される内部形式(syntax)が分からなければ中に何が入っているかは分かりません(当然入れ子になっているボックスがあるのかも分かりません)。ボックスタイプは典型的な4文字コードに加えてUUIDでも表現できるようになっていて誰でも他人とぶつからないボックスタイプを追加できます。それでメタデータなのですが、案の定あちこちに散らばっている感じですね。そのファイルの素性毎にどこにあるのかまちまちです。もちろんあらゆる方式に対応することは出来ませんが、とりあえず手元にあるm4aファイルくらいは読めるようにしておきました。それと写真をPhotoshopでJPEG2000で保存し直したものなんかもXMPとEXIFが埋め込まれるので読めるようにしておきました。何なんですかねこれ？　自由にボックスタイプを追加できるからって好き勝手しすぎ。これはそう……まるで闇鍋じゃないか！

© 2025 AKIYAMA Kouhei, all rights reserved.