2024-03-03

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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