Emacsのツールバーをカスタマイズする

Android版のEmacsのためにツールバーをカスタマイズしました。

修正前の状態は次図の通り。

今回はあくまで一番上の標準的なツールバー(tool-bar-mode)のお話しです。その下にあるキー入力用のバーは無視してください(これもそのうち何とかしなきゃいけませんが)。

上図はデフォルトの状態なのですが、どのボタンが何をするか分かるでしょうか。私は正直よく分かっていませんでした。一番左からファイル新規作成、ファイルを開く、ディレクトリを開く、バッファを閉じる、セーブ、アンドゥ、カット、コピー、ペースト、インクリメンタル検索となっています。

一番問題なのは最初の「ファイル新規作成、ファイルを開く、ディレクトリを開く」の部分です。これって実際に何をするか分かりますか？　Emacsでは通常全てfind-fileで行うものだと思います。実際に割り当てられているコマンドは左から、find-file、menu-find-file-existing、diredとなっています。find-fileだけでいいじゃん！

それとバッファを閉じるための×が押しにくいんですよね。一番左に配置しましょう。

カット、コピーは長押しのコンテキストメニューでやっているのでここには要らないかなーと思います。ペーストくらいは残しておいても良いかな？　この辺りはまた後で変えるかも。

他にもいくつかよく使う操作をツールバーのボタンにしたいと思います。

それと全体的にアイコンが小さすぎません？　いや、これはデフォルトフォントサイズの設定に合わせて変わってしまっています。私はデフォルトフォントを少し小さめにしてしまったので、ツールバーのボタンも一緒に小さくなって押しづらくなってしまいました。そしてツールバーのボタンのサイズだけを調整する方法が見当たりません。tool-barフェイスの:heightを変更してみてもこれはテキストのみにしか効果が無いらしくアイコンのサイズは変わりませんでした。うーん困った。

で、色々やってみた結果がこちら。

ボタンの数が減ってシンプルで分かりやすくなりました。ボタンのサイズも大きくなって押しやすくなりました。

一番右に追加したボタンはbeginning-of-bufferとend-of-bufferです。長いファイルの途中にいるときにタッチによるスクロールだけで大きく移動するのは大変です。かといってM-<やM->を押すのもなかなか面倒なので追加してみました。

作成したコードは次のようになりました。

;; 項目のカスタマイズ(既存項目の削除、並び順の変更)
;; tool-bar-mapを直接変更します。
;; tool-bar-setupが呼び出された後じゃないと正しく動作しません。

(defun my-tool-bar-map--customize-items (map)
  "tool-bar-mapの項目をカスタマイズします。"

  ;; new-file(find-file)のアイコンをopen-fileのものに変更
  (setf (plist-get (cdddr (alist-get 'new-file (cdr map))) :image)
        (plist-get (cdddr (alist-get 'open-file (cdr map))) :image))

  ;; 不要なアイコンを非表示
  ;;   - diredとopen-fileはnew-file(find-file)で代替できる
  ;;   - cutとcopyはコンテキストメニューでできる
  ;;     (pasteは正確な位置指定のために一応残す)
  (dolist (key '(dired open-file cut copy))
    (setf (plist-get (cdddr (alist-get key (cdr map))) :visible) nil))

  ;; separator-2と3を削除
  (setf (alist-get 'separator-2 (cdr map) nil t) nil)
  (setf (alist-get 'separator-3 (cdr map) nil t) nil)

  ;; kill-bufferをツールバーの先頭に移動
  ;; kill-bufferの右にseparator
  (let ((item (assq 'kill-buffer (cdr map))))
    (setf (alist-get 'kill-buffer (cdr map) nil t) nil)
    (setf (alist-get 'separator-0 (cdr map) nil t) nil)
    (setcdr map (cons item
                      (cons
                       (list 'separator-0 "--")
                       (cdr map))))))

;; 項目の追加

(defconst my-tool-bar-map--additional-items
  '((top "Top" beginning-of-buffer "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"24\" height=\"24\" version=\"1.1\"><path stroke=\"none\" d=\"M4 2H20V4H12L18 10H14V22H10V10H6L12 4H4Z\" fill=\"#444\" /></svg>")
    (bottom "Bottom" end-of-buffer "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"24\" height=\"24\" version=\"1.1\"><path stroke=\"none\" d=\"M4 22H20V20H12L18 14H14V2H10V14H6L12 20H4Z\" fill=\"#444\" /></svg>")))

(defun my-tool-bar--add-item (map id text cmd image-data)
  (setcdr map (assq-delete-all id (cdr map)))
  (setcdr map (append
               (cdr map)
               (list
                (list id 'menu-item text cmd
                      :image
                      (list 'quote
                            (create-image image-data
                                          'svg t :scale 'default)))))))

(defun my-tool-bar-map--customize-additional (map)
  (dolist (spec my-tool-bar-map--additional-items)
    (apply #'my-tool-bar--add-item map spec)))

;; アイコンサイズの調整
;; image descriptorに:scaleを無理矢理追加して調整します。

(defconst my-tool-bar--icon-scale 2.8) ;; ★要調整

(defun my-tool-bar--adjust-image-scale (image)
  (when image
    (setf (plist-get (cdr image) :scale) my-tool-bar--icon-scale))
  image)

(defun my-tool-bar--adjust-map-image-scale (map)
  (dolist (item (cdr map))
    (when-let* ((image (plist-get (cddddr item) :image)))
      (setf (plist-get (cddddr item) :image)
            (list 'my-tool-bar--adjust-image-scale image)))))

(defun my-tool-bar-map--customize-icon-size (map)
  (my-tool-bar--adjust-map-image-scale map))

;; 初期化

(defun my-tool-bar-map--customize ()
  (let ((map (default-value 'tool-bar-map)))
    (my-tool-bar-map--customize-items map)
    (my-tool-bar-map--customize-additional map)
    (my-tool-bar-map--customize-icon-size map)))

(if (and (boundp 'tool-bar-map) (cdr-safe (default-value 'tool-bar-map)))
    ;; すでにtool-bar-mapが初期化されているときは更新
    (progn
      (my-tool-bar-map--customize)
      (tool-bar--flush-cache)
      (force-mode-line-update))
  ;; まだの時は初期化されるまで待つ
  (advice-add 'tool-bar-setup :after #'my-tool-bar-map--customize))

Emacsのツールバーはカスタマイズ性が悪いですね。どうせみんな使ってないんでしょう？　いや、私もPC上では使っていませんが。まさかこの期に及んでツールバーをカスタマイズすることになるとは思いませんでした。

(2025-11-13:追記)org-mode時の折りたたみ操作もやりづらいので、org-mode用の項目も追加しました。

(defvar my-org-tool-bar-map
  (let ((map (make-sparse-keymap)))
    (define-key-after map [separator-org-1] menu-bar-separator)
    (define-key-after map [fold]
      `(menu-item
        "Fold" my-org-fold-current-subtree
        :help "Fold current subtree"
        :image (create-image "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"24\" height=\"24\" version=\"1.1\"><path d=\"M12 14 6 20H18\" fill=\"#444\" stroke=\"none\" /><path d=\"M12 10 18 4H6\" fill=\"#444\" stroke=\"none\" /></svg>" 'svg t :scale 'default)))
    map))

(defun my-org-tool-bar-map ()
  ;; make-composed-keymapは機能しない。
  ;; :imageの部分が展開されないから。(See: `tool-bar-make-keymap-1')
  ;; (make-composed-keymap (default-value 'tool-bar-map)
  ;;                       my-org-tool-bar-map)
  (let ((map (copy-keymap (default-value 'tool-bar-map))))
    (set-keymap-parent map my-org-tool-bar-map)
    map))

(defun my-org-fold-current-subtree ()
  "現在のサブツリーを折りたたみます。
ポイントが見出しにあり、その見出しがすでに折りたたまれている場合は、それ
を含む一つ上のサブツリーを折りたたみます。"
  (interactive)
  (if (org-at-heading-p)
      (if (org-fold-core-folded-p (pos-eol))
          ;; 折りたたまれている見出し上にいる場合
          (progn
            (outline-up-heading 1)
            (outline-hide-subtree))
        ;; 折りたたまれていない見出し上にいる場合
        (outline-hide-subtree)
        (unless (org-fold-core-folded-p (pos-eol))
          ;; 折りたためなかった場合、一つ上を試す
          ;; (空のエントリーの場合は折りたためない)
          (outline-up-heading 1)
          (outline-hide-subtree)))
    ;; 見出し以外にいる場合
    (outline-previous-heading)
    (outline-hide-subtree)))

(defun my-org-tool-bar-setup ()
  (setq-local tool-bar-map (my-org-tool-bar-map)))

(add-hook 'org-mode-hook 'my-org-tool-bar-setup)

org-modeの折りたたみ操作はキー操作においても常々不満があります。見出し上なら単に TAB で折りたためますが、エントリーの中では C-c C-p TAB としなければなりませんし、見出しの上でそれを含むサブツリーを折りたたむには C-c C-u TAB としなければならなかったりします。上に書いた my-org-fold-current-subtree コマンドは、どこであっても概ね狙った通りに折りたたむ(閉じる)ことが出来ます。