refactor: focus follow — idle-timer warp, 3 modes, minibuffer support
This commit is contained in:
159
config.el
159
config.el
@@ -938,36 +938,72 @@ Keeps the status bar and tab bar fully visible at any zoom level.")
|
||||
:desc "Toggle magnifier" "m" #'my/mag-toggle
|
||||
:desc "Mag zoom in" "M" #'my/mag-zoom-in
|
||||
:desc "Mag zoom out" "N" #'my/mag-zoom-out
|
||||
:desc "Cursor warp (macOS Zoom)" "w" #'my/cursor-warp-toggle))
|
||||
(:prefix ("f" . "focus follow")
|
||||
:desc "Toggle focus follow" "f" #'my/focus-follow-toggle
|
||||
:desc "Set mode (always/kbd/edge)" "m" #'my/focus-follow-set-mode)))
|
||||
|
||||
|
||||
;;; ============================================================
|
||||
;;; ACCESSIBILITY — MACOS ZOOM CURSOR TRACKING (SPC z w)
|
||||
;;; ACCESSIBILITY — MACOS ZOOM FOCUS FOLLOW (SPC z f)
|
||||
;;; ============================================================
|
||||
;; Prototype pro macOS Zoom "Follow mouse cursor" mode.
|
||||
;; Po každém příkazu přesune myš na pozici textového kurzoru.
|
||||
;; macOS Zoom v "Follow mouse cursor" módu pak sleduje kurzor.
|
||||
;;
|
||||
;; Princip: po každém klávesovém příkazu přesune myš na pozici textového
|
||||
;; kurzoru. macOS Zoom v "Follow mouse" módu pak sleduje kurzor.
|
||||
;; Myš je neviditelná při psaní (make-pointer-invisible) → žádné vizuální
|
||||
;; rušení. Při pohybu myší se viewport nepohybuje (warp se přeskočí).
|
||||
;; Tři módy (my/focus-follow-mode):
|
||||
;; always — warp po každém příkazu
|
||||
;; keyboard — warp jen když se point skutečně posunul
|
||||
;; edge — warp jen když kurzor opustí střední 60 % výšky okna
|
||||
;;
|
||||
;; SETUP (jednorázové nastavení macOS):
|
||||
;; System Settings → Accessibility → Zoom → Zoom style: Full Screen
|
||||
;; Technické detaily:
|
||||
;; - Warp se spouští přes idle-timer 0 (po redisplayi, ne v post-command)
|
||||
;; → souřadnice jsou přesné i po ccm scroll
|
||||
;; - Souřadnice: pos-visible-in-window-p + window-pixel-edges (frame-relative)
|
||||
;; - Minibuffer: plná podpora (M-x sleduje kurzor do minibufferu)
|
||||
;; - Pending timer se vždy zruší před novým → žádná závodní podmínka
|
||||
;;
|
||||
;; SETUP macOS: System Settings → Accessibility → Zoom → Full Screen
|
||||
;; "When zoomed in, the screen image moves: Continuously with pointer"
|
||||
;; Zoom level: dle potřeby (např. 4-16×)
|
||||
;; Pak zapni SPC z w pro aktivaci cursor trackingu.
|
||||
;;
|
||||
;; SPC z w toggle cursor warp on/off
|
||||
;; SPC z +/- font scaling (volitelné, pro jemné doladění)
|
||||
;; SPC z f f toggle focus follow on/off
|
||||
;; SPC z f m nastavit mód (always/keyboard/edge)
|
||||
|
||||
(defvar my/cursor-warp-enabled nil
|
||||
"When non-nil, mouse is warped to text cursor on each keyboard command.")
|
||||
;; --------------- state ---------------
|
||||
|
||||
;; Hide mouse pointer while typing (standard Emacs feature).
|
||||
(setq make-pointer-invisible t)
|
||||
(defvar my/focus-follow-enabled nil
|
||||
"When non-nil, mouse is warped to text cursor after each command.")
|
||||
|
||||
(defun my/last-input-was-mouse-p ()
|
||||
"Return non-nil if last input event was a mouse or scroll event."
|
||||
(defvar my/focus-follow-mode 'always
|
||||
"How focus follow tracks the cursor.
|
||||
\\='always — warp after every keyboard command
|
||||
\\='keyboard — warp only when point position changed since last command
|
||||
\\='edge — warp only when cursor exits the central 60% of window height")
|
||||
|
||||
(defvar my/focus-follow--last-point nil
|
||||
"Value of (point) after last warp, for keyboard mode.")
|
||||
|
||||
(defvar my/focus-follow--timer nil
|
||||
"Pending idle timer for next warp. Cancelled before each new schedule.")
|
||||
|
||||
;; --------------- coordinate engine ---------------
|
||||
|
||||
(defun my/focus-follow--cursor-pos ()
|
||||
"Return frame-relative (x . y) pixel position of cursor.
|
||||
Uses pos-visible-in-window-p which is reliable on macOS Retina.
|
||||
Returns nil if cursor is not visible in the selected window."
|
||||
(let* ((win (selected-window))
|
||||
(pt (window-point win))
|
||||
(vis (pos-visible-in-window-p pt win t)))
|
||||
(when (and vis (listp vis) (>= (length vis) 2))
|
||||
(let* ((edges (window-pixel-edges win))
|
||||
(x (+ (nth 0 edges) (nth 0 vis)))
|
||||
(y (+ (nth 1 edges) (nth 1 vis)
|
||||
(/ (line-pixel-height) 2))))
|
||||
(cons x y)))))
|
||||
|
||||
;; --------------- input guard ---------------
|
||||
|
||||
(defun my/focus-follow--mouse-input-p ()
|
||||
"Return non-nil if last input event was mouse/scroll (let user pan freely)."
|
||||
(and last-input-event
|
||||
(or (mouse-event-p last-input-event)
|
||||
(mouse-movement-p last-input-event)
|
||||
@@ -976,35 +1012,72 @@ Keeps the status bar and tab bar fully visible at any zoom level.")
|
||||
'(wheel-up wheel-down wheel-left wheel-right
|
||||
mouse-4 mouse-5 mouse-6 mouse-7))))))
|
||||
|
||||
(defun my/warp-mouse-to-cursor ()
|
||||
"Move mouse pointer to current text cursor position.
|
||||
Skips if last input was a mouse event (let user pan freely with mouse).
|
||||
;; --------------- warp decision ---------------
|
||||
|
||||
Uses posn-at-point + window-pixel-edges to get frame-relative coordinates.
|
||||
window-absolute-pixel-position is NOT used: on macOS it returns
|
||||
display-absolute coordinates, but set-mouse-pixel-position expects
|
||||
frame-relative — causing incorrect warps to screen corners."
|
||||
(when (and my/cursor-warp-enabled
|
||||
(defun my/focus-follow--should-warp-p ()
|
||||
"Return non-nil if warp should fire based on my/focus-follow-mode."
|
||||
(cond
|
||||
;; always: fire on every keyboard command
|
||||
((eq my/focus-follow-mode 'always) t)
|
||||
;; keyboard: only when point actually moved
|
||||
((eq my/focus-follow-mode 'keyboard)
|
||||
(not (eq (point) my/focus-follow--last-point)))
|
||||
;; edge: only when cursor exits central 60% of window height
|
||||
((eq my/focus-follow-mode 'edge)
|
||||
(let* ((win (selected-window))
|
||||
(win-h (window-pixel-height win))
|
||||
(vis (pos-visible-in-window-p (window-point win) win t))
|
||||
(y (and vis (listp vis) (nth 1 vis))))
|
||||
(and y (or (< y (* 0.20 win-h))
|
||||
(> y (* 0.80 win-h))))))
|
||||
(t nil)))
|
||||
|
||||
;; --------------- warp execution (called after redisplay) ---------------
|
||||
|
||||
(defun my/focus-follow--do-warp ()
|
||||
"Actually warp mouse to cursor. Called by idle-timer 0 after redisplay."
|
||||
(when (and my/focus-follow-enabled
|
||||
(display-graphic-p)
|
||||
(not (my/last-input-was-mouse-p))
|
||||
(not (window-minibuffer-p (selected-window))))
|
||||
(when-let* ((posn (posn-at-point))
|
||||
(xy (posn-x-y posn)))
|
||||
(let* ((edges (window-pixel-edges (selected-window)))
|
||||
(x (+ (nth 0 edges) (car xy)))
|
||||
;; Place mouse at vertical center of cursor line.
|
||||
(y (+ (nth 1 edges) (cdr xy) (/ (line-pixel-height) 2))))
|
||||
(set-mouse-pixel-position (selected-frame) x y)))))
|
||||
(not (my/focus-follow--mouse-input-p))
|
||||
(my/focus-follow--should-warp-p))
|
||||
(when-let* ((pos (my/focus-follow--cursor-pos)))
|
||||
(set-mouse-pixel-position (selected-frame) (car pos) (cdr pos))))
|
||||
;; Always update last-point (used by keyboard mode)
|
||||
(setq my/focus-follow--last-point (point)))
|
||||
|
||||
(add-hook 'post-command-hook #'my/warp-mouse-to-cursor)
|
||||
;; --------------- post-command scheduler ---------------
|
||||
|
||||
(defun my/cursor-warp-toggle ()
|
||||
"Toggle macOS Zoom cursor tracking on/off."
|
||||
(defun my/focus-follow--schedule ()
|
||||
"Schedule a warp after the next redisplay.
|
||||
Called from post-command-hook; the actual warp fires via idle-timer 0
|
||||
so that pos-visible-in-window-p returns post-redisplay coordinates."
|
||||
(when (and my/focus-follow-enabled
|
||||
(display-graphic-p)
|
||||
(not (my/focus-follow--mouse-input-p)))
|
||||
(when my/focus-follow--timer
|
||||
(cancel-timer my/focus-follow--timer))
|
||||
(setq my/focus-follow--timer
|
||||
(run-with-idle-timer 0 nil #'my/focus-follow--do-warp))))
|
||||
|
||||
(add-hook 'post-command-hook #'my/focus-follow--schedule)
|
||||
|
||||
;; --------------- interactive commands ---------------
|
||||
|
||||
(defun my/focus-follow-toggle ()
|
||||
"Toggle macOS Zoom focus follow on/off."
|
||||
(interactive)
|
||||
(setq my/cursor-warp-enabled (not my/cursor-warp-enabled))
|
||||
(if my/cursor-warp-enabled
|
||||
(message "Cursor warp ON — macOS Zoom will follow text cursor")
|
||||
(message "Cursor warp OFF")))
|
||||
(setq my/focus-follow-enabled (not my/focus-follow-enabled))
|
||||
(message "Focus follow %s (mode: %s)"
|
||||
(if my/focus-follow-enabled "ON" "OFF")
|
||||
my/focus-follow-mode))
|
||||
|
||||
(defun my/focus-follow-set-mode (mode)
|
||||
"Set focus follow MODE (always / keyboard / edge)."
|
||||
(interactive
|
||||
(list (intern (completing-read "Focus follow mode: "
|
||||
'("always" "keyboard" "edge") nil t))))
|
||||
(setq my/focus-follow-mode mode)
|
||||
(message "Focus follow mode → %s" mode))
|
||||
|
||||
|
||||
;;; ============================================================
|
||||
|
||||
Reference in New Issue
Block a user