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

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

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

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

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

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

調査と実装

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

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

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

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

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

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

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

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

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

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

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

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

注:

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

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

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

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

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

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

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

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

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

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

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

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

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

コード

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

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

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

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

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

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

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

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

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

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

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