Yearly Archives: 2022

2022-12-30 Emacs

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 …

ん？

「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の部分がハイライトされてるの？

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

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

なるほどね。

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

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

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

my-elisp-eldoc-funcall.el

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

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

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

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

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

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

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

良いお年を。

2022-12-29 Emacs

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 Emacs

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 Edraw, Emacs

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

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

misohena/el-easydraw: Embedded drawing tool for Emacs

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

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

phscrollの修正

org-modernと組み合わせたときにいくつか問題が目に付いたので修正しました。ついでに修正した点もいくつか。

misohena/phscroll: Enable partial horizontal scroll in Emacs

主な修正点:

phscroll-use-fringeをdefvarからdefcustomへ変更
左右スクロールコマンドでポイント位置を動かすオプションを追加
左右スクロールコマンドでスクロールする方向を反転するオプションを追加
Shift+マウスホイールでのスクロールに対応
orgテーブルの直後を余分にスクロール領域にしてしまうミスを修正
フィールドテキストがあるときに正しく動作しない問題を修正
org-phscroll使用時はmodification-hooksでは更新せずfontify時に更新するように変更
font-lockへの登録方法を修正
ピクセル単位で幅計算するオプションを追加(実験的)

左右スクロールコマンドが使いづらいという指摘があって私も同感で使っていないのですが、ポイントも一緒に動くようにしたりして少しはマシになりました。元々Emacs標準のscroll-left(C-x <)、scroll-right(C-x >)を真似た物でしたが、それ自体使いづらいですからね。

ついでにマウスのホイールに対応してみました。プラットフォームによってホイールのイベント名は変わるそうですね？　知りませんでした。mouse-wheel-up-eventやmouse-wheel-down-eventという変数にシンボルが格納されているのでそれを使うのだとか(Misc Events (GNU Emacs Lisp Reference Manual), mwheel.el)。

font-lockのキーワードまわりをあまりよく理解していなかったので必要な部分だけ少し勉強しました。font-lock処理(fontify? highlight?)(font-lock-fontify-keywords-regionを参照)はキーワードリストを上から順に処理していきますが、一つのキーワードで対象範囲の最初から最後までを処理してから次のキーワードをまた最初から処理する流れになっています。何となく複数のキーワードをまぜこぜに処理していくような気がしていたのですがそんなわけはありませんでした。一つの関数でマッチからハイライトまでをやってしまう場合、いくつか注意すべき点があります。基本的にmatcherの関数はre-search-forwardの代わりに呼ばれているので、tを返す場合はmatch-dataも有効でなければなりません。nilを返すのであればその限りにあらず。どちらにせよ一度に一箇所しか処理してはいけないという制約はありません。範囲内全てを一度に処理することは可能です。ただしmultilineや無限ループ回避のコードには注意が必要。

orgやorg-modernのfont-lock処理が終わってからでないと正しいテキスト幅が計算できないという問題に気がつきました。phscrollではテキストの幅を正しく計算することが求められます。これまではオーバーレイのmodification-hooksでテキストの変更を検出して更新処理を行っていましたが、それでは不十分でした。orgがリンクのパス部分を非表示にする(invisibleテキストプロパティにシンボルorg-linkを設定する)とテキストの変更無しに幅が縮まります。org-modernがテーブルの縦線を細くしてもテキストの(ピクセル)幅は縮まります。phscrollはその直後に水平スクロールに必要な幅の計算をしなければなりませんでした。

これまで幅の計算は文字数単位で行っていましたが、org-modernがテーブルの縦線を細くしてしまうと文字数は変わらないのに全体のピクセル数は小さくなってしまいます。すると縦線(テーブルの列)が沢山あるほど右側に無意味なスペースが空くことになっていました。これはピクセル単位で幅の計算をしなければ解決できません。

ピクセル単位での幅の計算は window-text-pixel-size 関数を使用しました。自分でテキストプロパティやオーバーレイを解析して計算しても良いのですが、なかなか完璧には出来ないので。

window-text-pixel-size 関数を使うにしても色々とやっかいな点があります。一番やっかいだったのは、折りたたまれて非表示になっているテキストに対してfont-lock処理が働く場合があることです。非表示になっているので window-text-pixel-size で計算しても幅は0になってしまいます。この問題に対しては、折りたたみ部分を隠すためのオーバーレイ(invisible=(outline . t)が設定されている)を一時的に表示状態(invisible=nil)にすることで解決しました。そんなことをして大丈夫なのか自信が無かったのですが、とりあえず動いています。最初は buffer-invisibility-specからoutlineを抜けば良いと思ったのですが、それだと他の非表示部分(リンクのパス部分など)が全て表示された状態で幅の計算をしてしまいます。テキストプロパティがどうであろうと、上に乗っかっているオーバーレイの非nilなinvisibleプロパティが優先されるようです。オーバーレイのinvisibleプロパティがoutlineである以上、その範囲内は全てinvisible=outlineであり、buffer-invisibility-specからoutlineを消した以上全て表示されてしまうのです。何はともあれ、この方法で解決して良かったです。ダメならそれこそ自分で幅の計算(というかもはや推測)をしなければいけないところでした。また、指定のピクセル幅を超えるテキスト位置を求める必要がありましたがそのような機能はどこにも無いため二分探索で何とかしました。

一応ピクセル単位での幅計算はオプションでデフォルト無効にしてあります。ちょっと重いような気もするので。

というわけでorg-modern下でもそれなりの見た目が実現出来ました。

私はこのプロジェクトがあまり良いものだとは思っていません。一応実用にはなるのですが、やり方はかなり強引ですし、同じ場所を幅の違う複数のウィンドウから見たら破綻するという根本的な問題も抱えています。理想的には、Emacsに折り返しを制御するような特殊なテキストプロパティを追加するのが良さそうに思えます。line-prefixやwrap-prefixと似たようなものです。いつかEmacsにそのような機能が追加されるのを夢見つつ、それまでのつなぎとして作っています。

2022-11-22 Emacs, org-mode

Emacs Lisp要素へのリンクをorg-modeに追加する

(2024-01-16追記: エクスポートに対応したのを書きました)

Emacs Lispの関数や変数、フェイスの定義へリンクを張ろうと思ったら次のような方法くらいしか無いらしい。

- [[elisp:(find-function 'org-mode)]]
- [[file:c:/app-install-dir/emacs-28.2/share/emacs/28.2/lisp/org/org.el::(define-derived-mode org-mode outline-mode "Org"]]

参考: Org-mode link to function definition - Emacs Stack Exchange

ファイル名はバージョンによってパスが変わってしまう。elispリンクタイプは評価するかの確認が必要。

ということで自分で定義した方が良さそう。

(org-link-set-parameters
 "elisp-function"
 :follow (lambda (str) (find-function (intern str))))

(org-link-set-parameters
 "elisp-variable"
 :follow (lambda (str) (find-variable (intern str))))

(org-link-set-parameters
 "elisp-face"
 :follow (lambda (str) (find-face-definition (intern str))))

[[elisp-function:org-version]]

[[elisp-variable:org-version]]

[[elisp-face:org-todo]]

2022-11-19 Emacs

diredに「戻る」機能を追加する

diredにディレクトリを「戻る」機能が無かったので追加してみました。

前提として、私はディレクトリを開くときに元のdiredバッファをkillするように改造して使っています。遙か昔Emacsを使い始めたときに真っ先に気になったことの一つがそれ。いつの間にかEmacsがdiredバッファだらけになっていてびっくりするわけです。他のEmacsユーザのことはほとんど知りませんが、多くの人が気になって直したのではないでしょうか。今日作業中に気がついたのですが、Emacs28からはdired-kill-when-opening-new-dired-bufferというカスタマイズ変数が追加されています。まさにそれを実現するための機能が長い時を経て追加されていました。

それでなぜ今になって戻る機能が欲しくなったかというと、新しいPCでシンボリックリンクを使ったからです。私は普段HOMEディレクトリをUSERPROFILE(C:/Users/名前/)とは別の場所に設定して使っています。C:/home/名前/のように。しかしそうするとUsersとhomeの使い分けが問題になってきます。私はUsersディレクトリはほとんど無視してhomeの中だけで過ごしてきました。そもそもWindows95系にはUsersなんてディレクトリは無かったはずです。古くからのユーザにはC:/の直下に好きなようにファイルを置いている人もまだいるかもしれません。それはともかく、私の使い方ではUsersとhomeが微妙に役割が被るケースがありました。その最たる物がdownloadsディレクトリです。私はこれまでUsersの下のディレクトリは使わずにC:/home/名前/downloadsというディレクトリを作って使っていました。しかし新しいPCをセットアップするたびにC:/Users/名前/Downloadsにファイルがダウンロードされてしまうわけです。ブラウザの設定をまだ変えていないので。ブラウザの設定を変えるのにも飽き飽きしてきましたし、エクスプローラで見たときにUsersの下のDownloadsディレクトリの方がアイコンが付いていて見た目が良く操作もしやすいという利点もあったので、 mklink /d C:\home\名前\downloads C:\Users\名前\Downloads でシンボリックリンクを張ってみたというわけです。個人的にはWindowsでシンボリックリングが欲しくなることというのはほとんど無いのでちょっと新鮮な気分でした。ちなみにシンボリックリンクを作るにはデフォルトでは管理者権限が必要みたいなのですが、Windowsを開発者モード(何だそりゃ)というのにすると管理者権限が無くても大丈夫になるようです。それでEmacsのdiredからC:/home/名前/downloadsディレクトリを開いてみると、C:/Users/名前/Downloadsが開きました。おおちゃんと対応しているじゃないかと気を良くして^を押して上のディレクトリに戻ろうとするとhome側では無くUsers側で上のディレクトリに移動してしまうわけです。原因の一端は find-file-visit-truename が t になっていることにありました。これがtだと開いた段階でシンボリックリンクの名前では無く、真のファイル名で開いてしまうわけです。nilにすればC:/home/名前/downloadsというパスでdiredが開くので、^を押したときにちゃんとC:/home/名前/に戻ります。しかし私は find-file-visit-truename を t に設定した覚えがありません。変数のドキュメントを見るとOriginal valueはnilだと書かれていますし実際files.elのdefcustomはnilです。探してみると、w32-fns.elの先頭付近でWindowsであればtに変更していました。8.3やlongnameを同一のバッファで開くというようなコメントがあります。今時8.3なんてお目にかかりませんしnilにしても問題ないような気がしましたが、念のためいじらないでおこうと思います。となるとシンボリックリンクの飛び先から戻るために最後に開いていたディレクトリに「戻る」機能が必要になるというわけです。ヤレヤレ！

HelpやInfoにも l で戻る機能がありますし、同じキーで戻れるようにしておけば直感的かもしれません。 l はdired-do-redisplayですが個人的には使っていません。 g を押してしまいますし。

既にあったコードも含めて次のようになりました。

(with-eval-after-load "dired"
  ;; 戻る機能を実現する
  
  (defvar-local my-dired-dir-history nil)

  (defmacro my-dired-dir-history-push (&rest body)
    (let ((new-hist (gensym))
          (result (gensym)))
      `(let ((,new-hist (cons (dired-current-directory) my-dired-dir-history))
             (,result (progn
                        ,@body))) ;;ここで新しいバッファを開く
         (setq-local my-dired-dir-history ,new-hist) ;;新しいバッファに履歴を持たせる
         ,result)))

  (defun my-dired-dir-history-back ()
    (interactive)
    ;; 存在しないディレクトリをスキップする。
    (while (and my-dired-dir-history
                (not (file-directory-p (car my-dired-dir-history))))
      (setq my-dired-dir-history (cdr my-dired-dir-history)))
    ;; 最近のディレクトリを開く。
    (when my-dired-dir-history
      (let ((last-dir (car my-dired-dir-history))
            (new-hist (cdr my-dired-dir-history)))
        (set-buffer-modified-p nil)
        (find-alternate-file last-dir)
        (setq-local my-dired-dir-history new-hist))))

  (define-key dired-mode-map "l" #'my-dired-dir-history-back) ;;dired-do-redisplayは個人的に使っていないのと(gを使ってしまう)、helpやinfoがlで戻るのでそれに合わせる。

  ;; aで開いたときに現在のディレクトリを履歴に記録する。

  (defun my-dired-find-alternate-file-for-record-dir-history (original-fun)
    (my-dired-dir-history-push
     (funcall original-fun)))
  (advice-add #'dired-find-alternate-file
              :around
              #'my-dired-find-alternate-file-for-record-dir-history)

  ;; ;; Emacs 28以降でdired-kill-when-opening-new-dired-bufferを使って
  ;; ;; e, f, ^でディレクトリを開いた場合に対応する。
  ;; (defun my-dired--find-file-for-record-dir-history (original-fun find-file-function file &rest args)
  ;;   (if (and (eq find-file-function #'find-alternate-file)
  ;;            (file-directory-p file))
  ;;       (my-dired-dir-history-push
  ;;        (apply original-fun find-file-function file args))
  ;;     (apply original-fun find-file-function file args)))
  ;; (when (and (fboundp 'dired--find-file)
  ;;            (boundp 'dired-kill-when-opening-new-dired-buffer)
  ;;            dired-kill-when-opening-new-dired-buffer)
  ;;   (advice-add #'dired--find-file
  ;;               :around
  ;;               #'my-dired--find-file-for-record-dir-history))
  ;; ↑動作未確認。
  ;; Emacs28以降であれば下の修正をせずに上の修正をしてdired-kill-when-opening-new-dired-bufferをtにすれば良い、はず。

  ;; 元々修正していたファイルを開く処理

  (defconst my-dired-open-desktop-extensions
    '(;;"pdf" <=use pdf-tools
      "xls" "xlsx" "docx" "vsd"
      "psd"
      "wav" "mp3" "aac" "au" "ogg" "flac"
      "mp4" "avi" "mpg" "mpeg"))
  (defun my-dired-w32-open ()
    (interactive)
    (w32-shell-execute "open" (dired-get-filename)))
  (defun my-dired-find-alternate-file ()
    (interactive)
    (cond
     ;; directoryはdired-find-alternate-file(aキー相当)で開く
     ((file-directory-p (dired-get-filename))
      (dired-find-alternate-file))
     ;; 一部の拡張子はw32-shell-executeで開く
     ((member (file-name-extension (dired-get-filename)) my-dired-open-desktop-extensions)
      (my-dired-w32-open))
     ;; emacsで開く
     (t
      (dired-find-file))))

  (define-key dired-mode-map "\C-m" 'my-dired-find-alternate-file) ;;C-mやRET

  ;; 元々修正していた上ディレクトリに移動する処理
  ;; (dired-up-directoryのコードをちょっと修正した物です)

  (defun my-dired-up-directory (&optional other-window)
    "Run dired on parent directory of current directory.
Find the parent directory either in this buffer or another buffer.
Creates a buffer if necessary."
    (interactive "P")
    (let* ((dir (dired-current-directory))
           (up (file-name-directory (directory-file-name dir))))
      (unless (equal dir up)
        (or (dired-goto-file (directory-file-name dir))
            ;; Only try dired-goto-subdir if buffer has more than one dir.
            (and (cdr dired-subdir-alist)
                 (dired-goto-subdir up))
            (progn
              (if other-window
                  (dired-other-window up)
                ;; ここから修正
                ;; 元は(dired up)
                ;; Emacs28からは(dired--find-possibly-alternative-file up)
                (my-dired-dir-history-push
                 (set-buffer-modified-p nil)
                 (find-alternate-file up))
                ;; ここまで修正
                )
              
              (dired-goto-file dir))))))

  (define-key dired-mode-map [delete] 'my-dired-up-directory) ;;Back Space
  (define-key dired-mode-map "^" 'my-dired-up-directory) ;;^

);;with-eval-after-load "dired"

dired-kill-when-opening-new-dired-bufferを使う方法に切り替えようかなとも思いましたが、たまにEmacs27以前をテストのために立ち上げることがあるのでしばらくは使わずにいようと思います。

HOMEをUSERPROFILEと同じにしてしまうという手も考えなくも無いんですけどね。C:/Users/名前/下の乱雑さを見ると気が引けてしまいます。整理していない(アプリが勝手にいじくるママにしている)からというのもあるのでしょうけど。

2022-11-19 Computer

新しいPCのセットアップ

新しい ~~おもちゃ~~ サブ機が届いたのでセットアップした。

winget install -e --id Google.Chrome
winget install -e --id Dropbox.Dropbox

regedit SwapCtrlCaps_EscZenkaku.reg
……で済むと思いきや、キー配列的にESCと全角半角は入れ替える必要が無かった。

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Keyboard Layout]
"Scancode Map"=hex:00,00,00,00,00,00,00,00,05,00,00,00,29,00,01,00,3a,00,1d,00,\
  01,00,29,00,1d,00,3a,00,00,00,00,00

05→03にして29,00,01,00と01,00,29,00を削除。

手動インストール:kanalock
手動インストール:XKeymacs
winget install -e --id Microsoft.VCRedist.2015+.x86
winget install -e --id Microsoft.VCRedist.2015+.x64
(Xkeymacsに必要だったので)
手動インストール:ATOK
手動インストール:Git for Windows
(wingetだと–location=が効かない。初期設定も出来ない)
winget install -e --id Microsoft.WindowsTerminal
Windows標準のOpenSSHをアンインストール。
winget install -e --id msys2.msys2 --location "c:\app\msys64"
- ユーザ環境変数設定
  - HOME=場所を指定
  - MSYSTEM=UCRT64
  - MSYSTEM_CARCH=x86_64
  - LANG=ja_JP.CP932
  - PATH=色々追加
- etc/fstabで/homeをHOMEの場所にマッピング。
- pacman -Syuuで先にパッケージデータベースを最新にしておく。
- pacman -S <package-name>
  - openssh
  - unzip
  - zip
  - rsync
  - base-devel
  - msys2-devel
  - msys2-runtime-devel
  - mingw-w64-ucrt-x86_64-toolchain
  - mingw-w64-ucrt-x86_64-gnupg
  - mingw-w64-ucrt-x86_64-emacs
  - mingw-w64-ucrt-x86_64-imagemagick
  - mingw-w64-ucrt-x86_64-librsvg
  - mingw-w64-ucrt-x86_64-graphviz
  - mingw-w64-ucrt-x86_64-clang
  - mingw-w64-ucrt-x86_64-clang-tools-extra (clangd)
  - mingw-w64-ucrt-x86_64-7zip
  - mingw-w64-ucrt-x86_64-wget2
  - mingw-w64-ucrt-x86_64-ripgrep
  - mingw-w64-ucrt-x86_64-emacs-pdf-tools-server
  - libiconv-devel
  - mingw-w64-ucrt-x86_64-boost
- ssh-keygenして公開鍵をGitサーバ(GitHub等)に登録。
- Emacsの設定をチェックアウト。
- .bashrcとかの設定。
- ビルド&インストール(usr/local/bin)
  - (UCRT64)nkf (CFLAGSに-DDEFAULT_CODE_UTF8=1を指定したバージョンも作る)
  - (MSYS2)git-encwrapper
  - (MSYS2)win-ssh-agent (環境変数をフルパスで設定するように修正)
winget install -e --id evernote.evernote
winget install -e --id IrfanSkiljan.IrfanView
winget install -e --id Adobe.Acrobat.Reader.64-bit
後は必要に応じて。SSD容量がそれほど無いので。
reg add "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\DWM" /v "AccentColorInactive" /t REG_DWORD /d 0x00ffffff
Chromeが非アクティブの時のタブバーの色を設定。エクスプローラのタブバーはアクティブ時にアクセントカラーにならないのかしら。

最初はやっぱりキーボードの設定。まずは全角半角-ESCとCtrl-Capsの入れ替え……ってEscが1の真上にある。全角半角はその右。これは入れ替えなくて良いかな。後はXKeymacsと自作のカナロックアプリ。未だに動いてくれるのはありがたいね。

今回はwingetを積極的に使ってみてるけどなんか微妙。普通のインストーラをダウンロードしてサイレントインストールしてくれるけど、たまに–location=が無視されるし、セットアップ中の細かい設定が出来ないしで結局自分で落としてインストールした方が早いのではと思うことがたまにある。でも基本的には良いものだと思う。特に既存のインストーラシステムを尊重しているところが。それ故うまく行かないところがあるのも仕方なし。Windows SDKのバージョン違いが複数入っているとずっとアップグレード対象になってしまうのは既知の問題みたい。

今回はCygwinは入れないでMSYS2だけで環境を構築してみることにした。同じような物を二つも入れておくことに近年疑問を持っていたので。環境はMinGW64ではなくUCRT64を選択。最近はUCRT64が推奨環境らしいので。今のところ特に問題なし。

Emacsはmingw-w64-ucrt-x86_64-emacsを使用。MSYSのEmacsパッケージを常用するのは初めて。これまではIMEパッチを当てて自分でビルドするか、配布のバイナリを使ってきたので。ネイティブコンパイルは普通にしてくれる。librsvgは自動で入らないのね。mingw-w64-ucrt-x86_64-gnupgを入れないとpackage-install-selected-packagesが出来ないので焦った。

初Windows11環境。相変わらずタスクバーやスタートメニューが変わっているけど問題なし。どうせCtrl+Esc(またはWin)で開いてアプリ名を数文字入れるのにしか使っていない。あ、ucrt64/bin/runemacs.exeへのショートカットを作ってemacsにリネームしてスタートメニューに入れておく作業を書いていなかった。他と被らない二文字をショートカットのファイル名にしてスタートメニューに入れておいたりも良くする。二文字打ってEnterすれば実行できるので。Win95の頃はスタートメニューに検索機能は無かったけど、フォルダ名やショートカットファイル名の先頭文字を工夫することで同じ事が出来た(その時はEnterは不要で本当に二文字で起動できたはず。例えばフォルダ名がMicrosoft→ショートカットファイル名がExcelなら Ctrl+Esc m e で Excelが起動できたり。今は Ctrl+Esc e x Enter くらい。Enterが余計)。

2022-11-13 Emacs

Windows上のMagitでコミットメッセージを編集できるようになるまでが遅すぎるので調査してテキトーキャッシュで改善してみた

別に今に始まったことでは無いのですがMagitが遅すぎるんですよ。MS-Windowsで。stageした後、c cを押してからコミットメッセージが書けるようになるまでにいったい何秒待たされることか。待っている間に何を書こうとしたか忘れるくらい遅いんです。一回だけならまだ我慢しましょう。でも変更点を部分的にstageしてコミット、それを何度も繰り返すようなときはかなりウンザリします。

最近VCを試しました。Emacsに昔から標準で入っているバージョンコントロール機能です。私は昔からこれを避けてきました。ちゃんと動かないことが多かったので。CVSにせよSVNにせよ専用のクライアント(pcl-cvs.elやpsvn.el)が軽快に動作していましたし。Gitになってからも試しましたが文字化けしていたので直さないとなと思いつつ放置していました。最近再び試したところ意外なことにちゃんと動くではありませんか。それもMagitのように遅くありません。軽快に動きます。

もうこれで良いんじゃないかとも思いましたが、やはりMagitの機能は魅力的です。特に部分的なstageはもはや手放せません。

そうしてMagitに戻ってみると、コミット時の待ち時間があまりにも長いことが気になってきました。やることと言えば単にコミットメッセージを入力するバッファを開くというだけです。まだコミットすらしていない段階です。それだけで8秒かかります。

絶対におかしい。やっていることに比して時間がかかりすぎです。ということで調査してみました。

マニュアルに書かれている対策

パフォーマンスについてはマニュアルに少し記載があります。

Performance (Magit User Manual)

Windows向けのGitの設定。

git config --global core.preloadindex true   # default since v2.1
git config --global core.fscache true        # default since v2.8
git config --global gc.auto 256

コミット時にdiffを自動的に表示しない設定。

(remove-hook 'server-switch-hook 'magit-commit-diff)
(remove-hook 'with-editor-filter-visit-hook 'magit-commit-diff)

もちろんこれらを試してみましたが、まだまだ全然遅いです。

コミット時の流れを把握

Magitのバッファからc cを押すと実行されるのが magit-commit-create です。この関数(コマンド)は基本的に git commit を非同期で実行するだけです。

この部分の面白いところは with-editor という仕組み(マクロ)を使用している点です。 with-editor は、Emacsから外部コマンド(今回の場合は git commit)を呼び出してそのコマンドがエディタを起動するときに自身がそのエディタになる(コマンドを呼び出したEmacsのプロセスでファイルを開くようにする)ための仕掛けです。具体的には次のような流れになります。

Emacsサーバを起動します。
環境変数GIT_EDITORにemacsclientを指定します。1で起動したサーバの情報も付け加えて確実にemacsclientがそのサーバと接続出来るようにします。
非同期でgit commitを起動します。git-commit-createはすぐに終了します。
gitはコミットメッセージを求めてエディタを起動します。起動するのはGIT_EDITORに書かれているemacsclientです。エディタへの引数としてコミットメッセージを書くためのファイル(.git/COMMIT_EDITMSG)を指定します。
emacsclientはEmacsサーバに接続してCOMMIT_EDITMSGを開くよう要求します。
gitを起動したEmacs側では、Emacsサーバがその要求を認識してCOMMIT_EDITMSGを開きます。

こんなまどろっこしいことをしなくてもgit起動時に直接コミットメッセージを渡せば良いと思うかもしれませんが、gitはCOMMIT_EDITMSGに色々な情報をコメントで付け加えてからエディタを起動するので、その情報が欲しいと言うことなのでしょう。

実はここまでであればそれほど遅くはありません。試しにまだmagitが読み込まれていない状態で M-: (progn (require 'with-editor) (with-editor "GIT_EDITOR" (start-process "git-proc-name" "git-output-buffer" "git" "commit"))) などと実行すると割とすぐ(1秒くらい?)にCOMMIT_EDITMSGファイルが開きます。問題はどうもその後にあるようです。

magitが読み込まれていると、サーバがCOMMIT_EDITMSGを開く段階で次の関数(主にgit-commit.el内)が実行されます。

git-commit-setup (global-git-commit-modeによってfind-file-hookにadd-hookされる関数)
git-commit-setup-font-lock (git-commit.elロード時にafter-change-major-mode-hookにadd-hookされる関数)
magit-auto-revert-mode-enable-in-buffers (magit-auto-revert-modeによってafter-change-major-mode-hookにadd-hookされる関数)

どれもファイルを開いた事によるフックによって自動的に呼び出されます。

なのでこれらの関数をフックから外してしまえばその処理は行われません。

(with-eval-after-load "git-commit"
  (global-git-commit-mode -1)
  (remove-hook 'after-change-major-mode-hook #'git-commit-setup-font-lock-in-buffer))
(with-eval-after-load "magit"
  (magit-auto-revert-mode -1))

結果、c cでコミットメッセージを書くバッファが開くまでの時間が大幅に短縮されました。めでたしめでたし。

と終わっても良いのですが、これだと色々な機能が利用できなくなってしまいます。

これらの関数が中で何をするのかもう少し調べてみます。

コミット時の流れを計測

トレースと計測のためにmy-profiler.elを作りました。

まずは全体的な流れを把握。

;; 調査用コード
(require 'my-profiler)
(my-profiler-instrument-all
 '((magit-commit-create . start) ;;ここで計測開始
   (server-execute . stop) ;;ここで計測終了
   magit-commit-diff
   git-commit-setup
   (git-commit-setup-font-lock-in-buffer . short)
   (magit-auto-revert-mode-enable-in-buffers . short)
   normal-mode))
(progn
  (switch-to-buffer "magit: my-test-git-repository") ;;既に開いてstageしてあるMagitのバッファを表に出す。
  (magit-commit-create)) ;;そのバッファ上でmagit-commit-createを実行する。

TM startからの経過時間 前計測点からの経過時間 関数内の滞在時間
TM	     0.014	+     0.014	          	Enter #<subr magit-commit-create>
TM	   806.706	+   806.692	   806.641	Leave #<subr magit-commit-create>
TM	   988.713	+   182.007	          	Enter #<subr server-execute>
TM	   996.355	+     7.642	          	Enter  #<subr normal-mode>
TM	  1209.287	+   212.932	   212.859	Eval    #<subr git-commit-setup-font-lock-in-buffer>
TM	  1675.698	+   466.411	   466.354	Eval    #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  1896.232	+   220.534	   217.599	Eval    #<subr git-commit-setup-font-lock-in-buffer>
TM	  2364.570	+   468.338	   468.274	Eval    #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  2365.017	+     0.447	  1368.649	Leave  #<subr normal-mode>
TM	  2365.066	+     0.049	          	Enter  #<subr git-commit-setup>
TM	  2365.100	+     0.034	          	Enter   #<subr normal-mode>
TM	  2587.760	+   222.660	   222.564	Eval     #<subr git-commit-setup-font-lock-in-buffer>
TM	  3060.027	+   472.267	   472.190	Eval     #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  3325.810	+   265.783	   262.448	Eval     #<subr git-commit-setup-font-lock-in-buffer>
TM	  3782.673	+   456.863	   456.770	Eval     #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  3783.060	+     0.387	  1417.947	Leave   #<subr normal-mode>
TM	  4899.085	+  1116.025	  2533.975	Leave  #<subr git-commit-setup>
TM	  4899.128	+     0.043	     0.001	Eval   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  5122.180	+   223.052	          	Enter  #<subr magit-commit-diff>
TM	  7588.585	+  2466.405	     0.001	Eval    #<subr git-commit-setup-font-lock-in-buffer>
TM	  7588.614	+     0.029	     0.003	Eval    #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  7821.368	+   232.754	  2699.136	Leave  #<subr magit-commit-diff>
TM	  7822.309	+     0.941	  6833.551	Leave #<subr server-execute>

まずmagit-commit-createが終わるまでに800msかかります。
serverがemacsclientからの要求を受けてserver-executeを実行するのが約1s経過時点。以下server-executeの中で6.8sかかります。
ファイルを開いてメジャーモードが切り替わるので、normal-mode関数によってafter-change-major-mode-hookが実行されます。フックに設定されているgit-commit-setup-font-lock-in-bufferとmagit-auto-revert-mode-enable-in-buffersが呼ばれます。一回のnormal-modeで二回も。
git-commit-setupに入る時点で既に2.3s経過。
git-commit-major-modeの設定に従ってメジャーモードを変更するのでまたafter-change-major-mode-hookが実行されます。
そしてgit-commit-diffでdiffを出力し、終わるのが開始から7.8s後。

どの関数でも数百msもの時間がかかっています。

また、計上されていない時間もあり状況がよく分かりません。なのでそれらの関数の中身を読んで詳しく調べました。

すると多数のgitコマンドの実行が見つかりました。例えばgit-commit-setup-font-lock関数内には次のようなコードがあります。

    (setq-local comment-start
                (or (with-temp-buffer
                      (and (zerop
                            (call-process
                             (git-commit-executable) nil (list t nil) nil
                             "config" "core.commentchar")) ;;←ここ★
                           (not (bobp))
                           (progn
                             (goto-char (point-min))
                             (buffer-substring (point) (line-end-position)))))
                    "#"))

このコードは git config core.commentchar を実行してコメントに使う文字をgitから取得しています。

また、git-commit-setup関数内には次のようなコードがあります。

  (let ((default-directory
         (or (and (not (file-exists-p ".dir-locals.el"))
                  ;; When $GIT_DIR/.dir-locals.el doesn't exist,
                  ;; fallback to $GIT_WORK_TREE/.dir-locals.el,
                  ;; because the maintainer can use the latter
                  ;; to enforce conventions, while s/he has no
                  ;; control over the former.
                  (fboundp 'magit-toplevel)  ; silence byte-compiler
                  (magit-toplevel)) ;;←ここ★
             default-directory)))

ここでは(magit-toplevel)という関数が使われています。この関数はリポジトリの最上位のディレクトリを返しますが、内部で git rev-parse --show-toplevel というコマンドを実行しています。

このようにあちこちから気軽にgitコマンドが実行されているので全てを把握するのが困難です。

そこで次のような計測を行ってcall-processの呼び出し状況を調べてみました。

;; 調査用コード
(require 'my-profiler)
(my-profiler-instrument-all
 '((magit-commit-create . start)
   (server-execute . stop)
   magit-commit-diff
   git-commit-setup
   git-commit-setup-font-lock-in-buffer
   magit-auto-revert-mode-enable-in-buffers
   normal-mode
   (call-process . short))) ;;←これを追加
(progn
  (switch-to-buffer "magit: my-test-git-repository") ;;既に開いてstageしてあるMagitのバッファを表に出す。
  (magit-commit-create)) ;;そのバッファ上でmagit-commit-createを実行する。

TM	     0.067	+     0.067	          	Enter magit-commit-create
TM	   165.595	+   165.528	   128.970	Eval   call-process
TM	   276.355	+   110.760	   110.152	Eval   call-process
TM	   383.838	+   107.483	   106.953	Eval   call-process
TM	   492.492	+   108.654	   108.011	Eval   call-process
TM	   597.941	+   105.449	   103.835	Eval   call-process
TM	   702.018	+   104.077	   103.379	Eval   call-process
TM	   806.025	+   104.007	   103.550	Eval   call-process
TM	   818.413	+    12.388	   818.277	Leave magit-commit-create
TM	   998.803	+   180.390	          	Enter server-execute
TM	  1006.222	+     7.419	          	Enter  normal-mode
TM	  1006.265	+     0.043	          	Enter   git-commit-setup-font-lock-in-buffer
TM	  1116.712	+   110.447	   110.347	Eval     call-process
TM	  1225.767	+   109.055	   108.696	Eval     call-process
TM	  1226.047	+     0.280	   219.770	Leave   git-commit-setup-font-lock-in-buffer
TM	  1226.065	+     0.018	          	Enter   magit-auto-revert-mode-enable-in-buffers
TM	  1350.425	+   124.360	   114.586	Eval     call-process
TM	  1457.264	+   106.839	   106.571	Eval     call-process
TM	  1569.336	+   112.072	   111.709	Eval     call-process
TM	  1683.220	+   113.884	   113.402	Eval     call-process
TM	  1683.250	+     0.030	   457.178	Leave   magit-auto-revert-mode-enable-in-buffers
TM	  1686.554	+     3.304	          	Enter   git-commit-setup-font-lock-in-buffer
TM	  1794.665	+   108.111	   107.975	Eval     call-process
TM	  1910.274	+   115.609	   115.262	Eval     call-process
TM	  1910.601	+     0.327	   224.034	Leave   git-commit-setup-font-lock-in-buffer
TM	  1910.632	+     0.031	          	Enter   magit-auto-revert-mode-enable-in-buffers
TM	  2039.771	+   129.139	   119.084	Eval     call-process
TM	  2154.799	+   115.028	   114.813	Eval     call-process
TM	  2263.058	+   108.259	   107.883	Eval     call-process
TM	  2374.596	+   111.538	   111.138	Eval     call-process
TM	  2374.652	+     0.056	   464.004	Leave   magit-auto-revert-mode-enable-in-buffers
TM	  2375.022	+     0.370	  1368.786	Leave  normal-mode
TM	  2375.053	+     0.031	          	Enter  git-commit-setup
TM	  2375.080	+     0.027	          	Enter   normal-mode
TM	  2375.131	+     0.051	          	Enter    git-commit-setup-font-lock-in-buffer
TM	  2481.555	+   106.424	   106.317	Eval      call-process
TM	  2590.186	+   108.631	   108.101	Eval      call-process
TM	  2590.481	+     0.295	   215.338	Leave    git-commit-setup-font-lock-in-buffer
TM	  2590.498	+     0.017	          	Enter    magit-auto-revert-mode-enable-in-buffers
TM	  2714.161	+   123.663	   113.784	Eval      call-process
TM	  2825.484	+   111.323	   111.140	Eval      call-process
TM	  2931.823	+   106.339	   105.959	Eval      call-process
TM	  3046.016	+   114.193	   113.908	Eval      call-process
TM	  3046.080	+     0.064	   455.567	Leave    magit-auto-revert-mode-enable-in-buffers
TM	  3048.839	+     2.759	          	Enter    git-commit-setup-font-lock-in-buffer
TM	  3159.395	+   110.556	   110.437	Eval      call-process
TM	  3269.152	+   109.757	   109.407	Eval      call-process
TM	  3269.528	+     0.376	   220.675	Leave    git-commit-setup-font-lock-in-buffer
TM	  3269.548	+     0.020	          	Enter    magit-auto-revert-mode-enable-in-buffers
TM	  3398.770	+   129.222	   119.693	Eval      call-process
TM	  3504.807	+   106.037	   105.769	Eval      call-process
TM	  3615.480	+   110.673	   110.212	Eval      call-process
TM	  3727.668	+   112.188	   111.808	Eval      call-process
TM	  3727.712	+     0.044	   458.142	Leave    magit-auto-revert-mode-enable-in-buffers
TM	  3728.222	+     0.510	  1353.118	Leave   normal-mode
TM	  3843.396	+   115.174	   114.663	Eval    call-process
TM	  3954.347	+   110.951	   110.736	Eval    call-process
TM	  4063.458	+   109.111	   108.434	Eval    call-process
TM	  4173.732	+   110.274	   109.117	Eval    call-process
TM	  4277.008	+   103.276	   101.671	Eval    call-process
TM	  4386.951	+   109.943	   109.613	Eval    call-process
TM	  4496.227	+   109.276	   102.939	Eval    call-process
TM	  4607.267	+   111.040	   110.903	Eval    call-process
TM	  4735.445	+   128.178	   123.408	Eval    call-process
TM	  4846.907	+   111.462	   110.492	Eval    call-process
TM	  4847.823	+     0.916	  2472.720	Leave  git-commit-setup
TM	  4847.862	+     0.039	          	Enter  magit-auto-revert-mode-enable-in-buffers
TM	  4847.882	+     0.020	     0.012	Leave  magit-auto-revert-mode-enable-in-buffers
TM	  4957.249	+   109.367	   105.964	Eval   call-process
TM	  5071.761	+   114.512	   114.348	Eval   call-process
TM	  5075.277	+     3.516	          	Enter  magit-commit-diff
TM	  5190.165	+   114.888	   114.456	Eval    call-process
TM	  5299.389	+   109.224	   108.968	Eval    call-process
TM	  5406.564	+   107.175	   106.868	Eval    call-process
TM	  5523.598	+   117.034	   116.481	Eval    call-process
TM	  5628.045	+   104.447	   104.183	Eval    call-process
TM	  5733.773	+   105.728	   105.326	Eval    call-process
TM	  5854.707	+   120.934	   118.859	Eval    call-process
TM	  5961.210	+   106.503	   106.278	Eval    call-process
TM	  6074.760	+   113.550	   112.966	Eval    call-process
TM	  6204.416	+   129.656	   129.186	Eval    call-process
TM	  6320.894	+   116.478	   116.091	Eval    call-process
TM	  6426.537	+   105.643	   105.306	Eval    call-process
TM	  6531.705	+   105.168	   104.829	Eval    call-process
TM	  6653.648	+   121.943	   121.594	Eval    call-process
TM	  6766.164	+   112.516	   112.064	Eval    call-process
TM	  6883.633	+   117.469	   116.855	Eval    call-process
TM	  6996.202	+   112.569	   112.346	Eval    call-process
TM	  7105.460	+   109.258	   108.693	Eval    call-process
TM	  7223.988	+   118.528	   117.887	Eval    call-process
TM	  7330.973	+   106.985	   106.761	Eval    call-process
TM	  7475.212	+   144.239	   143.927	Eval    call-process
TM	  7595.205	+   119.993	   118.270	Eval    call-process
TM	  7595.306	+     0.101	          	Enter   git-commit-setup-font-lock-in-buffer
TM	  7595.332	+     0.026	     0.019	Leave   git-commit-setup-font-lock-in-buffer
TM	  7595.346	+     0.014	          	Enter   magit-auto-revert-mode-enable-in-buffers
TM	  7595.362	+     0.016	     0.010	Leave   magit-auto-revert-mode-enable-in-buffers
TM	  7701.903	+   106.541	   106.110	Eval    call-process
TM	  7825.783	+   123.880	   123.021	Eval    call-process
TM	  7827.148	+     1.365	  2751.850	Leave  magit-commit-diff
TM	  7828.413	+     1.265	  6829.588	Leave server-execute

非常に多くのcall-processが呼ばれていることが分かります。その数なんと67回(この数は現在開いているファイルなどEmacs全体の状態によって多少変わります)。

1回につきだいたい100msは持って行かれています。それが67回ですから、そりゃ遅いわけです。

call-processを全てチェックする

どのような引数でcall-processが呼ばれているのかを詳しく調査してみます。

call-processに細工をして、渡された引数と処理時間を出力できるようにしました。

;; 調査用コード
(defun my-watch-call-process (orig-func program infile destination display &rest args)
  (let* ((start-time (current-time))
         (result (apply orig-func program infile destination display args))
         (end-time (current-time))
         (str (format "%10.3f\tcall %s dir=%s args:%s infile=%s dest=%s display=%s"
                      (* 1000.0 (float-time (time-subtract end-time start-time)))
                      program
                      (expand-file-name default-directory)
                      args
                      infile
                      destination
                      display)))
    ;;(message "%s" str)
    (with-current-buffer (get-buffer-create "*Watch Call Process*")
      (insert str "\n"))
    result))
(advice-add #'call-process :around #'my-watch-call-process)
(progn
  (switch-to-buffer "magit: my-test-git-repository") ;;既に開いてstageしてあるMagitのバッファを表に出す。
  (magit-commit-create)) ;;そのバッファ上でmagit-commit-createを実行する。
;; (advice-remove #'call-process #'my-watch-call-process)

実行結果:

  127.805	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil
  107.044	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  107.562	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  112.606	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  110.020	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  109.413	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  107.641	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  104.655	call git-encwrapper dir=c:/my-test-git-repository/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
  108.715	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
  115.636	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  109.609	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  111.605	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  112.741	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
  111.269	call git-encwrapper dir=c:/my-test-git-repository/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
  114.393	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
  116.784	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  106.856	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  111.306	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  113.603	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
  110.811	call git-encwrapper dir=c:/my-test-git-repository/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
  108.250	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
  123.924	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  111.405	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  114.570	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  113.685	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
  103.513	call git-encwrapper dir=c:/my-test-git-repository/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
  109.157	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
  112.987	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  106.662	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  104.755	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  117.193	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
  119.297	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  107.351	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  108.289	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  114.332	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse HEAD) infile=nil dest=(t nil) display=nil
  103.471	call git-encwrapper dir=c:/my-test-git-repository/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
  111.284	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
  108.283	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-files -c -z -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
  109.082	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-tree --name-only -z HEAD -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
  113.619	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url upstream) infile=nil dest=t display=nil
  107.181	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url origin) infile=nil dest=t display=nil
  114.011	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-files -c -z -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
  108.958	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-tree --name-only -z HEAD -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
  118.451	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  112.981	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  105.087	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  121.276	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  104.412	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  109.560	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  116.268	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  111.705	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  106.008	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  122.337	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil
  118.292	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  117.703	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  107.558	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  122.989	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --) infile=nil dest=nil display=nil
  114.488	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  110.997	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  113.395	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  107.008	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  115.545	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  124.748	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
  113.055	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
  116.179	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 config -z --get-all magit.extension) infile=nil dest=(t nil) display=nil
  117.604	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
  126.063	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --ita-visible-in-index -p --no-prefix --numstat --cached --stat --no-ext-diff --) infile=nil dest=(t nil) display=nil

同じ引数のものをまとめてみます。

回数	平均時間	引数
1	 126.063	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --ita-visible-in-index -p --no-prefix --numstat --cached --stat --no-ext-diff --) infile=nil dest=(t nil) display=nil
1	 116.179	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 config -z --get-all magit.extension) infile=nil dest=(t nil) display=nil
1	 122.989	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --) infile=nil dest=nil display=nil
1	 107.181	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url origin) infile=nil dest=t display=nil
1	 113.619	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url upstream) infile=nil dest=t display=nil
2	 109.020	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-tree --name-only -z HEAD -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
2	 111.147	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-files -c -z -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
1	 114.332	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse HEAD) infile=nil dest=(t nil) display=nil
4	 114.305	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
11	 108.982	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
5	 110.360	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
5	 106.744	call git-encwrapper dir=c:/my-test-git-repository/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
13	 111.840	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
17	 114.632	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
2	 125.071	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil

合計で7535.042ms(call-processの中だけで)
呼び出し回数は67回
平均で一回あたり112.463ms
パターンは15種類
実行時間はどれも大差なし
infileは全てnil(入力無し)
destinationはnil, t, (t nil)のいずれか(破棄、標準出力とエラー出力をミックス、エラーだけ破棄のいずれか)
displayは全てnil

とにかくプロセスの起動が多すぎます。それも同じ情報を10回以上問い合わせている箇所が3件もあります。

プロセスの起動速度

それにしてもプロセスの起動に100msというのはかなり遅いです。いったいどうなっているのでしょうか。

様々な方法でプロセスを起動してみてその実行時間を計測してみました。計測は次のコードで行い、100回繰り返したときの平均時間を求めました。

(benchmark-run 100 (call-process "git-encwrapper" nil (list t nil) nil "config" "core.commentchar"))

結果は平均106.37ms。私のEmacsはプロセスの起動まわりに色々細工をしてあるのでemacs -Qで起動したものでも試してみたところ平均104.78msでした。

git-encwrapperでは無く素のgitで試してみたところ、平均76.60ms(emacs -Qで76.22ms)。

私が使っているGitはGit for Windowsですが、Git/cmd(またはGit/bin)にあるgit.exeとGit/mingw64/binにあるgit.exeが別物です。前者は後者を呼び出すラッパーとなっています。通常PATHが通っているのは前者なので、後者を直接起動してみたところ、平均56.76msまで縮まりました(emacs -Qで55.19ms)。このラッパーには色々な役割があって、環境変数の調整なども行っているようなので直接呼び出して大丈夫なのかは分かりません。

	常用環境	emacs -Q環境
git-encwrapper.exe	106.37	104.78
Git/cmd/git.exe	76.60	76.22
Git/mingw64/bin/git.exe	56.76	55.19

以上はEmacsを経由して起動した場合の時間です。

Windowsはプロセスの起動が遅いとはよく言われていることです。しかし本当にWindowsだけの問題なのでしょうか。Emacs側には問題は無いのでしょうか。試しに次のようなバッチファイルを作成してcmd.exeから起動してみました。

echo %TIME%
>"test.log" (for /L %%a in (1,1,100) do "git.exe" config core.commentchar)
echo %TIME%

結果:

git-encwrapper 67.1ms
git.exe 31.4ms
mingw64/bin/git.exe 17.1ms

	常用環境	emacs -Q環境	cmd.exe
git-encwrapper.exe	106.37	104.78	67.1
Git/bin/git.exe	76.60	76.22	31.4
Git/mingw64/bin/git.exe	56.76	55.19	17.1

こうしてみるとプロセス起動が遅い原因を全てWindowsのせいにして良いのか疑問が湧いてきます。git-encwrapperが遅いのは、まぁ、私のせいです(笑)。とはいっても文字エンコーディングが複数混在しているプロジェクトで素のGitやMagitが使いづらいのは私のせいではありません。Emacsとcmd.exeの差(約40ms)を見るに、Emacs自体にも何か遅くなる原因がありそうです。Git for windowsのラッパーは意外に大きな差を生んでいます(約20ms)。GitにせよEmacsにせよUNIX系のOSで使われている物を無理矢理Windows上に持ってきているので色々と調整のためのコードが挟まっているのかもしれません。

ちなみにVirtualBoxに入っていたUbuntu 21とEmacs27.1で試したところ、2.1msくらいでした。10倍くらいの差があります。実際の所Windowsのプロセス起動がLinuxと比べて遅いのは確かです。

私の所限定の話になりますが、diffとapplyのとき以外はgit-encwrapperは必要ないので直接gitを呼び出して構いません。概ね次のようなコードで切り替えられそうです。

(defun my-call-process-for-bypassing-git-encwrapper (original-call-process program infile destination display &rest args)
  (when (and (equal program "git-encwrapper")
             ;; ↓オプション内にdiffやapplyという文字列が含まれていると誤判定するが、遅くなるだけで実害は無い。
             (not (and (member "diff" args) destination)) ;;diffでも出力を捨てる場合は素のgitで良い
             (not (member "apply" args)))
    (setq program "git"))
  (apply original-call-process program infile destination display args))
(advice-add #'call-process :around #'my-call-process-for-bypassing-git-encwrapper)
;;(advice-remove #'call-process #'my-call-process-for-bypassing-git-encwrapper)

Git/mingw64/bin/git.exeを直接呼ぶかどうかはGit/cmd/git.exeが何をしているかをよく調査してから判断すべきでしょう。ソースは MINGW-packages/git-wrapper.c at main · git-for-windows/MINGW-packages にあるようです。環境変数を事前に調整してやれば直接呼べるかもしれません。

call-processの結果をキャッシュする

プロセスの起動が遅いというのはとりあえず受け入れるとして、それならどうすれば良いでしょうか。

もちろん起動する回数を減らすよりありません。幸い同じ情報を何度も問い合わせている箇所があり、それらをまとめれば大幅な時間短縮が望めそうです。

一番手っ取り早いのはcall-process自体にキャッシュ機能を付けてしまうことでしょう。call-processの書式は次の通りです(Synchronous Processes (GNU Emacs Lisp Reference Manual)より)。

(call-process program &optional infile destination display &rest args)

programがgit(またはmagit-git-executableの値)のときに、default-directory(カレントディレクトリ)とargs、destinationをキーにして、結果となる終了ステータスとバッファに出力された文字列をキャッシュします。

もちろん結果は常に一定とは限りません。何か変更操作をした後は結果が変化するでしょう。どのタイミングでキャッシュをフラッシュ(クリア)するかが悩み所です。

とはいえ、コミットメッセージを入力する部分だけに限定するのであれば、その間に変更操作は無いのでクリアせずにずっと保持してしまって大丈夫でしょう。

というわけで作ったのが次のEmacs Lispです。

my-magit-speedup-for-windows/my-magit-process-cache.el at main · misohena/my-magit-speedup-for-windows

基本的な使い方:

my-magit-process-cache-turn-on でキャッシュを有効化(+キャッシュをクリア)
my-magit-process-cache-turn-off でキャッシュを無効化(+キャッシュをクリア)
my-magit-process-cache-clear-cache-all でキャッシュをクリア

これだけだと使い物にならないのでグローバルモードにしてみました。

git-commit-createのときだけキャッシュするモード(my-magit-process-cache-commit-msg-mode)

my-magit-process-cache-commit-msg-mode は magit-commit-create の実行開始から編集バッファが出るところまでの間でGitの実行結果をキャッシュするモードです。リポジトリを変更しないことが分かっている期間なので安全にキャッシュできますが、それ以前(例えば直前のgit-refresh時)に取得した情報を再利用することはできません。

このモードを有効にした後にcall-processを記録した結果が次です。

   126.944	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil
   114.978	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
   108.789	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
   111.174	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
   110.404	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
   119.540	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
   107.830	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
   106.409	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
   110.727	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
   113.143	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse HEAD) infile=nil dest=(t nil) display=nil
   103.890	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-files -c -z -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
   108.034	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-tree --name-only -z HEAD -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
   114.293	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url upstream) infile=nil dest=t display=nil
   106.079	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url origin) infile=nil dest=t display=nil
   142.861	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil
   117.363	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --) infile=nil dest=nil display=nil
   111.601	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 config -z --get-all magit.extension) infile=nil dest=(t nil) display=nil
   122.322	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --ita-visible-in-index -p --no-prefix --numstat --cached --stat --no-ext-diff --) infile=nil dest=(t nil) display=nil

合計所要時間: 2056.381ms
平均所要時間: 114.243ms
呼び出し回数: 18回
パターン: 18種類

キャッシュされているので各パターン1回ずつの呼び出しになっています。

git-refreshでキャッシュをクリアするモード(my-magit-process-cache-clear-on-refresh-mode)

my-magit-process-cache-clear-on-refresh-mode は常にキャッシュを有効化し、git-refreshを実行するときにキャッシュをクリアするモードです。

次はこのモードを有効にして、git-refreshした直後にgit-commit-createを実行した結果です。

   127.341	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil
   107.335	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(config core.commentchar) infile=nil dest=(t nil) display=nil
   109.548	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 for-each-ref --format=%(refname:short) refs/heads) infile=nil dest=(t nil) display=nil
   113.989	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --show-toplevel) infile=nil dest=(t nil) display=nil
   108.152	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --git-dir) infile=nil dest=(t nil) display=nil
   104.489	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse --is-bare-repository) infile=nil dest=(t nil) display=nil
   109.008	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 ls-files --error-unmatch c:/my-test-git-repository/.git/COMMIT_EDITMSG) infile=nil dest=nil display=nil
   107.208	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 rev-parse HEAD) infile=nil dest=(t nil) display=nil
   109.791	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-files -c -z -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
   108.371	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager ls-tree --name-only -z HEAD -- .git/COMMIT_EDITMSG) infile=nil dest=(t nil) display=nil
   119.849	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url upstream) infile=nil dest=t display=nil
   151.523	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager remote get-url origin) infile=nil dest=t display=nil
   124.484	call git-encwrapper dir=c:/my-test-git-repository/.git/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --cached --) infile=nil dest=nil display=nil
   117.872	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --quiet --) infile=nil dest=nil display=nil
   110.447	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager --literal-pathspecs -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 config -z --get-all magit.extension) infile=nil dest=(t nil) display=nil
   122.532	call git-encwrapper dir=c:/my-test-git-repository/ args:(--no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 --no-pager -c core.preloadindex=true -c log.showSignature=false -c color.ui=false -c color.diff=false -c i18n.logOutputEncoding=UTF-8 diff --ita-visible-in-index -p --no-prefix --numstat --cached --stat --no-ext-diff --) infile=nil dest=(t nil) display=nil

合計所要時間: 1851.939ms
平均所要時間: 115.746ms
呼び出し回数: 16回
パターン: 16種類

思ったよりも減りませんでした。magit-refreshで取得する情報とそれほど重複がないのでしょう。

このモードはgit-refresh時にしかキャッシュをクリアしないので動作の正しさが保証できません。Magitが何かの変更操作をした後、かつ、git-refreshでキャッシュをクリアする前にその変更に関連する状態を取得しようとしていると、変更前の状態を取得してしまう可能性があります。

全てのコマンドや使い方を確認していないので、そのような問題を引き起こす箇所があるかどうかは分かりません。また、Magitの外で何か変更を加えたときにも問題が生じます。

手動でキャッシュをクリアするモード(my-magit-process-cache-mode)

my-magit-process-cache-mode は、常にキャッシュを有効にし一切クリアしないモードです。

全てがキャッシュに乗りさえすれば笑ってしまうくらい速いです。Linuxでの体感速度に近いですね。

もちろんコミットなど変更操作をした後は手動で更新しないと正しい情報が表示されません。閲覧だけなら問題なし？

いつキャッシュをクリアするか

結局キモはキャッシュした情報が無効になるタイミングを正確に把握できるかどうかです。それが出来れば最高のパフォーマンスが得られるでしょう。Magit外での操作まで考慮すると難しいでしょうが、Magit内だけであれば不可能ではないかもしれません。

Magitのキャッシュ機能

ちなみに、Magitにはプロセスの結果を一時的にキャッシュする仕組みが既にあります。magit-git.elに (magit--with-refresh-cache key &rest body) というマクロがあります。このマクロはbodyを評価した結果を変数 magit--refresh-cache にキャッシュするというものです。すでにキャッシュされている結果を持っている場合は単にそれを返します。keyは主にdefault-directoryやargsを含むリストです。このマクロを使ってキャッシュに値を格納する関数は主にGitを呼び出して文字列を返す関数群のようです。 magit--refresh-cache がnilのときは何もしないので、キャッシュするにはあらかじめletで適当なリストを割り当てておく必要があるようです。例えばmagit-statusの先頭に (let ((magit--refresh-cache (list (cons 0 0)))) のようなコードがあります。つまり、特定の範囲だけ今回と同じようなキャッシュをする仕組みです。

残念ながらこの仕組みは非同期の処理の全体には適用出来ません。また、フックの中からGitを呼び出すような状況でも活用(他の部分とのキャッシュの共有)が難しいでしょう。

今回の場合時間がかかっている部分はserver-executeから呼ばれる関数に集中しているので、server-executeを (let ((magit--refresh-cache (list (cons 0 0)))) (apply original-fun args) ) と:around adviceで無理矢理囲むという手もあるかもしれません。

キャッシュ以外の可能性

もし一回のプロセス起動で複数の情報を取得出来たらかなりの高速化が望めそうです。Gitにそのような機能はあるのでしょうか。またはlibgitを使えばそのようなプログラムを作成できるでしょうか。全ての操作をスクリプト化して一回の呼び出しで実行できればかなり速くなるでしょう。

また、libgitをdynamic module化してEmacsに組み込んでしまう試みが存在するようです。これならそもそもプロセスの呼び出し自体が必要ありません。

magit/libegit2: Emacs bindings for libgit2

ただし問題も多く優先順位も低いためあまり進んでいないようです。

Implement an Elisp binding for libgit2 · Issue #2959 · magit/magit

試してみようと思ったのですが、Emacs Lispからの呼び出し部分が出来ていないように見えます。

個別の改善

ここまででかなりの数のプロセス起動を削減できましたが、まだ1回のコミットメッセージを書くまでに16回のプロセス起動が残っています。

実行されたgitコマンドだけ見てもそれが何のための物なのか分からないので、呼び出し元をbacktraceで表示させてみました。

;; 調査用コード
(require 'backtrace)
(defun my-watch-call-process-with-backtrace (orig-func program infile destination display &rest args)
  (let* ((trace (let ((after-change-major-mode-hook nil))
                  (backtrace-to-string)))
         (str (format "call dir=%s from=\n%s"
                      (expand-file-name default-directory)
                      (replace-regexp-in-string
                       "\\`\\(.\\|\n\\)*?\n\\(  call-process\\)" "\\2"
                       trace))))
    ;;(message "%s" str)
    (with-current-buffer (get-buffer-create "*Watch call-process with backtrace*")
      (insert str "\n"))
    )
  (apply orig-func program infile destination display args))
(advice-add #'call-process :around #'my-watch-call-process-with-backtrace)
(progn
  (switch-to-buffer "magit: my-test-git-repository") ;;既に開いてstageしてあるMagitのバッファを表に出す。
  (magit-commit-create) ;;そのバッファ上でmagit-commit-createを実行する。
  )
;;(advice-remove #'call-process #'my-watch-call-process-with-backtrace)

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--cached" "--")
  process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--cached" "--")
  magit-process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--cached" "--")
  magit-process-git(nil (("diff" "--quiet" "--cached" nil "--" nil)))
  magit-git-exit-code(("diff" "--quiet" "--cached" nil "--" nil))
  magit-git-failure("diff" "--quiet" "--cached" nil "--" nil)
  magit-anything-staged-p()
  magit-commit-assert(nil)
  #<subr magit-commit-create>()
  apply(#<subr magit-commit-create> nil)
  (let ((result (apply original-fun args))) (if result nil (my-magit-process-cache--commit-create-end)) result)
  my-magit-process-cache--commit-create(#<subr magit-commit-create>)
  apply(my-magit-process-cache--commit-create #<subr magit-commit-create> nil)
  magit-commit-create()
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  magit-process-git((t nil) ("rev-parse" "--show-toplevel"))
  magit-git-str("rev-parse" "--show-toplevel")
  magit-rev-parse-safe("--show-toplevel")
  magit-toplevel()
  #<subr magit-commit-create>()
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  magit-process-git((t nil) ("rev-parse" "--git-dir"))
  magit-git-str("rev-parse" "--git-dir")
  magit-rev-parse-safe("--git-dir")
  magit-git-dir()
  magit--record-separated-gitdir()
  magit-run-git-with-editor("commit" ("--"))
  #<subr magit-commit-create>()
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil (t nil) nil "config" "core.commentchar")
  git-commit-setup-font-lock()
  git-commit-setup-font-lock-in-buffer()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  find-file-noselect-1(#<buffer COMMIT_EDITMSG> "c:/my-test-git-repository/.git/COMMIT_EDITMSG" nil nil "c:/my-test-git-repository/.git/COMMIT_EDITMSG" (341992096703475215 1121764838))
  find-file-noselect("C:/my-test-git-repository/.git/COMMIT_EDITMSG")
  #<subr server-visit-files>((("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) #<process server23432 <127.0.0.1:64200>> nil)
  apply(#<subr server-visit-files> ((("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) #<process server23432 <127.0.0.1:64200>> nil))
  server-visit-files((("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) #<process server23432 <127.0.0.1:64200>> nil)
  server-execute(#<process server23432 <127.0.0.1:64200>> (("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) nil nil t nil nil)
  #f(compiled-function () #<bytecode -0x1bd4f2f840dbc4c>)()
  server-execute-continuation(#<process server23432 <127.0.0.1:64200>>)
  server-process-filter(#<process server23432 <127.0.0.1:64200>> "-auth [m:TL:<;51aiw67(FyI/O,\\{$|yUxQ0>:kv|IC?b~Kg&...")

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "for-each-ref" "--format=%(refname:short)" "refs/heads")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "for-each-ref" "--format=%(refname:short)" "refs/heads")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "for-each-ref" "--format=%(refname:short)" "refs/heads")
  magit-process-git((t nil) ("--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "for-each-ref" "--format=%(refname:short)" "refs/heads"))
  magit-git-insert("for-each-ref" "--format=%(refname:short)" nil "refs/heads")
  magit-git-lines("for-each-ref" "--format=%(refname:short)" nil "refs/heads")
  magit-list-refs("refs/heads" "%(refname:short)")
  magit-list-refnames("refs/heads")
  magit-list-local-branch-names()
  git-commit-setup-font-lock()
  git-commit-setup-font-lock-in-buffer()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  magit-process-git((t nil) ("rev-parse" "--show-toplevel"))
  magit-git-str("rev-parse" "--show-toplevel")
  magit-rev-parse-safe("--show-toplevel")
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  magit-process-git((t nil) ("rev-parse" "--git-dir"))
  magit-git-str("rev-parse" "--git-dir")
  magit-rev-parse-safe("--git-dir")
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--is-bare-repository")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--is-bare-repository")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--is-bare-repository")
  magit-process-git((t nil) ("rev-parse" "--is-bare-repository"))
  magit-git-output(("rev-parse" ("--is-bare-repository")))
  magit-git-true("rev-parse" ("--is-bare-repository"))
  magit-rev-parse-true("--is-bare-repository")
  magit-bare-repo-p()
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "ls-files" "--error-unmatch" "c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "ls-files" "--error-unmatch" "c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  magit-process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "ls-files" "--error-unmatch" "c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  magit-process-git(nil (("ls-files" "--error-unmatch" "c:/my-test-git-repository/.git/COMMIT_EDITMSG")))
  magit-git-exit-code(("ls-files" "--error-unmatch" "c:/my-test-git-repository/.git/COMMIT_EDITMSG"))
  magit-git-success("ls-files" "--error-unmatch" "c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  magit-file-tracked-p("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "HEAD")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "HEAD")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "HEAD")
  magit-process-git((t nil) ("--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "HEAD"))
  magit-git-insert("rev-parse" "HEAD")
  magit-git-string("rev-parse" "HEAD")
  magit-rev-parse("HEAD")
  git-commit-setup()
  git-commit-setup-check-buffer()
  run-hooks(find-file-hook)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "ls-files" "-c" "-z" "--" ".git/COMMIT_EDITMSG")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "ls-files" "-c" "-z" "--" ".git/COMMIT_EDITMSG")
  vc-git--call((t nil) "ls-files" "-c" "-z" "--" ".git/COMMIT_EDITMSG")
  vc-git--out-ok("ls-files" "-c" "-z" "--" ".git/COMMIT_EDITMSG")
  vc-git-registered("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  vc-call-backend(Git registered "c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  #f(compiled-function (b) #<bytecode 0x14704c4aaf6471f6>)(Git)
  mapc(#f(compiled-function (b) #<bytecode 0x14704c4aaf6471f6>) (RCS CVS SVN SCCS SRC Bzr Git Hg))
  vc-registered("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  vc-backend("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  vc-responsible-backend("c:/my-test-git-repository/.git/COMMIT_EDITMSG" t)
  bug-reference-try-setup-from-vc()
  run-hook-with-args-until-success(bug-reference-try-setup-from-vc)
  bug-reference--run-auto-setup()
  bug-reference-mode()
  run-hooks(git-commit-setup-hook)
  git-commit-setup()
  git-commit-setup-check-buffer()
  run-hooks(find-file-hook)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "ls-tree" "--name-only" "-z" "HEAD" "--" ".git/COMMIT_EDITMSG")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "ls-tree" "--name-only" "-z" "HEAD" "--" ".git/COMMIT_EDITMSG")
  vc-git--call((t nil) "ls-tree" "--name-only" "-z" "HEAD" "--" ".git/COMMIT_EDITMSG")
  vc-git--out-ok("ls-tree" "--name-only" "-z" "HEAD" "--" ".git/COMMIT_EDITMSG")
  vc-git-registered("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  vc-call-backend(Git registered "c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  #f(compiled-function (b) #<bytecode 0x14704c4aaf6471f6>)(Git)
  mapc(#f(compiled-function (b) #<bytecode 0x14704c4aaf6471f6>) (RCS CVS SVN SCCS SRC Bzr Git Hg))
  vc-registered("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  vc-backend("c:/my-test-git-repository/.git/COMMIT_EDITMSG")
  vc-responsible-backend("c:/my-test-git-repository/.git/COMMIT_EDITMSG" t)
  bug-reference-try-setup-from-vc()
  run-hook-with-args-until-success(bug-reference-try-setup-from-vc)
  bug-reference--run-auto-setup()
  bug-reference-mode()
  run-hooks(git-commit-setup-hook)
  git-commit-setup()
  git-commit-setup-check-buffer()
  run-hooks(find-file-hook)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil t nil "--no-pager" "remote" "get-url" "upstream")
  process-file("git-encwrapper" nil t nil "--no-pager" "remote" "get-url" "upstream")
  vc-do-command(#<buffer  *temp*-514073> 0 "git-encwrapper" nil "--no-pager" "remote" "get-url" "upstream")
  vc-git-command(#<buffer  *temp*-514073> 0 nil "remote" "get-url" "upstream")
  vc-git-repository-url("c:/my-test-git-repository/.git/COMMIT_EDITMSG" "upstream")
  vc-call-backend(Git repository-url "c:/my-test-git-repository/.git/COMMIT_EDITMSG" "upstream")
  #f(compiled-function (remote) #<bytecode 0xc87372323b60bec>)("upstream")
  #f(compiled-function (elt) #<bytecode 0xd0e31d85bc76844>)("upstream")
  mapc(#f(compiled-function (elt) #<bytecode 0xd0e31d85bc76844>) ("upstream" nil))
  seq-do(#f(compiled-function (elt) #<bytecode 0xd0e31d85bc76844>) ("upstream" nil))
  seq-some(#f(compiled-function (remote) #<bytecode 0xc87372323b60bec>) ("upstream" nil))
  bug-reference-try-setup-from-vc()
  run-hook-with-args-until-success(bug-reference-try-setup-from-vc)
  bug-reference--run-auto-setup()
  bug-reference-mode()
  run-hooks(git-commit-setup-hook)
  git-commit-setup()
  git-commit-setup-check-buffer()
  run-hooks(find-file-hook)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil t nil "--no-pager" "remote" "get-url" "origin")
  process-file("git-encwrapper" nil t nil "--no-pager" "remote" "get-url" "origin")
  vc-do-command(#<buffer  *temp*-332582> 0 "git-encwrapper" nil "--no-pager" "remote" "get-url" "origin")
  vc-git-command(#<buffer  *temp*-332582> 0 nil "remote" "get-url" "origin")
  vc-git-repository-url("c:/my-test-git-repository/.git/COMMIT_EDITMSG" nil)
  vc-call-backend(Git repository-url "c:/my-test-git-repository/.git/COMMIT_EDITMSG" nil)
  #f(compiled-function (remote) #<bytecode 0xc87372323b60bec>)(nil)
  #f(compiled-function (elt) #<bytecode 0xd0e31d85bc76844>)(nil)
  mapc(#f(compiled-function (elt) #<bytecode 0xd0e31d85bc76844>) ("upstream" nil))
  seq-do(#f(compiled-function (elt) #<bytecode 0xd0e31d85bc76844>) ("upstream" nil))
  seq-some(#f(compiled-function (remote) #<bytecode 0xc87372323b60bec>) ("upstream" nil))
  bug-reference-try-setup-from-vc()
  run-hook-with-args-until-success(bug-reference-try-setup-from-vc)
  bug-reference--run-auto-setup()
  bug-reference-mode()
  run-hooks(git-commit-setup-hook)
  git-commit-setup()
  git-commit-setup-check-buffer()
  run-hooks(find-file-hook)
  after-find-file(nil t)
  ...略

call dir=c:/my-test-git-repository/.git/ from=
  call-process("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--cached" "--")
  process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--cached" "--")
  magit-process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--cached" "--")
  magit-process-git(nil (("diff" "--quiet" "--cached" nil "--" nil)))
  magit-git-exit-code(("diff" "--quiet" "--cached" nil "--" nil))
  magit-git-failure("diff" "--quiet" "--cached" nil "--" nil)
  magit-anything-staged-p()
  magit-commit-diff-1()
  #<subr magit-commit-diff>()
  apply(#<subr magit-commit-diff> nil)
  magit-commit-diff()
  run-hooks(server-switch-hook)
  server-execute(#<process server23432 <127.0.0.1:64200>> (("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) nil nil t nil nil)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--")
  process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--")
  magit-process-file("git-encwrapper" nil nil nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--quiet" "--")
  magit-process-git(nil (("diff" "--quiet" nil "--" nil)))
  magit-git-exit-code(("diff" "--quiet" nil "--" nil))
  magit-git-failure("diff" "--quiet" nil "--" nil)
  magit-anything-unstaged-p()
  magit-commit-diff-1()
  #<subr magit-commit-diff>()
  apply(#<subr magit-commit-diff> nil)
  magit-commit-diff()
  run-hooks(server-switch-hook)
  server-execute(#<process server23432 <127.0.0.1:64200>> (("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) nil nil t nil nil)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "config" "-z" "--get-all" "magit.extension")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "config" "-z" "--get-all" "magit.extension")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "config" "-z" "--get-all" "magit.extension")
  magit-process-git((t nil) ("--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "config" "-z" "--get-all" "magit.extension"))
  magit-git-insert("config" nil "-z" "--get-all" "magit.extension")
  magit-git-items("config" nil "-z" "--get-all" "magit.extension")
  magit-get-all("magit.extension")
  magit-load-config-extensions()
  run-hooks(change-major-mode-after-body-hook special-mode-hook magit-section-mode-hook magit-mode-hook magit-diff-mode-hook)
  apply(run-hooks (change-major-mode-after-body-hook special-mode-hook magit-section-mode-hook magit-mode-hook magit-diff-mode-hook))
  run-mode-hooks(magit-diff-mode-hook)
  magit-diff-mode()
  magit-setup-buffer-internal(magit-diff-mode nil ((magit-buffer-range nil) (magit-buffer-typearg "--cached") (magit-buffer-diff-args ("--stat" "--no-ext-diff")) (magit-buffer-diff-files nil) (magit-buffer-diff-files-suspended nil)))
  magit-diff-setup-buffer(nil "--cached" ("--stat" "--no-ext-diff") nil)
  magit-commit-diff-1()
  #<subr magit-commit-diff>()
  apply(#<subr magit-commit-diff> nil)
  magit-commit-diff()
  run-hooks(server-switch-hook)
  server-execute(#<process server23432 <127.0.0.1:64200>> (("C:/my-test-git-repository/.git/COMMIT_EDITMSG")) nil nil t nil nil)
  ...略

call dir=c:/my-test-git-repository/ from=
  call-process("git-encwrapper" nil (t nil) nil "--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--ita-visible-in-index" "-p" "--no-prefix" "--numstat" "--cached" "--stat" "--no-ext-diff" "--")
  process-file("git-encwrapper" nil (t nil) nil "--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--ita-visible-in-index" "-p" "--no-prefix" "--numstat" "--cached" "--stat" "--no-ext-diff" "--")
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--ita-visible-in-index" "-p" "--no-prefix" "--numstat" "--cached" "--stat" "--no-ext-diff" "--")
  magit-process-git((t nil) ("--no-pager" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "diff" "--ita-visible-in-index" "-p" "--no-prefix" "--numstat" "--cached" "--stat" "--no-ext-diff" "--"))
  magit-git-insert(("diff" "--ita-visible-in-index" "-p" "--no-prefix" "--numstat" "--cached" "--stat" "--no-ext-diff" "--"))
  magit-git-wash(magit-diff-wash-diffs "diff" ("--ita-visible-in-index" "-p" "--no-prefix" "--numstat" "--cached" "--stat" "--no-ext-diff" "--"))
  magit--insert-diff("diff" nil "-p" "--no-prefix" "--numstat" "--cached" ("--stat" "--no-ext-diff") "--" nil)
  magit-insert-diff()
  magit-run-section-hook(magit-diff-sections-hook)
  magit-diff-refresh-buffer()
  magit-refresh-buffer()
  magit-setup-buffer-internal(magit-diff-mode nil ((magit-buffer-range nil) (magit-buffer-typearg "--cached") (magit-buffer-diff-args ("--stat" "--no-ext-diff")) (magit-buffer-diff-files nil) (magit-buffer-diff-files-suspended nil)))
  magit-diff-setup-buffer(nil "--cached" ("--stat" "--no-ext-diff") nil)
  magit-commit-diff-1()
  #<subr magit-commit-diff>()
  apply(#<subr magit-commit-diff> nil)
  magit-commit-diff()
  run-hooks(server-switch-hook)
  ...略

まとめると次のようになります。

gitコマンドの引数	呼び出し元	より大きな呼び出し元	対策
`diff --quiet --cached --`	magit-anything-staged-p	magit-commit-create
`rev-parse --show-toplevel`	magit-toplevel	magit-commit-create	常時キャッシュ
`rev-parse --git-dir`	magit-git-dir	magit-commit-create	常時キャッシュ
`config core.commentchar`	直接呼び出し	git-commit-setup-font-lock	常時キャッシュ
`for-each-ref --format=%(refname: ...略`	magit-list-local-branch-names	git-commit-setup-font-lock	色分け無効化
`rev-parse --show-toplevel`	magit-toplevel	magit-turn-on-auto-revert-mode-if-desired	常時キャッシュ
`rev-parse --git-dir`	magit-toplevel	magit-turn-on-auto-revert-mode-if-desired	常時キャッシュ
`rev-parse --is-bare-repository`	magit-toplevel	magit-turn-on-auto-revert-mode-if-desired	常時キャッシュ
`ls-files --error-unmatch c:/my- ...略`	magit-file-tracked-p	magit-turn-on-auto-revert-mode-if-desired	コミットファイル無視
`rev-parse HEAD`	magit-rev-parse	git-commit-setup
`ls-files -c -z -- .git/COMMIT_EDITMSG`	vc-git-registered	bug-reference-mode	mode無効化
`ls-tree --name-only -z HEAD -- ....略`	vc-git-registered	bug-reference-mode	mode無効化,コミットファイル無視
`remote get-url upstream`	vc-git-repository-url	bug-reference-mode	mode無効化
`remote get-url origin`	vc-git-repository-url	bug-reference-mode	mode無効化
`diff --quiet --cached --`	magit-anything-staged-p	magit-commit-diff
`diff --quiet --`	magit-anything-unstaged-p	magit-commit-diff
`config -z --get-all magit.extension`	magit-load-config-extensions	magit-commit-diff	常時キャッシュ
`diff --ita-visible-in-index -p ...略`	magit-insert-diff	magit-commit-diff

それぞれのgitコマンドが何のために呼ばれているのかを調べ、一段階高い視点から削減を試みます。

VCとbug-reference-mode

bug-reference-mode から4回もgitが起動されています。

bug-reference-mode はバグトラッカーの番号をリンクに置き換えるマイナーモードのようです。

そしてその bug-reference-mode は git-commit-setup-hook に設定されていることから呼び出されています。

私はこの機能を使っていないのでサクッと登録解除してしまいましょう。

;; ■bug-reference-mode抑制
;; 次のコードはコミットメッセージを書くバッファでbug-reference-modeが起動するのを抑制します。
(with-eval-after-load "git-commit"
  (remove-hook 'git-commit-setup-hook 'bug-reference-mode))

もし使いたい場合でも改善する方法はあります。

vc-git-registeredで.git/COMMIT_EDITMSGファイルがgitリポジトリに登録されているか確認していますが、されているわけがありません(特殊な機能でされることがあったらすみません)。なので次のような最適化が可能です。

;; ■vc-git-registeredで.git/COMMIT_EDITMSGを無視
;; 次のコードは.git/COMMIT_EDITMSG等を即座にgit登録外と判定します。これによりプロセスの起動回数を削減できます。
;; 注意:もし意図的にgitの中で.git/COMMIT_EDITMSGという名前のディレクトリ名やファイル名を使いたいならこのコードは問題になります。(gitがそのようなディレクトリ名を許容するのか知りませんが)
(defun my-vc-git-registered-for-ignoring-commit-filenames (original-fun file)
  (if (string-match-p (concat ".git" git-commit-filename-regexp) file)
      nil
    (funcall original-fun file)))
(advice-add #'vc-git-registered :around #'my-vc-git-registered-for-ignoring-commit-filenames)

bug-reference-modeを使わない場合でもfind-file-hook経由でvc-refresh-stateが呼ばれてvc-git-registeredが呼ばれるようなので、上のコードは起動回数削減に寄与するでしょう。

vc-git-registeredに対処して結果がキャッシュされなくなると、 after-change-major-mode-hook → magit-turn-on-auto-revert-mode-if-desired → magit-file-tracked-p という流れで同じように.git/COMMIT_EDITMSGの登録確認が実行されます。これも同様に対処できます。

;; ■magit-file-tracked-pで.git/COMMIT_EDITMSGを無視
(defun my-magit-file-tracked-p-for-ignoring-commit-filenames (original-fun file)
  (if (string-match-p (concat ".git" git-commit-filename-regexp) file)
      nil
    (funcall original-fun file)))
(advice-add #'magit-file-tracked-p :around #'my-magit-file-tracked-p-for-ignoring-commit-filenames)

バッファの色づけ(git-commit-setup-font-lock)

git-commit-setup-font-lockからgitが呼ばれるのは2回。

一つはmagit-list-local-branch-namesでブランチ名を列挙しているところ。ブランチ名をローカルとリモートで色分けしたいですか？　私は諦められます。というか現在のコードはdeffaceで(featurep 'magit)を使って分岐していますが、magitから(require 'git-commit)するので常にnilです。このままだと常に両方ともfont-lock-variable-name-faceが使われるので、どのみち色分けされません。

ただ、コードの構造的に簡単に直すのが難しいです。関数全体を書き替えてしまうのも手ですが、とりあえず次のコードで無理矢理直しました。

;; ■ブランチ名の色分けを抑制
;; 次のコードはコミットメッセージ用バッファでブランチ名を取得できないようにします。
;; プロセスの起動回数を削減できますが、ローカルブランチとリモートブランチの色分けが行われなくなります。
(defun my-git-commit-setup-font-lock-for-blocking-branch-names-retrieval (original-fun &rest args)
  (cl-letf (((symbol-function 'magit-list-local-branch-names) (lambda () nil))) ;;一時的に関数シンボルの指す先を空にする。
    (apply original-fun args)))
(advice-add #'git-commit-setup-font-lock :around #'my-git-commit-setup-font-lock-for-blocking-branch-names-retrieval)

もう一つは git config core.commentchar を直接的に実行しているところ。コメントの色分けに使うのでしょう。これについては次で。

configのキャッシュを保持

使われているgit configコマンドは次の通りです。

config core.commentchar
config -z --get-all magit.extension

いずれの機能も使っていないので無視しても構いません。

しかし一応対応するのであれば、configコマンドは一律キャッシュをクリアしないというのはどうでしょう。そのための仕組みは既にmy-magit-process-cache.elに作ってあります。

(setq my-magit-process-cache--keep-args-regexp "\\bconfig\\b")

正規表現にマッチするコマンドライン引数を持つキャッシュはデフォルトではクリアされなくなります。

この正規表現だと値の設定や消去(unset)にもマッチしてしまいますが、とりあえずここでは発生しないので置いておきましょう。

もちろんどこかでconfigを変更したときには正しく動作しなくなります。しかし私は上の二つの設定を使っていませんし、使うとしても変更する頻度は高くないでしょう。そのような設定値を頻繁にプロセス起動で取得するのは割に合いません。

念のためgit-status実行時にクリアするのはどうでしょう。おかしくなったら立ち上げ直しますよね？

(defun my-magit-status-for-clearing-cache (&rest args)
  (my-magit-process-cache--clear-cache-all-forced))
(advice-add #'magit-status :before #'my-magit-status-for-clearing-cache)

一部のrev-parseを保持

使われているgit rev-parseコマンドは次の通りです。

rev-parse HEAD
rev-parse --git-dir
rev-parse --show-toplevel
rev-parse --is-bare-repository

rev-parse HEAD は頻繁に変わりますが、それ以外はディレクトリ構造を変えない限り変化しません。これもconfigと同じようにキャッシュを維持して良いのではないでしょうか。

(setq my-magit-process-cache--keep-args-regexp "\\(\\bconfig\\b\\|\\brev-parse \\(--show-toplevel\\|--git-dir\\|--is-bare-repository\\)\\'\\)")

stageされているか否か

magit-anything-staged-p と magit-anything-unstaged-p という関数があります。その名の通り現在のstage状況を確認するための関数です。staged-pはstageされている変更があるかどうか、unstaged-pはstageしていない変更があるかどうかです。

magit-commit-create から magit-anything-staged-p が呼ばれるのは仕方がありません。stageしている変更が無ければそこで終了すべきですから。

しかし magit-commit-diff-1 から magit-anything-staged-p や magit-anything-unstaged-p が呼ばれているのはなぜでしょうか。 magit-commit- なのですからここに来る段階ではstagedなのが当たり前ではないでしょうか。unstagedだと何が変わるのでしょうか。

magit-commit-diff-1 のソースコードを読んでみると、案外色々なシチュエーションがあるようです。ただ、 magit-commit-create によってここに来た場合は staged も unstaged もあえて取得する意味は無いように見えます。であれば次のように必ずstaged=t、unstaged=nilになるようにしてプロセス起動を回避できます。

;; ■staged, unstagedチェックの回避
(defun my-magit-commit-diff-1-for-avoid-call-process (original-fun &rest args)
  (let ((command (magit-repository-local-get 'this-commit-command)))
    (if (memq command
              ;; magit-commit-diff-1内に書かれている特別な対応が必要なコマンド一覧
              '(magit-commit--rebase magit-commit-amend magit-commit-reword magit-commit--all handle-switch-frame))
        (apply original-fun args)
      ;; magit-commit-create等特別な対応が必要ないコマンドなら
      ;; 必ずstage=t, unstaged=nilで良い、と思う。
      ;; (nil nil ,_) が気になるけど、そんなシチュエーションあるの？
      (cl-letf (((symbol-function 'magit-anything-staged-p) (lambda () t))
                ((symbol-function 'magit-anything-unstaged-p) (lambda () nil)))
        (apply original-fun args)))))
(advice-add #'magit-commit-diff-1 :around #'my-magit-commit-diff-1-for-avoid-call-process)

残り

`diff --quiet --cached --`	magit-anything-staged-p	magit-commit-create
`rev-parse HEAD`	magit-rev-parse	git-commit-setup
`diff --ita-visible-in-index -p ...略`	magit-insert-diff	magit-commit-diff

rev-parse HEADはコミットのたびに変化してしまいます。取得したコミットのハッシュ値は、git-commit-run-post-finish-hookでコミットが完了するのを待つときに使われます。0.01秒ごとにrev-parse HEADを実行して変化したらコミット完了と判定するみたいです。そんなの別に今じゃなくてもいいじゃん、書いている途中に非同期で取得してよ、と思いますが、まぁ、このくらいは勘弁してやります。面倒くさいし。非同期はともかくfinish時でいいとは思いますけどね。

最後のdiffはdiffを表示するなら避けられないでしょう。

その他細かい設定

git-commit-major-modeをnilにしておくとメジャーモードの切り替え処理が一つ減ります。デフォルトはtext-modeになっています。 fundamental-modeでいいやと思うならnilにしましょう。数十msくらい節約になります。

;; ■コミットメッセージを書くためのバッファでメジャーモードを切り替えない
(setq git-commit-major-mode nil)

最初にメジャーモードが設定される時にやってしまえば良さそうなものですが出来ないのでしょうか？

最終計測

というわけで最終計測です。最初の方で実行したcall-processを含んだ方法で計測します。call-processが削減されたことも確認したいので。

;; 調査用コード
(require 'my-profiler)
(my-profiler-instrument-all
 '((magit-commit-create . start)
   magit-commit-diff
   (server-execute . stop)
   git-commit-setup
   git-commit-setup-font-lock-in-buffer
   magit-auto-revert-mode-enable-in-buffers
   normal-mode
   (call-process . short)
))
(progn
  (switch-to-buffer "magit: my-test-git-repository") ;;既に開いてstageしてあるMagitのバッファを表に出す。
  (magit-commit-create) ;;そのバッファ上でmagit-commit-createを実行する。
)

一回目はconfigやrev-parseのキャッシュが済んでいないのでやや遅くなります。

TM	     0.023	+     0.023	          	Enter #[128 \300\301\302^C#\207 [apply my-magit-process-cache--commit-create #<subr magit-commit-create> nil] 5 nil (byte-code ^C\203
\0\301\302 BC\207\302 C\207 [current-prefix-arg --amend magit-commit-arguments] 2)]
TM	    90.752	+    90.729	    90.361	Eval   #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   170.682	+    79.930	    79.417	Eval   #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   250.379	+    79.697	    78.845	Eval   #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   347.523	+    97.144	    75.891	Eval   #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   347.642	+     0.119	          	Enter  #<subr git-commit-setup-font-lock-in-buffer>
TM	   347.666	+     0.024	     0.017	Leave  #<subr git-commit-setup-font-lock-in-buffer>
TM	   347.678	+     0.012	          	Enter  #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   347.698	+     0.020	     0.014	Leave  #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   360.608	+    12.910	   360.541	Leave #[128 \300\301\302^C#\207 [apply my-magit-process-cache--commit-create #<subr magit-commit-create> nil] 5 nil (byte-code ^C\203
\0\301\302 BC\207\302 C\207 [current-prefix-arg --amend magit-commit-arguments] 2)]
TM	   360.700	+     0.092	          	Enter #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   360.726	+     0.026	     0.014	Leave #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   534.973	+   174.247	          	Enter #<subr server-execute>
TM	   542.818	+     7.845	          	Enter  #<subr normal-mode>
TM	   542.860	+     0.042	          	Enter   #<subr git-commit-setup-font-lock-in-buffer>
TM	   617.753	+    74.893	    74.777	Eval     #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   618.189	+     0.436	    75.309	Leave   #<subr git-commit-setup-font-lock-in-buffer>
TM	   618.229	+     0.040	          	Enter   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   712.136	+    93.907	    84.548	Eval     #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   789.723	+    77.587	    77.278	Eval     #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   866.628	+    76.905	    76.519	Eval     #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   866.940	+     0.312	   248.700	Leave   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   871.546	+     4.606	          	Enter   #<subr git-commit-setup-font-lock-in-buffer>
TM	   872.208	+     0.662	     0.643	Leave   #<subr git-commit-setup-font-lock-in-buffer>
TM	   872.240	+     0.032	          	Enter   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   881.868	+     9.628	     9.617	Leave   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   882.129	+     0.261	   339.300	Leave  #<subr normal-mode>
TM	   882.152	+     0.023	          	Enter  #<subr git-commit-setup>
TM	   967.860	+    85.708	    84.202	Eval    #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   973.618	+     5.758	    91.407	Leave  #<subr git-commit-setup>
TM	   973.642	+     0.024	          	Enter  #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   973.660	+     0.018	     0.011	Leave  #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   977.661	+     4.001	          	Enter  #<subr magit-commit-diff>
TM	   984.019	+     6.358	          	Enter   #<subr git-commit-setup-font-lock-in-buffer>
TM	   984.049	+     0.030	     0.022	Leave   #<subr git-commit-setup-font-lock-in-buffer>
TM	   984.078	+     0.029	          	Enter   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   984.107	+     0.029	     0.023	Leave   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	  1110.370	+   126.263	   125.311	Eval    #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	  1111.088	+     0.718	   133.404	Leave  #<subr magit-commit-diff>
TM	  1113.181	+     2.093	   578.189	Leave #<subr server-execute>

問題は二回目以降です。

TM	     0.023	+     0.023	          	Enter #[128 \300\301\302^C#\207 [apply my-magit-process-cache--commit-create #<subr magit-commit-create> nil] 5 nil (byte-code ^C\203
\0\301\302 BC\207\302 C\207 [current-prefix-arg --amend magit-commit-arguments] 2)]
TM	    87.735	+    87.712	    87.139	Eval   #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   103.653	+    15.918	   103.562	Leave #[128 \300\301\302^C#\207 [apply my-magit-process-cache--commit-create #<subr magit-commit-create> nil] 5 nil (byte-code ^C\203
\0\301\302 BC\207\302 C\207 [current-prefix-arg --amend magit-commit-arguments] 2)]
TM	   296.154	+   192.501	          	Enter #<subr server-execute>
TM	   303.936	+     7.782	          	Enter  #<subr normal-mode>
TM	   303.981	+     0.045	          	Enter   #<subr git-commit-setup-font-lock-in-buffer>
TM	   304.298	+     0.317	     0.307	Leave   #<subr git-commit-setup-font-lock-in-buffer>
TM	   304.312	+     0.014	          	Enter   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   314.016	+     9.704	     9.693	Leave   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   316.569	+     2.553	          	Enter   #<subr git-commit-setup-font-lock-in-buffer>
TM	   316.849	+     0.280	     0.270	Leave   #<subr git-commit-setup-font-lock-in-buffer>
TM	   316.863	+     0.014	          	Enter   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   326.005	+     9.142	     9.132	Leave   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   326.220	+     0.215	    22.274	Leave  #<subr normal-mode>
TM	   326.240	+     0.020	          	Enter  #<subr git-commit-setup>
TM	   405.085	+    78.845	    77.140	Eval    #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   409.544	+     4.459	    83.276	Leave  #<subr git-commit-setup>
TM	   409.580	+     0.036	          	Enter  #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   409.598	+     0.018	     0.010	Leave  #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   413.333	+     3.735	          	Enter  #<subr magit-commit-diff>
TM	   418.831	+     5.498	          	Enter   #<subr git-commit-setup-font-lock-in-buffer>
TM	   418.852	+     0.021	     0.014	Leave   #<subr git-commit-setup-font-lock-in-buffer>
TM	   418.864	+     0.012	          	Enter   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   418.882	+     0.018	     0.012	Leave   #<subr magit-auto-revert-mode-enable-in-buffers>
TM	   543.655	+   124.773	   123.842	Eval    #[128 \300\301\302^C#\207 [apply my-call-process-for-bypassing-git-encwrapper #[128 \300\301\302^C#\207 [apply my-procargfix-advice--call-process #<subr call-process> ((depth . 99))] 5 nil] nil] 5 nil]
TM	   544.376	+     0.721	   131.027	Leave  #<subr magit-commit-diff>
TM	   546.288	+     1.912	   250.112	Leave #<subr server-execute>

546ms！　全く引っかかりが無いとは言えませんが、実用上ほとんど問題ない程度になったと思います。元が7822msでしたから元の6.98%にまで減ったことになります。

もちろん三回目以降も同じような時間になりますし、Magitのバッファを削除して再度magit-statusを実行してから計測すると、一回目の時間になります。キャッシュのクリアも機能しています。

コミットメッセージ以外の高速化

ここまではコミットメッセージを書けるようになるまでの時間を改善してきましたが、それ以外の部分でも改善の余地がありました。

コミットメッセージ以外でも常にキャッシュを有効化する

configやrev-parseは常時キャッシュしても問題ないものがありそうです。

これまでにキャッシュしたのは次のgitコマンドです。

config core.commentchar
config -z --get-all magit.extension
rev-parse --show-toplevel
rev-parse --git-dir
rev-parse --is-bare-repository

これらのうちいくつかはリフレッシュ時などコミット以外でも実行されます。

そこで my-magit-process-cache-always-mode というグローバルモードを作成しました。これは常時キャッシュを有効にしつつ、比較的安全そうなものだけをキャッシュするモードです。

my-magit-process-cache-commit-msg-modeと同じようにコミットメッセージ編集バッファを立ち上げる間は全てをキャッシュします。

その上でそれ以外の時でも上に挙げたconfigやrev-parseはキャッシュします。

このモードはこれまでに挙げた次の改善を内包します。

git-commit-createのときだけキャッシュするモード(my-magit-process-cache-commit-msg-mode)
configのキャッシュを保持
一部のrev-parseを保持

gitとは関係ないディレクトリでのmagit-auto-revert-mode

調査用のコードを有効にしていると気がつくのですが、git管理下に無いファイルを単に開いただけでgitを四回呼び出します。

call dir=c:/tmp/ from=
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  magit-process-git((t nil) ("rev-parse" "--show-toplevel"))
  magit-git-str("rev-parse" "--show-toplevel")
  magit-rev-parse-safe("--show-toplevel")
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  find-file-noselect-1(#<buffer test.txt> "~/tmp/test.txt" nil nil "~/tmp/test.txt" (552535379283176539 1121764838))
  find-file-noselect("c:/tmp/test.txt" nil nil nil)
  find-file("c:/tmp/test.txt")

call dir=c:/tmp/ from=
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  magit-process-git((t nil) ("rev-parse" "--git-dir"))
  magit-git-str("rev-parse" "--git-dir")
  magit-rev-parse-safe("--git-dir")
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(change-major-mode-after-body-hook after-change-major-mode-hook)
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/tmp/ from=
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--show-toplevel")
  magit-process-git((t nil) ("rev-parse" "--show-toplevel"))
  magit-git-str("rev-parse" "--show-toplevel")
  magit-rev-parse-safe("--show-toplevel")
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(after-change-major-mode-hook)
  run-mode-hooks(text-mode-hook)
  text-mode()
  ...略
  set-auto-mode()
  normal-mode(t)
  after-find-file(nil t)
  ...略

call dir=c:/tmp/ from=
  magit-process-file("git-encwrapper" nil (t nil) nil "--no-pager" "--literal-pathspecs" "-c" "core.preloadindex=true" "-c" "log.showSignature=false" "-c" "color.ui=false" "-c" "color.diff=false" "-c" "i18n.logOutputEncoding=UTF-8" "rev-parse" "--git-dir")
  magit-process-git((t nil) ("rev-parse" "--git-dir"))
  magit-git-str("rev-parse" "--git-dir")
  magit-rev-parse-safe("--git-dir")
  magit-toplevel()
  magit-turn-on-auto-revert-mode-if-desired()
  magit-auto-revert-mode-enable-in-buffers()
  run-hooks(after-change-major-mode-hook)
  run-mode-hooks(text-mode-hook)
  text-mode()
  ...略
  set-auto-mode()
  normal-mode(t)
  after-find-file(nil t)
  ...略

change-major-mode-after-body-hook から magit-auto-revert-mode-enable-in-buffers の流れです。また magit-auto-revert-mode か。

これだけで数百msくらいかかるわけです。もう本当に勘弁して欲しい。

ルートまで辿って.gitが無ければ何もしないようにしましょう。vc-git-rootというおあつらえ向きな関数があるのでそれを流用することにします。上のディレクトリに向かって.gitディレクトリを探す関数です。

;; ■magit-auto-revert-modeでvc-git-rootを使う
;; ファイルを開くときに(正確にはメジャーモードが変わるときに) .gitディ
;; レクトリが存在しないときはauto-revert-modeを立ち上げるかどうかのチェッ
;; クを即座に打ち切ります。
;; これによりプロセスの起動回数を削減できます。
;; 警告: もし.gitディレクトリ無しにgit管理下のファイルがある場合は正しく動作しなくなります。
(defun my-magit-turn-on-auto-revert-mode-if-desired-for-use-vc-git-root (original-fun &optional file)
  (if file
      (funcall original-fun file)
    (when (and buffer-file-name
               (vc-git-root buffer-file-name))
      (funcall original-fun file))))

(advice-add #'magit-turn-on-auto-revert-mode-if-desired :around #'my-magit-turn-on-auto-revert-mode-if-desired-for-use-vc-git-root)

gitの管理下なのに.gitディレクトリが存在しないケースはあるのでしょうか。GIT_DIRが指定されている場合？　もしあったとしても私はそういったことはしないので問題ありません。

特殊なケースを利用しないのであれば、magit-toplevel自体を差し替えるという方法もあります。

;; ■magit-toplevelを不完全だが高速なものに差し替え
;; magit-toplevelは頻繁に呼び出されるので高速化の効果は大きいです。
;; 欠点: 特殊な形式のリポジトリを一切認識しなくなります。
(defun my-magit-toplevel-fast-but-imperfect (original-fun &optional directory)
  (magit--with-refresh-cache
      (cons (or directory default-directory) 'magit-toplevel)
    (magit--with-safe-default-directory directory
      (save-match-data
        (cond
         ;; Remote
         ((file-remote-p default-directory)
          (funcall original-fun directory))
         ;; Submodule (2022-11-23追記)
         ((string-match "\\`\\(.*/\\)\\.git/modules/\\(.*\\)\\'" default-directory)
          (concat (match-string 1 default-directory)
                  (match-string 2 default-directory)))
         ;; Does not support:
         ;; - environments for git directory (GIT_DIR, GIT_WORK_TREE, etc)
         ;; - bare repository
         ;; - find-file-visit-truename
         (t
          (when-let ((root-dir (vc-git-root default-directory)))
            (magit-expand-git-file-name root-dir))))))))
(advice-add #'magit-toplevel :around #'my-magit-toplevel-fast-but-imperfect)

(2022-11-23追記: サブモジュール下のコミットで正しくdiffが表示されなかったので修正しました。これも割と適当な修正の仕方です)

Magitはベアリポジトリでも使えるんですね。 git rev-parse --is-bare-repository はどうやってベアリポジトリを判別するのでしょうか。とりあえず未対応で。

まとめ

プロセスの起動回数を削減することでコミットログを編集するまでに約8秒かかっていたものが約0.5秒まで短縮できました。

その代わりに細かい制限が増えていますが私の使用状況ではほとんど支障は無い程度です。

MagitがWindowsで遅い原因には次のようなものがあります。

Magitの設計がごく短時間でプロセスを起動できるOSを前提にしたものになっていてWindowsがそうではない
EmacsやGitにもWindows版には多少のオーバーヘッドがある

開発者は問題を認識しており、様々な対策を講じてきたようです。特にlibgitを使ったアプローチは魅力的です。しかしlibgitを使うことで生じる問題や、何よりこの改善がWindowsユーザーしか喜ばない点でなかなか進まないようです。

いつかはより根本的な対策がなされると思いますが、それまではこのような小手先の改善で回避していく方が現実的かもしれません。

コード

最終的なコードは次の場所に配置してあります。

misohena/my-magit-speedup-for-windows: My setup files for Magit on MS-Windows.

環境

Emacs 28.2 (Windows版公式ビルド)

Windows 10 22H2

Core i7-6700 3.4GHz/H170M-PLUS/MEM16GB/SSD1TB

Magit 20221101.2214 [>= 3.3.0-git]

Git for Windows 2.38.1.windows.1

2022-11-06 MSYS2

win-ssh-agentをMSYS2で使う

長年win-ssh-agentを使っているのですが、ふとMSYS2で動作するのか、また、ビルドできるのか気になったので試してみました。

MSYS2でwin-ssh-agentをビルドする

ビルドするには、おそらく

pacman -S base-devel
pacman -S msys2-devel
pacman -S msys2-runtime-devel

あたりが入っていれば良いのだと思います。色々やった後の環境なので、いつの間にか入っているパッケージで必要なものがまだあるかもしれません。

それらを入れてMSYS環境からmakeしてみたところ、無事ビルドが成功して動作もしました。出来上がったexeはCygwinと同じように専用のDLL(msys-2.0.dll)に依存します。win-ssh-agentはpopenやらwait3やらcygwin_internalやら素のWindowsには無い関数を使用しているので仕方ないところです。全部Win32で書き直せば依存関係を減らせますが、CygwinかMSYS2環境下で動かすのが目的なのでやる必要は無いでしょう。

CygwinとMSYS2の両方で使う

通常Cygwin側でwin-ssh-agentを実行してもMSYS2側のsshでは認識されません(毎回パスフレーズが求められます)。反対にMSYS2側でwin-ssh-agentを実行してもCygwin側のsshでは認識されません。

なぜかというと環境変数に保存されるパスがそれぞれの環境独自のパスになっているからです。例えば次のように。

SSH_ASKPASS=/usr/loca/bin/win-ssh-askpass.exe
SSH_AUTH_SOCK=/tmp/ssh-????????????\agent.????

/usr や /tmp がどこにマップされているかは環境(CygwinかMSYS2か)で異なります。

これをc:から始まる通常のフルパスに直すとCygwinからでもMSYS2からでも認識されます。

SSH_ASKPASS=c:\cygwin\usr\local\bin\win-ssh-agent/win-ssh-askpass.exe
SSH_AUTH_SOCK=c:\cygwin\tmp\ssh-????????????\agent.????

MSYS2も元はCygwinということできっと方式は同じなのでしょう。

win-ssh-agentではわざわざWindows標準のパスをCygwin用のパスに変換している場所があります(SSH_ASKPASS設定時)。また、ssh-agentから返ってくるCygwin用のパスを変換せずにSSH_AUTH_SOCKに設定しています。これらの場所で確実にWindows用のフルパスに変換してしまえば、CygwinからでもMSYS2からちゃんと認識してくれるようになります。

具体的には、 misc.h, misc.cpp に conv_path_posix_to_win という関数があるので、それをコピーしてstd::stringを返すバージョン(conv_path_posix_to_win_aとか)を作り、setenvするところ(こことかこことか)で変換してしまえばOKです。ちゃんとやるなら全部ワイド文字列にすべきですが、面倒なのでいいや。