Monthly Archives: 12月 2022

2022-12-30

cl-defmethodやcl-defunで作成した関数に対するeldocを改善する

例えば次のようなコードを書いたとしましょう。 

(require 'eieio)

(defclass myshape-rect () ;;Emacs Lispは何でもかんでも接頭辞必須なのが鬱陶しいですね。
  ((x-min :initarg :x-min :type number)
   (y-min :initarg :y-min :type number)
   (x-max :initarg :x-max :type number)
   (y-max :initarg :y-max :type number)))

(defclass myshape-ellipse ()
  ((cx :initarg :cx :type number)
   (cy :initarg :cy :type number)
   (rx :initarg :rx :type number)
   (ry :initarg :ry :type number)))

(cl-defmethod myshape-scale ((rect myshape-rect) sx &optional (sy sx) &key (ox 0) (oy 0))
  (with-slots (x-min y-min x-max y-max) rect
    (setf x-min (+ (* (- x-min ox) sx) ox)
          x-max (+ (* (- x-max ox) sx) ox)
          y-min (+ (* (- y-min oy) sy) oy)
          y-max (+ (* (- y-max oy) sy) oy)))
  rect)

(cl-defmethod myshape-scale ((ellipse myshape-ellipse) sx &optional (sy sx) &key (ox 0) (oy 0))
  (with-slots (cx cy rx ry) ellipse
    (setf cx (+ (* (- cx ox) sx) ox)
          cy (+ (* (- cy oy) sy) oy)
          rx (* rx sx)
          ry (* ry sy)))
  ellipse)

で、myshape-scaleメソッドを試してみますか。 

(let ((rect (myshape-rect :x-min 100 :x-max 200 :y-min 1000 :y-max 1100)))
  (myshape-scale …

ん？

2022-12-30-issue-method-args.png

「ARG &rest ARGS」って何だよ。

こんなの見せられたって一つ以上の引数を取る関数としか分からないじゃないか。

いや、分かってるよ。cl-defgenericを書けって言いたいんでしょ？　うっせーバーカ！　それにしたって「ARG &rest ARGS」は無いでしょう。こんなの出すなら何も出さない方がマシ。それとも煽ってるの？

……まぁいいや、とりあえずお試しだからcl-defgenericを書くとして 

(cl-defgeneric myshape-scale (shape sx &optional (sy sx) &key (ox 0) (oy 0)))

sxは2、syもとりあえず2でいいかな。原点は…… 

(let ((rect (myshape-rect :x-min 100 :x-max 200 :y-min 1000 :y-max 1100)))
  (myshape-scale rect 2 2

ん？　なんでsxの部分がハイライトされてるの？

2022-12-30-issue-divided-arg.png

キーワードも全然ダメじゃないか。

2022-12-30-issue-keyword.png

この部分ってアレでしょ？　cl-defunってやつと同じ。Common Lispの。そもそもあれよく知らないんだよね……(cl-defunのお勉強へ)

なるほどね。

cl-defunで定義した関数でも同様の問題が発生します。一つの引数が複数の要素を含むリストになっている場合は必ず問題が生じます。単純に空白で分割しているだけのようです。キーワードも対応するものをハイライトするなんてことにはなっていないようです。

ミニバッファに情報を表示しているのはeldoc。特に関数呼び出し時の表示は elisp-eldoc-funcall の仕事です。

というわけでこの辺りを修正すべく作成したのがこちら。

my-elisp-eldoc-funcall.el

まず関連するメソッドは全て表示します。出し惜しみせず知ってることは素直に全て出せば良いんです。

2022-12-30-fixed-method.png

ちゃんとひとまとまりの部分をハイライトします。

2022-12-30-fixed-divided-arg.png

キーワードも対応する場所をハイライトします。

2022-12-30-fixed-keyword.png

cl-defunで定義した関数にも対応しました。通常の関数と区別が付かないのでちょっと心配ではあるのですが。

&keyと&restは同時にハイライトします。どちらにも入りますからね。

2022-12-30-fixed-cl-defun.png

こういうこともできますが、本当はC++みたいに多重定義を静的に解決してくれたら最高なんですけどね。型推論とか入ってくれてもいいのよ？

2022-12-30-edraw-to-string.png

はぁ、LSPでコードの解析が出来ると騒がしい昨今に何で自分でこんなことやってるんだろう。それも年末に。もう12月30日じゃないですか。

良いお年を。

2022-12-29

cl-defunのお勉強

cl-defunは通常のdefunに加えて便利な機能が付け加えられていますが、正直使いませんしやりたいことに対して過剰に複雑な気がしたのでこれまで学ぶのを避けてきました。

しかし必要になったので諦めて嫌々勉強することにしました。

cl-defunのドキュメント

まずはドキュメントを確認しましょう。 

cl-defun is an autoloaded Lisp macro in ‘cl-macs.el’.
# cl-defun は ‘cl-macs.el’ に自動ロードされる Lisp マクロです。

(cl-defun NAME ARGLIST [DOCSTRING] BODY...)

Define NAME as a function.
# NAME を関数として定義します。
Like normal ‘defun’, except ARGLIST allows full Common Lisp conventions,
and BODY is implicitly surrounded by (cl-block NAME ...).
# ARGLIST が完全な Common Lisp 規則を許可し、BODY が (cl-block NAME ...)
# で暗黙的に囲まれていることを除いて、通常の「defun」と同様です。

The full form of a Common Lisp function argument list is
# Common Lisp 関数の引数リストの完全な形式は

   (VAR...
    [&optional (VAR [INITFORM [SVAR]])...]
    [&rest|&body VAR]
    [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
    [&aux (VAR [INITFORM])...])

VAR may be replaced recursively with an argument list for
destructuring, ‘&whole’ is supported within these sublists.  If
SVAR, INITFORM, and KEYWORD are all omitted, then ‘(VAR)’ may be
written simply ‘VAR’.  See the Info node ‘(cl)Argument Lists’ for
more details.
# VAR は、再帰的に分解用の引数リストに置き換えることができます。これらの
# サブリスト内では「&whole」がサポートされています。 SVAR、INITFORM、
# KEYWORD をすべて省略した場合、「(VAR)」は単に「VAR」と記述できます。詳
# 細については、Info ノード「(cl)Argument Lists」を参照してください。

Web上だとArgument Lists (Common Lisp Extensions)にマニュアルがあります。(ちなみにCommon Lispの場合はCLHS: Section 3.4.1)

通常のdefunと違うのは次の点です:

  • 引数リストの形式を拡張
    • 分割代入(再帰的な引数リストと&whole指定)
    • &optionalの拡張(分割代入、初期値、指定有無変数)
    • &restの拡張(分割代入)
    • &bodyを追加(&restの別名)
    • &keyを追加(名前付き引数(Named parameter - Wikipedia)を実現)
    • &auxを追加(ローカル変数定義)
  • 関数の内部をcl-blockで囲む

cl-blockについては今回の興味の対象外なので、引数について見て行きます。

順番

(VAR...
 [&optional (VAR [INITFORM [SVAR]])...]
 [&rest|&body VAR]
 [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
 [&aux (VAR [INITFORM])...])

&optional、&rest(または&body)、&key、&auxはこの順番でなければならないようです。

違う順番で書くと定義時にエラーになりました。 

(cl-defun test-clfun (a b &rest args &optional e f)
  (list a b c d e f)) ;;Malformed argument list ends with: (&optional e f)

(cl-defun test-clfun (a b &key c d &optional e f)
  (list a b c d e f)) ;;Malformed argument list ends with: (&optional e f)

(cl-defun test-clfun (a b &key c d &rest args)
  (list a b c d args)) ;;Malformed argument list ends with: (&rest args)

(cl-defun test-clfun (a b &aux (z (+ a b)) &optional c d)
  (list a b c d z)) ;;Malformed argument list ends with: (&optional c d)

(cl-defun test-clfun (a b &aux (z (+ a b)) &rest args)
  (list a b c d z)) ;;Malformed argument list ends with: (&rest args)

(cl-defun test-clfun (a b &aux (z (+ a b)) &key c d)
  (list a b c d z)) ;;Malformed argument list ends with: (&key c d)

技術的にはどんな順番でも良さそうな物ですが、処理の順番としては自然な気もします。

同じ物(&～)を複数書いた場合は対応が分かれます。(Emacs 28.2時点) 

(cl-defun test-clfun (a b &optional c d &optional e f)
  (list a b c d e f)) ;;OK!
(test-clfun 1 2) ;;Invalid function

(cl-defun test-clfun (a b &optional (c 100) d &optional e f)
  (list a b c d e f)) ;;OK!
(test-clfun 1 2) ;;OK!

(cl-defun test-clfun (a b &rest rest1 &rest rest2)
  (list a b rest1 rest2)) ;;Malformed argument list ends with: (&rest rest2)

(cl-defun test-clfun (a b &rest rest &body body)
  (list a b rest body)) ;;Malformed argument list ends with: (&rest body)

(cl-defun test-clfun (a b &key c d &key e f)
  (list a b c d e f)) ;;OK!
(test-clfun 1 2) ;;OK!
(test-clfun 1 2 :c 3 :d 4 :e 5 :f 6) ;;OK!

(cl-defun test-clfun (a b &aux (c (+ a b)) &aux (d (* a b)))
  (list a b c d)) ;;OK!
(test-clfun 2 3) ;;OK! (2 3 5 6)

&restで指定出来る変数は必ず一つだけということでしょう。複数の要素が指定出来る物(&～)は(連続する場合に限り)同じ物(&～)を許容する方針のようです(cl–do-arglist内でwhenではなくわざわざwhileが使われています)。ただし&optionalはcl-defun的には良くても実行時にエラーが出る場合がありました。&optionalは元々Emacs Lispで対応しているというあたりが関係しているのかもしれません。元々対応していない初期値指定を入れたら通るようになりました。

&optionalや&key、&auxの後に何も無いのは受け入れられるようです。 

(cl-defun test-clfun (a b &optional)
  (list a b)) ;;OK
(test-clfun 1 2) ;;OK

(cl-defun test-clfun (a b &key)
  (list a b)) ;;OK
(test-clfun 1 2) ;;OK

(cl-defun test-clfun (a b &optional &key &aux)
  (list a b)) ;;OK
(test-clfun 1 2) ;;OK

&restに関しては次の要素が強制的に格納先になる他、末尾での挙動が意図した物なのかは不明です。 

(cl-defun test-clfun (&optional &rest &key &aux)
  (list &key)) ;;OK (&keyという変数になります)
(test-clfun 1 2 3) ;;OK

(cl-defun test-clfun (&optional &rest)
  (list "Hello")) ;;OK! (&rest _と同様の使い方を想定している？ たまたま？)
(test-clfun 1 2 3) ;;OK!

;;ちなみに↑は通常のdefunでは実行時エラーになります。

(defun test-fun (&optional &rest)
  (list "Hello"))
(test-fun 1 2 3) ;;Invalid function

VARに書けるもの(分割代入あるいは再帰的な引数リスト)

(VAR...
 [&optional (VAR [INITFORM [SVAR]])...]
 [&rest|&body VAR]
 [&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
 [&aux (VAR [INITFORM])...])

VARと書いてある部分には再帰的に引数リストが書けます。また、その引数リストの先頭には &whole 変数 という指定ができます。

引数リストを書いた場合はその引数に指定した値が分割代入されます。 

(cl-defun test-clfun (a b (c &optional d e))
  (list a b c d e))
(test-clfun 1 2 '(3 4))
;;=> (1 2 3 4 nil)

(cl-defun test-clfun (a b (c1 (c21 c22 &optional c23 c24) &rest c3s) d)
  (list a b c1 c21 c22 c23 c24 c3s d))
(test-clfun 1 2 '(31 (321 322 323) 33 34) 4)
;;=> (1 2 31 321 322 323 nil (33 34) 4)

引数リストの先頭に &whole 変数 と書いてあると引数全体がその 変数 に格納されます。 

(cl-defun test-clfun (a b (&whole all c d))
  (list a b c d all))
(test-clfun 1 2 '(3 4))
;;=> (1 2 3 4 (3 4))

ここで 変数 と書いているのはVARでは無いということです。ここでは分割代入はできません。 

(cl-defun test-clfun (a b (&whole (all-c all-d) c d))
  (list a b c d all-c all-d))
(test-clfun 1 2 '(3 4));;Wrong type argument: symbolp, (all-c all-d)

&optional

[&optional (VAR [INITFORM [SVAR]])...]

&optionalは通常のdefunにもある機能ですが次の点が違います。

  • VARの分割代入
  • 初期値指定 (INITFORM)
  • 指定されたかを判別する変数 (SVAR)

INITFORM

INITFORMは&optionalや&keyword、&auxで変数の初期化に使う式です。

&optionalと&keyの所にあるINITFORMは指定されなかったときだけ評価されます。初期化されてから上書きされるわけではありません。 

(let ((opt1-count 0)
      (kw1-count 0))
  (cl-defun test-clfun (&optional
                        (opt1 (cl-incf opt1-count))
                        &key
                        (kw1 (cl-incf kw1-count)))
    (list opt1 kw1))
  (test-clfun 100 :kw1 200)
  (message "%s %s" opt1-count kw1-count) ;;0 0
  (test-clfun)
  (message "%s %s" opt1-count kw1-count) ;;1 1
  (test-clfun 2)
  (message "%s %s" opt1-count kw1-count)) ;;1 2

INITFORMは関数内の最初の方で評価されます。呼び出す場所でマクロ展開・評価されるわけではありません。 

(funcall
 (let ((a 2))
   (cl-defun test-clfun (b &optional (c (* a b)))
     (list a b c))
   #'test-clfun)
 3)
;;=>
;;レキシカルバインディング時: (2 3 6)
;;ダイナミックバインディング時: Symbol’s value as variable is void: a

(cl-defun test-clfun (b &optional (c (* a b)))
  (list a b c))

(let ((a 2))
  (test-clfun 3)))
;;=>
;;レキシカルバインディング時: Symbol’s value as variable is void: a
;;ダイナミックバインディング時: (2 3 6)

引数の左側は参照できて右側は参照できません。 

(cl-defun test-clfun (a &optional (b (* a c)) &aux (c 100))
  (list a b c))
(test-clfun 2) ;;Symbol’s value as variable is void: c

SVAR

SVARには省略可能(&optionalまたは&key)な引数が指定されたかどうか(nilまたはt)を格納する変数を指定出来ます。 

(cl-defun test-clfun (&optional
                      (opt1 100 opt1-supplied)
                      &key
                      (kw1 200 kw1-supplied))
  (list opt1 opt1-supplied kw1 kw1-supplied))
(test-clfun) ;;=> (100 nil 200 nil)
(test-clfun 1) => (1 t 200 nil)
(test-clfun nil :kw1 nil) ;;=> (nil t nil t)

引数の値がnilのときに省略されてnilになったのかnilを指定されたのかが区別できます。

ちなみにSVARは分割代入が可能ですが、nilかtしか渡されないのであまり意味は無いと思います。 

(cl-defun test-clfun (&optional (opt1 100 (&whole opt1-sup-all &rest opt1-sup-args)))
  (list opt1 opt1-sup-all opt1-sup-args))
(test-clfun 1) ;;=> (1 t t)

&restまたは&body

[&rest|&body VAR]

&restまたは&bodyの後には一つのVARが続きます。

&restは通常のdefunにもある機能ですが、VARなので分割代入が出来ます。 

(cl-defun test-clfun (a &rest (b c d &key e f))
  (list a b c d e f))
(test-clfun 1 2 3 4 :f 6) ;;=> (1 2 3 4 nil 6)

&bodyという表記には何か意味があるみたいですが詳しいことは知りません。

上でも書きましたが、末尾でVARを書かなくても受け入れられるケースがありますが意図的かは分かりません。

&key

[&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]

&keyはいわゆる名前付き引数を実現するための機能です。

例えば次のような関数呼び出しを実現します。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123) ;;=> (123 234 nil 345)

;; より複雑な例 b:初期値, c:分割代入、初期値、指定の有無
(cl-defun test-clfun (&key a (b 222) ((:c (c1 c2)) '(301 302) c-supplied))
  (list a b c1 c2 c-supplied))
(test-clfun :c '(30001 30002) :a 1 :b 2) ;;=> (1 2 30001 30002 t)

キーワードの順番は自由です。

同じキーワードが指定された場合は最初のものが採用され後のものは無視(破棄)されます。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :b 100 :b 101 :b 102) ;;=> (nil 100 nil nil)

INITFORMやSVARは&optionalの時と同じです。省略時はINITFORMの評価値か、INITFORMが無ければnilです。キーワードが指定されたかはSVARに指定した変数で判別可能です。

問題は肝心のキーワードと受け取る変数を指定する部分です。 

(([KEYWORD] VAR) 略)

と書いてありますが、実際にはもう少し説明が必要でしょう。ここに書けるのは次の3パターンです。

シンボル
次の (シンボル) と等価です。
(シンボル 略)
キーワードと変数を同時に指定します。 シンボル の頭に:を付けたものがキーワードになります。もし シンボル の頭に_があるなら先に取り除いてからキーワードにします(未使用変数をマークできるようにするため)。引数の値は シンボル で指定した名前の変数に格納されます。
((シンボル VAR) 略)
シンボル がそのままキーワードになります。引数の値はVARに格納されます。VARなので分割代入が可能です。

末尾に&allow-other-keysが指定されていると定義されていないキーワードでも受け入れます。これは&restと組み合わせて取得したり単に無視することもできます。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123 :z 999) ;;Keyword argument :z not one of (:a :b :c :d)

(cl-defun test-clfun (&key a b c d &allow-other-keys)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123 :z 999) ;;=> (123 234 nil 345)

または呼び出し側で許可させることも出来ます。 

(cl-defun test-clfun (&key a b c d)
  (list a b c d))
(test-clfun :d 345 :b 234 :a 123 :z 999 :allow-other-keys t) ;;=> (123 234 nil 345)
(test-clfun :allow-other-keys t :d 345 :b 234 :a 123 :z 999) ;;=> (123 234 nil 345)
(test-clfun :allow-other-keys nil :d 345 :b 234 :a 123 :z 999) ;;Keyword argument :z not one of (:a :b :c :d)

&optionalと&keyを同時に指定した場合

&optionalと&keyの両方が引数リストにある場合は注意が必要です。

例えば次のような書き方は問題ありませんが…… 

(cl-defun test-clfun (a b &optional c d &key e f)
  (list a b c d e f))
(test-clfun 1 2 3 4 :e 5 :f 6) ;;=> (1 2 3 4 5 6)
(test-clfun 1 2 3 4) ;;=> (1 2 3 4 nil nil)
(test-clfun 1 2 nil nil :e 5 :f 6) ;;=> (1 2 nil nil 5 6)

&optionalを省略して&keyを指定することはできません。 

(test-clfun 1 2 :e 5 :f 6) ;;=> (1 2 :e 5 nil 6)

そもそも最初から次のようなミスもあり得ます。 

(test-clfun :e 5 :f 6) ;;=> (:e 5 :f 6 nil nil)

位置引数(positional parameter)と名前付き引数(named parameter)の食い合わせが悪いという言い方も出来るかもしれません。&optionalまでが位置で指定する引数であり、キーワードはその後からになります。

&restと&keyを同時に指定した場合

&restと&keyは並列に処理されます。 

(cl-defun test-clfun (a b &rest args &key c d e)
  (list a b c d e args))
(test-clfun 111 222 :c 3 :d 4 :e 5) ;;=> (111 222 3 4 5 (:c 3 :d 4 :e 5))

&optional引数の最後より後は全て&restで指定されたVARに入るとともに、それらは同時にキーワード引数として処理されます。

&restの方にはあくまで指定されたものがそのまま入ります。 

(cl-defun test-clfun (a b &rest args &key c d e)
  (list a b c d e args))
(test-clfun 111 222 :c 3 :e 5 :c 33 :c 333 999 :allow-other-keys t) ;;=> (111 222 3 nil 5 (:c 3 :e 5 :c 33 :c 333 999 :allow-other-keys t))

&aux

[&aux (VAR [INITFORM])...])

&auxは関数内部で使える変数を定義するためのものらしいです。

次の二つの関数は等価です。 

(cl-defun test-clfun (a b &aux (z (+ a b)))
  ""
  ...)
(cl-defun test-clfun (a b)
  ""
  (let ((z (+ a b)))
    ...))

&auxの部分はドキュメント文字列にも載りません。

なぜこんなものがあるのかは次のページの議論が参考になりそうです。

what is &aux used for?

あながち互換性のためだけのものとは言えないかもしれません。letの字下げが鬱陶しいと思ったことは度々あるので、それが抑えられるのは案外嬉しいかもしれませんね。

もし&auxが引数リストのどこにでも書けてINITFORMから参照できたらもっと有用だったかもしれません。……と思いましたが、VARには分割代入で再帰的な引数リストが書けるのですから次のような使い方は出来ますね。 

(cl-defun test-clfun ((&rest lst &aux (lst-len (length lst))) ;;lengthを1回で済ます！
                      &optional (mid (/ lst-len 2)) (upper lst-len))
  (list lst mid upper lst-len))
(test-clfun '(1 2 3 4 5 6 7 8)) ;;=> ((1 2 3 4 5 6 7 8) 4 8 8)

(追記)&optionalな引数は指定もINITFORMも無い場合でもnilが分割代入されるのでしょうか。 

(cl-defun test-clfun (&optional ((&rest lst &aux (lst-len (length lst)))))
  (list lst lst-len))
(test-clfun) ;;=> (nil 0)

うん、ちゃんと&auxの評価されて0になりますね。

実態に即した文法

以上を踏まえて実態に即した文法を書くとだいたい次のような感じでしょうか？ 

LAMBDA-LIST :
  ([VAR]...
   [&optional [SYMBOL|(VAR [INITFORM [SVAR]])]...]...
   [&rest|&body VAR]
   [&key [SYMBOL|(SYMBOL|(SYMBOL VAR) [INITFORM [SVAR]])]... [&allow-other-keys]]...
   [&aux [(VAR [INITFORM])]...]...)

VAR :
  SYMBOL|
  ([VAR]...
   [&whole SYMBOL]
   [&optional [SYMBOL|(VAR [INITFORM [SVAR]])]...]...
   [&rest|&body VAR]
   [&key [SYMBOL|(SYMBOL|(SYMBOL VAR) [INITFORM [SVAR]])]... [&allow-other-keys]]...
   [&aux [(VAR [INITFORM])]...]...)

SVAR :
  VAR

まぁ、ほとんどは明文化されていない未定義状態なのである日突然変わって鼻から悪魔が出ても文句は言えないかもしれません。

続く

何でこんな重箱の隅をつつくようなことをしているかというと引数リストを解析する必要があったからなのですが、それはまた次のお話しということで。あー、やっぱり面倒くさかった。嫌だ嫌だ。

2022-12-26

Windows上のEmacsで初期化を速くする即効性のある方法

Windows上のEmacsは起動もかなり遅く私もこれまでに色々試したのですが、今回はその中で最も効果的だったload-path解決の高速化をご紹介したいと思います。

何が遅いのか

Windows環境でプロファイルをするとすぐに見つかるのが locate-library が遅いということだと思います。つまり、 (locate-library "magit") などとしたときにこれに平気で数十ミリ秒も持って行かれたりします。

試しにやってみましょう。 

(car (benchmark-run 1 (locate-library "magit")))

0.06533

65msかかりました。

今私の手元では (length load-path) は 218 を返してきます。つまり、load-pathに218のディレクトリが設定されているわけです(無駄なディレクトリ多すぎ)。

load-pathの中で最も最後にあるのが (Emacsのインストールディレクトリ)/share/emacs/28.2/lisp/obsolete ですが、その最後のファイルであるyow.elを探してみましょう。 

(car (benchmark-run 1 (locate-library "yow")))

0.113833

なんと113.8msもかかりました。

一方で一番最初のディレクトリにあったのは all-the-icons-dired.el でした。 

(car (benchmark-run 1 (locate-library "all-the-icons-dired")))

0.001121

こちらは1.1msで済んでいます。

load-path上の順番によって処理速度が大幅に変わっていることが分かります。

locate-library よりもやや気がつきにくいのですが、実は require も同じだけかかっています。 (require 'magit) とすれば初回は当然パスを解決するだけで65msかかってしまいます。trampを読み込むだけで1秒以上持って行かれるのには参りました。その中でも分かりやすかったのがring.el。見てみれば分かりますがとてもシンプルなelispですが、やはり60msくらいrequireで時間を消費していました。こんな他のファイルに依存していない小さなファイルの読み込みがそんなにかかるわけがありません。読み込み以前のパスの解決でそれだけかかっているのです。

なぜ遅いのか

知りません。なぜ遅いのかを知るにはC言語のコードに遡って処理を理解する必要がありますが面倒くさいので見ていません。

また、手元のVirtualBoxに入れたUbuntu(Emacs 27.1)で同様の試験をした結果…… 

(benchmark-run 1 (locate-library "yow"))

0.007467886

(length load-path) が165で、一番最後にあるyowのパスを特定するのに7msかかりました。文字通り桁が違います。

というわけでWindows版のEmacsに特有の現象である可能性が高そうです。Windowsのファイル処理が遅いのか、それともWin32APIからEmacs Lispまでの間に何かあるのか、調べてみなければ確かなことは分かりません。まぁ、おそらくその両方でしょう。それにしても100msはとんでもない時間だとは思いますが。Win32で同じ処理を直書きして比較してみたいものです。

詳しい原因は分かりませんが、load-path上の順番で処理時間が大幅に変わることから、毎回ディレクトリを検索している可能性が高そうです。

高速化の方法

であれば解決方法は全ファイルの位置をキャッシュしてしまうことでしょう。

もちろんload-pathとその下にあるファイルが変わらないという前提が必要です。幸い私が利用しているパッケージには少なくとも初期化中にload-pathを書き替えるものはありませんでした。新しくelispを生成する物も無し。強いて言えばpackage.elですが、package-enable-at-startupがtなのでinit.elの前にload-pathが設定されます。未インストールのパッケージを自動的にインストールするようにしているとそのタイミングでload-pathが変わることはあるでしょう。自分用にload-pathを追加しているところもあります。しかし、それ以降は変わることはありません。ある時点から初期化終了まではload-pathが変わらないので、少なくともその期間は問題なくキャッシュ出来るでしょう。

というわけで作成したのが次のコードです。 

;;;; 高速ライブラリパス解決

(defvar my-locate-library-list nil
  "ファイルのベース名をシンボル化したもののリスト。
後でリセットするためのもの。")

(defvar my-locate-library-load-path nil
  "build時点でのload-path。変更を(簡易的に)検出するためのもの。")

(defconst my-locate-library-file-extensions
  (get-load-suffixes)
  "ロード対象の拡張子リスト")
(defconst my-locate-library-file-regexp
  (concat "\\`\\(.*\\)\\(" (mapconcat #'regexp-quote my-locate-library-file-extensions "\\|") "\\)\\'")
  "ロード対象のファイルにマッチし、ベース名と拡張子を取り出す正規表現。")

(defun my-locate-library-build ()
  "`my-locate-library'関数用のデータを構築する。

`load-path'が確定したら呼び出すこと。"
  ;; load-pathの変更を検出するために構築時のload-pathを保存する。
  ;; my-locate-libraryのたびに厳密な検査は時間がかかりすぎてやりたくないが
  ;; せめて先頭の比較くらいはしたい。
  ;; pushやpopしたくらいなら変更に気づけるので。
  ;; 厳密に判定したいなら、copy-sequenceしておいてequalで判定するくらいか？
  ;; もちろんそれでもファイルが増えたことには気づけない。
  (setq my-locate-library-load-path load-path)

  ;; load-path上の全てのディレクトリを走査する。
  ;; 先頭、つまり優先するものから走査する。
  (dolist (dir load-path)
    ;; 存在するディレクトリであること。
    (when (file-directory-p dir)
      (let (files) ;; filesは(ベース名 . 拡張子)のリスト。
        ;; dirの下にあるロード対象ファイルをリストアップする。
        ;; ファイルのベース名と最も優先する拡張子を求める。
        ;; 例: (foo.el foo.elc bar.el bar.txt aaa.txt) => (foo.elc bar.el)
        ;; directory-filesはソートされたリストを返すので、ベース名が一致
        ;; するファイルは隣接することを利用する。
        (dolist (file (directory-files dir))
          ;; 有効な拡張子を持つファイルであること。
          (when (string-match my-locate-library-file-regexp file)
            ;; ベース名と拡張子を取り出す。
            (let ((curr-base (match-string 1 file))
                  (curr-ext (match-string 2 file)))
              ;; 一つ前のベース名と比較する
              (if (equal (car (car files)) curr-base)
                  ;; 一つ前と同じベース名の場合 (e.g. foo.el and foo.elc)
                  ;; 拡張子の優先順位を比較する
                  ;;@todo .elcのタイムスタンプを考慮すべき？
                  (if (< (my-locate-library-ext-priority curr-ext)
                         (my-locate-library-ext-priority (cdr (car files))))
                      ;; 現在のを取る
                      (setcdr (car files) curr-ext)
                    ;; 一つ前のを取る
                    nil)
                ;; 違うベース名の場合
                (push (cons curr-base curr-ext) files)))))
        ;; シンボルを作りそのプロパティにパスを設定する。
        (dolist (base-ext files)
          (my-locate-library-set-path dir (car base-ext) (cdr base-ext)))))))

(defun my-locate-library-ext-priority (extension)
  "EXTENSIONの優先順位を示す整数値を返す。
例えば.elcの方が.elよりも小さな値を返す。"
  (seq-position my-locate-library-file-extensions extension))

(defun my-locate-library-set-path (dir base ext)
  "BASEをシンボル化し、それにファイルへのパス(DIR/BASE EXT)をプロパティとして設定する。"
  (let ((sym (intern base)))
    (unless (get sym 'my-locate-library-path) ;;上書きするとload-pathで後にある方が優先されてしまうので注意。
      (let ((path (file-name-concat dir (concat base ext))))
        ;;(message "library %s path=%s" sym path)
        (put sym 'my-locate-library-path path)
        (push sym my-locate-library-list)))))

(defun my-locate-library-clean ()
  (dolist (sym my-locate-library-list)
    (put sym 'my-locate-library-path nil))
  (setq my-locate-library-list nil))

(defun my-locate-library-rebuild ()
  (my-locate-library-clean)
  (my-locate-library-build))

(defun my-locate-library (file)
  "FILEで指定したファイルがあればそのパスを返す。

`locate-library'は非常に時間がかかるがこれは短時間でチェックできる。

FILEはシンボルでも良く、文字列を指定するよりも速い。"
  (unless (eq load-path my-locate-library-load-path)
    (warn "load-path change detected on (my-locate-library %s)" file)
    (my-locate-library-rebuild))
  ;; 私の手元ではlocate-libraryに拡張子が付いたファイル名や相対パスを指定するコードは無かったので以下は省略。
  ;;@todo 拡張子を考慮 例:(locate-library "tramp.el.gz")
  ;;@todo ディレクトリ名(相対パス指定)を考慮 例:(locate-library "net/tramp")
  ;; (when (stringp file)
  ;;   (when (file-name-directory file)
  ;;     (warn "directory specified on (my-locate-library %s)" file))
  ;;   (when (file-name-extension file)
  ;;     (warn "extension specified on (my-locate-library %s)" file)))
  (get (if (stringp file) (intern file) file) 'my-locate-library-path))

;; 以下、adviceでlocate-library、require、loadを書き替える。

(defun my-locate-library-advice (orig-fun
                                 library &optional
                                 nosuffix path interactive-call)
  (if (or (not (stringp library))
          (file-name-extension library) ;;2022-12-26:追加 動かないケースを除外する
          (file-name-directory library) ;;2022-12-26:追加 動かないケースを除外する
          nosuffix path interactive-call)
      ;; 想定していない使い方の場合はオリジナルを呼び出す。
      (funcall orig-fun library nosuffix path interactive-call)
    (my-locate-library (intern library))))

(defun my-locate-library-require-advice (orig-fun
                                         feature &optional filename noerror)
  (unless filename
    ;; ファイル名(パス)を補う。
    (setq filename (my-locate-library feature)))
  (funcall orig-fun feature filename noerror))

(defconst my-locate-library-load-suffixes-with-nil
  (cons nil (get-load-suffixes)))

(defun my-locate-library-load-advice (orig-fun
                                      file &optional
                                      noerror nomessage nosuffix must-suffix)
  (funcall orig-fun
           (or (and (stringp file)
                    (not nosuffix)
                    (not must-suffix)
                    (not (file-name-directory file))
                    (member (file-name-extension file)
                            my-locate-library-load-suffixes-with-nil)
                    (my-locate-library (file-name-base file)))
               file)
           noerror nomessage nosuffix must-suffix))

(defun my-locate-library-enable ()
  "`locate-library'や`require'、`load'のパス解決を高速化する。

あらかじめ`load-path'が確定した段階で`my-locate-library-build'を
実行しておくこと。

`my-locate-library-disable'で元に戻せる。"
  (advice-add #'locate-library :around #'my-locate-library-advice)
  (advice-add #'require :around #'my-locate-library-require-advice)
  (advice-add #'load :around #'my-locate-library-load-advice))

(defun my-locate-library-disable ()
  (advice-remove #'locate-library #'my-locate-library-advice)
  (advice-remove #'require #'my-locate-library-require-advice)
  (advice-remove #'load #'my-locate-library-load-advice))

locate-libraryには拡張子が付いたファイル名や相対パスも指定出来るようですが上のコードはそれらには対応していません。そのようなコードがある場合は自分で修正して下さい。

使い方は、load-pathが確定した段階で次のようにします。 

(my-locate-library-build)
(my-locate-library-enable)

これでlocate-library、require、loadのよく使われる呼び出し形式が速くなります。ディレクトリを指定したり、ファイルの拡張子を指定したりする一部の呼び出し形式は速くなりません。速くならないどころか正しく動作しない場合もあるので注意して下さい(手抜きです)。

また、使用が終わったら次のようにします。 

(my-locate-library-disable)

いつload-pathが変わるか分かりませんし、locate-libraryやrequire、loadに対して私が考慮していない引数を渡すコードがいつ実行されるかも分かりません。初期化が終わったら念のためdisableしておく方が良いでしょう。

効果の確認

(car (benchmark-run 1 (my-locate-library "yow")))

5e-06

桁が違うどころではありませんね(笑)

通常のlocate-libraryと違いシンボルも受け付けます。こちらの方がinternしなくて良いので若干早くなります。 

(car (benchmark-run 1 (my-locate-library 'yow)))

3e-06

my-locate-library-enableしておけば通常のlocate-libraryも速くなります。 

(my-locate-library-build)
(my-locate-library-enable)
(prog1 (car (benchmark-run 1 (locate-library "yow")))
  (my-locate-library-disable))

4e-06

requireも速くなります。例えば私のload-pathに218個のディレクトリが指定されている環境で、初期化の最初で動作を止めて (require 'tramp)を実行してみましょう。 

(car (benchmark-run 1 (require 'tramp)))

1.269366

1.269秒(笑)

上のコードを評価しつつ有効化した後だと 

(car (benchmark-run 1 (require 'tramp)))

0.197264

197msと大幅に短くなりました。(それでもかなり長いですが)

ちなみにemacs -Q環境だとload-pathの長さは24で (require 'tramp)は366msほどでした。load-pathに登録されているディレクトリが少なく検索する時間があまりかからないケースでは効果も薄くなります。

キャッシュの構築にかかる時間ですが 

(car (benchmark-run 1 (my-locate-library-build)))

0.070408

実行毎にかなりバラツキがあるのですが、70msくらいのことが多いようです。平均的には90msくらい。元のlocate-libraryの1回分と大差ありません。Emacsで全ディレクトリを走査するとそのくらいかかるということなのでしょうね。

初期化プロセス全体だと大量のrequireが発生するのでこれだけで何秒も変わるほどのインパクトがあります。

Emacsの起動時間の短縮はelispの読み込みを遅延するのが王道ですが、Windowsでどうしてもある程度以上短くならないとお悩みの方は試してみてはいかがでしょうか。細かい注意点がいくつかあるので、よく読んだ上でご利用下さい。

まぁ、あとディレクトリも減らした方がいいですね。使っていないの多すぎ。整理しないと。

2022-12-21

Emacsの中で動く作図ツール 最近の変更点

最近またEmacsの中で動く作図ツールをいじっています。

misohena/el-easydraw: Embedded drawing tool for Emacs

作成した図形をカスタムシェイプに登録して使用する様子(gifのため色数少ない)
図1: 作成した図形をカスタムシェイプに登録して使用する様子(gifのため色数少ない)

(↑のgifアニメですが、C-u クリックで既存のアンカーポイントに接続しないでアンカーポイントを追加しています。つまり、一筆書きで描いています。2ストロークに分けた方が自然かもしれません)

最近の変更点:

グループ化機能の改善
最低限実用になる(グループ化を解除できる、つまり使うのをやめられるｗ)程度まで実装しました。いくつか問題は残っています。特に変形。
opacity属性対応
グループ全体の不透明度を変えたかったので。fill-opacityやstroke-opacityとは別に全体の不透明度を指定出来ます。
カスタムシェイプツール追加

あらかじめ定義済みの図形を追加する仕組みです。追加するだけなら簡単なのですが、シェイプピッカーと呼んでいる図形一覧を表示するバッファの作成にとにかく時間がかかりました。非常にカスタマイズ性がある仕組みになっています。org-modeをシェイプピッカーにしてしまおうというアイデアもあったのですが、それはそのうち。

カスタムシェイプツールを使用しているところ
図2: カスタムシェイプツールを使用しているところ
数値入力での拡大縮小・回転機能追加
お天気マークの太陽を描くのに回転機能が必要だったので。問題多し。
全選択・選択解除機能追加
Aでトグルします。
コピー、カット、ペーストのキーを変更
これまでコピーはC-c C-x M-wとかいう複雑怪奇なキー割り当てだったのですが、久しぶりに使ったら全く覚えていなかったので単純にM-w([remap kill-ring-save])にしました。 これに限らず、キー操作をEmacsに似せて良いのかは悩み所です。作図エディタ内の操作はバッファに対する操作とは独立しているので分けた方が良いかなと思っているのですが、作図エディタ操作中は作図エディタの中に集中しているのでバッファに対する操作はしないと考えると極力Emacsの操作体系に似せた方が使いやすいのかなとも思いますがどうなんでしょうね。UndoとRedoはzとZなのですが、慣れていないとついC-/を押してしまうことがあるので迷うところです(よく使う操作なのですぐに慣れてzを押すようになります)。
高解像度環境下でカラーピッカーの座標がずれる問題の修正
Emacsの(というかcreate-image関数の)自動スケーリングを画質の観点からSVG内部で再現しているのにもかかわらず、カラーピッカーだけ画像の自動スケーリングを無効化し忘れていました。つまり自動スケーリングによる拡大が二回分かかっていたことになります。おそらくかなり初期の頃から問題はあったと思います。結局誰も使っていないと言うことでしょう。
カラーピッカーに色無し(none)ボタンを追加
キーボードでnoneと打たなければならなかったので地味に不便でした。
スクロール・ズーム機能

カスタムシェイプを作成するときに欲しかったので。カスタムシェイプは細かい図形が多くなりますし、原点(0,0)に図形の中心を置くとクリックした位置と配置される位置の関係が分かりやすかったりするのでズームとスクロールが必要でした。ズームがC-ホイール、スクロールが中ドラッグでできる他、SPCでインタラクティブなスクロール・ズームモードに入ります。C-ホイールは単にホイールだけにしようか迷いました。中ボタンは使えない人もいるかもしれないので、そういう場合はSPCを使って下さい。小さなサイズのSVGではズームしたときに編集領域(ビュー)自体も大きくなるようにしました。

ズームして小さなアイコンを編集している様子
図3: ズームして小さなアイコンを編集している様子
viewBox属性指定機能追加
SVG要素のviewBox属性を最低限文字列で指定出来るだけです。現状では編集には一切影響が無く、編集が終わった後の表示にのみ効果があります。
画像ツール追加(image要素対応)

jpgやpngといった画像をSVG内に埋め込めるようになりました。data URIは直接的には対応していませんが自分で変換してプロパティエディタからhref属性に指定すれば使えるとは思います。ただ、あまり容量が大きい物をdataで埋め込むのもどうかなと。Windows等で画像が表示されない場合はgdk-pixbufがらみのファイルを確認しましょう。librsvgはgdk-pixbufを使用して画像を描画するので。

画像ツールで画像を配置した例
図4: 画像ツールで画像を配置した例
内部での数値の持ち方やSVG出力時の数値の形式を改善
.0を出さないようにしたり、内部的な構造を少し見直したり。
プロパティエディタの改善
作図エディタ終了時に自動的に閉じるようにしたり、入力中の数字が微妙に変わってしまう問題(100.00が100になったり100.01から100.009999になったり)を修正しました。
edrawリンクの右クリックメニューを改善

これまでインライン画像に対する右クリックメニュー(コンテキストメニュー)にはEditだけしかありませんでしたが、便利な機能をいくつか追加しました。図形の中身を作図エディタを開かずコピーして他の作図エディタへペーストできたり、SVGのコードを表示したり、data=形式とfile=形式の相互変換が出来たりします。

インライン画像化されたedrawリンクを右クリックしたときの様子
図5: インライン画像化されたedrawリンクを右クリックしたときの様子
fileリンク対応
[[file:somefile.edraw.svg]] のようなリンクをその場で編集するコマンドを追加しました。 [[edraw:file=somefile.edraw.svg]] の方が使い勝手が良いとは思うのですが、エクスポータがらみで通常のリンクにしたい場合は有用です。
rectとellipseをpathへ変換する機能を追加
rectやellipseは座標軸に沿った矩形や楕円しか表現できないので、回転するならtransform属性を使用するかpathへ変換する必要があります。transform属性は拡大縮小時に線の太さも変わってしまうので、それを回避したければpathへ変換するのが手っ取り早いです。
latexエクスポータを追加
私はあまり使わないのですが一応対応。

今後の予定:

変形まわりを何とかしたい
アンカーポイント座標のみの変形と図形全体の変形(transform属性)が現状でごっちゃになっています。グループだけ最初からtransform属性で変形しています。他の要素はtransform属性がある場合はそれに追加する形で変形していて、無い場合はアンカーポイント座標のみで変形しています。一貫性がありません。どちらの方式にも利点があるのでどう切り替えるか。また、GUIで変形したいです。
カラーピッカーやプロパティエディタ、シェイプピッカーは別フレームで表示したい
親フレームからはみ出せる子フレームって作れるのかな。

大きな物はこのくらいでしょうか。Emacsに最低限の作図ツールをもたらすという観点から言えば残っている物はそれほど多くはありません。

必要は最大のモチベーション、ということで自分が必要だと思う物を気ままに作っていくだけです。

© 2024 AKIYAMA Kouhei, all rights reserved.