2025-07-27

VerticoとCorfuをタッチスクリーンで操作できるようにする

私はEmacsの補完インタフェースにVerticoとCorfuを使用していますが、Android版のEmacsを使っていると補完候補の一覧をタップで選択できないことにフラストレーションを感じます。同様にスワイプによるスクロールも出来ません。

というわけで、何とかしてみました。

Vertico用のコード:

;;; my-vertico-touch.el ---                          -*- lexical-binding: t; -*-

;; 使い方:
;; (with-eval-after-load 'vertico
;;   (require 'my-vertico-touch)
;;   (my-vertico-touch-setup)

(require 'vertico)
(require 'vertico-mouse)

(defconst my-vertico-touch-tap-threshold 4)

(defun my-vertico-touchscreen-begin (begin-event)
  (interactive "e")
  (let* ((begin-posn (cdadr begin-event))
         (begin-xy (posn-x-y begin-posn))
         (begin-window (posn-window begin-posn))
         (moved nil))
    (with-selected-window begin-window
      (let ((begin-scroll-pos vertico--scroll))
        (while
            (let ((ev (read-event)))
              (pcase (car-safe ev)
                ('touchscreen-update
                 (let* ((update-xy (touch-screen-relative-xy (cdaadr ev)
                                                             begin-window))
                        (dx (- (car update-xy) (car begin-xy)))
                        (dy (- (cdr update-xy) (cdr begin-xy))))
                   (when (and (not moved)
                              (>= (+ (* dx dx) (* dy dy))
                                  (* my-vertico-touch-tap-threshold
                                     my-vertico-touch-tap-threshold)))
                     (setq moved t))
                   (when moved
                     (let* ((dline (/ dy (default-line-height)))
                            (new-scroll-pos (- begin-scroll-pos dline)))
                       (cond
                        ((< new-scroll-pos vertico--scroll)
                         (vertico--goto (+ new-scroll-pos vertico-scroll-margin)))
                        ((> new-scroll-pos vertico--scroll)
                         (vertico--goto (+ new-scroll-pos vertico-count
                                           (- vertico-scroll-margin))))))
                     (vertico--exhibit)))
                 t)
                ('touchscreen-end
                 (unless moved
                   (vertico--goto (vertico-mouse--index begin-event))
                   (vertico-exit))
                 nil))))))))

(defun my-vertico-touch-setup ()
  (interactive)
  (vertico-mouse-mode)
  (define-key vertico-mouse-map (kbd "<touchscreen-begin>")
              #'my-vertico-touchscreen-begin))

(defun my-vertico-touch-teardown ()
  (interactive)
  (define-key vertico-mouse-map (kbd "<touchscreen-begin>")
              #'my-vertico-touchscreen-begin
              t))

(provide 'my-vertico-touch)

Corfu用のコード:

;;; my-corfu-touch.el ---                            -*- lexical-binding: t; -*-

;; 使い方:
;; (with-eval-after-load "corfu"
;;   (require 'my-corfu-touch)
;;   (my-corfu-touch-setup))

(require 'corfu)

;;;; Frame Handling

(defun my-corfu-defocus-child-frame ()
  "corfu用の子フレームからフォーカスを外す。"
  (when (eq (selected-frame) corfu--frame)
    (when-let* ((parent (frame-parent)))
      (select-frame parent))))

(defun my-corfu-handle-switch-frame-p ()
  "フレームの変更処理中なら非nilを返す。
`this-command'と`last-input-event'によって判定される。

`this-command'が`handle-switch-frame'であり、かつ、`last-input-event'が
corfu用の子フレームに対する`switch-frame'イベントであれば、非nilを返し、
そうでなければnilを返す。"
  (and (eq this-command 'handle-switch-frame)
       (eq (car-safe last-input-event) 'switch-frame)
       (eq (cadr last-input-event) corfu--frame)))

;; 子フレームがクリック/タップされたとき、`switch-frame'イベントが発生
;; し`handle-switch-frame'コマンドが実行される。また、その前後でwindow
;; 変更を通知するフックも呼び出される(クリックかタップかによって微妙に
;; 順番は変わる?)。
;;
;; それらのタイミングのどこかでフォーカスの変更が行われるので、
;; `my-corfu-defocus-child-frame'を呼び出して元の親フレームがフォーカス
;; されている状態を維持する必要がある(`switch-frame'の効果を打ち消す)。
;;
;; また、`handle-switch-frame'コマンドによってcorfuが終了してしまうこ
;; とがあるので、それも防止する必要がある。基本的にcorfuの候補表示フレー
;; ム(`corfu--frame')に対する`handle-switch-frame'は無視した方が良い。

(defun my-corfu--post-command:around (old-fun &rest args)
  (my-corfu-defocus-child-frame)

  (unless (my-corfu-handle-switch-frame-p)
    (apply old-fun args)))

(defun my-corfu--prepare:around (old-fun &rest args) ;; pre-command-hook
  (unless (my-corfu-handle-switch-frame-p)
    (apply old-fun args)))

(defun my-corfu--window-change:around (old-fun &rest args)
  ;; 注意: タッチイベントの時はhandle-switch-frameよりも先にここに来る。
  ;;       クリックの時は先にhandle-switch-frameが発生するのでこれは不要。
  (my-corfu-defocus-child-frame)
  (apply old-fun args))

;;;; Candidate List

(defun my-corfu-select (index)
  (corfu--goto index)
  (corfu-insert))

(defun my-corfu-posn-line-number (posn)
  (with-current-buffer (window-buffer (posn-window posn))
    (line-number-at-pos (posn-point posn) t)))

(defun my-corfu-posn-index (posn)
  (+ corfu--scroll (my-corfu-posn-line-number posn) -1))

(defun my-corfu-select-clicked (event)
  (interactive "e")
  (my-corfu-select (my-corfu-posn-index (event-start event))))

(defun my-corfu-set-scroll-pos (new-scroll-pos)
  (cond
   ((< new-scroll-pos corfu--scroll)
    (corfu--goto (+ new-scroll-pos corfu-scroll-margin)))
   ((> new-scroll-pos corfu--scroll)
    (corfu--goto (+ new-scroll-pos corfu-count
                    (- corfu-scroll-margin))))))

;;;; Mouse / Touch Event Handlers

(defun my-corfu-on-mouse-1 (event)
  (interactive "e")
  (my-corfu-select-clicked event))

(defconst my-corfu-touch-tap-threshold 4)

(defun my-corfu-on-touchscreen-begin (begin-event)
  (interactive "e")
  (let* ((begin-posn (cdadr begin-event))
         (begin-window (posn-window begin-posn))
         (begin-xy (posn-x-y begin-posn))
         (moved nil))
    (with-selected-window begin-window
      (let ((begin-scroll-pos corfu--scroll)
            (echo-keystrokes 0))
        (while
            (let ((ev (read-event)))
              (pcase (car-safe ev)
                ('touchscreen-update
                 (let* ((update-xy (touch-screen-relative-xy (cdaadr ev) begin-window))
                        (dx (- (car update-xy) (car begin-xy)))
                        (dy (- (cdr update-xy) (cdr begin-xy))))
                   (when (and (not moved)
                              (>= (+ (* dx dx) (* dy dy))
                                  (* my-corfu-touch-tap-threshold
                                     my-corfu-touch-tap-threshold)))
                     (setq moved t))
                   (when moved
                     (let* ((dline (/ dy (default-line-height)))
                            (new-scroll-pos (- begin-scroll-pos dline)))
                       (my-corfu-set-scroll-pos new-scroll-pos))
                     (corfu--exhibit)))
                 t)
                ('touchscreen-end
                 (unless moved
                   (my-corfu-select (my-corfu-posn-index (cdadr begin-event))))
                 nil))))))))

;;;; Setup

(defun my-corfu-touch-setup ()
  (interactive)

  ;; pre-command-hook、post-command-hook、ウィンドウ切り替え時の処理を修正する。
  (advice-add 'corfu--post-command :around 'my-corfu--post-command:around)
  (advice-add 'corfu--prepare :around 'my-corfu--prepare:around)
  (advice-add 'corfu--window-change :around 'my-corfu--window-change:around)

  ;; マウスを無視するためのキーマップにマウスやタッチのイベントハンドラを
  ;; 登録してしまう。
  (push 'my-corfu-on-mouse-1 corfu-continue-commands)
  (push 'my-corfu-on-touchscreen-begin corfu-continue-commands)
  (define-key corfu--mouse-ignore-map
              [mouse-1] #'my-corfu-on-mouse-1)
  (define-key corfu--mouse-ignore-map
              [touchscreen-begin] #'my-corfu-on-touchscreen-begin)

  ;; 子フレームにフォーカスが当たるようにする。
  ;; そうしないとイベントが起きないので。
  (setf (alist-get 'no-accept-focus corfu--frame-parameters) nil))

(provide 'my-corfu-touch)

VerticoもCorfuも同じ作者によるものなので構造は似ています。

どちらもマウスやタッチイベントは完全に無視するように作られているので、まずはそれを解除する必要があります。

Verticoの方はvertico-mouse-modeというのが付属しているので、それを参考にしてタッチイベントへの対応を追加しました。

Corfuの方は子フレームを使っているので、改善の難易度が上がります。タッチした瞬間に子フレームにフォーカスが移動し、当然カレントバッファも変わってしまいます。そのため上のコードではフォーカスを親フレームに戻す処理を入れています。そういった遷移イベントによってCorfuが終了してしまうことも防止する必要がありました。一応マウスクリックにも対応させてみましたが、ホイールへの対応はうまく出来ませんでした。フォーカスが当たっていない別フレームでホイールを回しても、ホイールイベントは発生しないようです(MS-Windowsでの使用時)。

これらのコードはMS-Windowsのタッチパネル搭載ノートPCとAndroidの両方でテストして動作することを確認しました。

設定等によってはうまく動かないケースも多々あるかもしれません。