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 "Toggle magnifier" "m" #'my/mag-toggle
|
||||||
:desc "Mag zoom in" "M" #'my/mag-zoom-in
|
:desc "Mag zoom in" "M" #'my/mag-zoom-in
|
||||||
:desc "Mag zoom out" "N" #'my/mag-zoom-out
|
: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
|
;; Tři módy (my/focus-follow-mode):
|
||||||
;; kurzoru. macOS Zoom v "Follow mouse" módu pak sleduje kurzor.
|
;; always — warp po každém příkazu
|
||||||
;; Myš je neviditelná při psaní (make-pointer-invisible) → žádné vizuální
|
;; keyboard — warp jen když se point skutečně posunul
|
||||||
;; rušení. Při pohybu myší se viewport nepohybuje (warp se přeskočí).
|
;; edge — warp jen když kurzor opustí střední 60 % výšky okna
|
||||||
;;
|
;;
|
||||||
;; SETUP (jednorázové nastavení macOS):
|
;; Technické detaily:
|
||||||
;; System Settings → Accessibility → Zoom → Zoom style: Full Screen
|
;; - 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"
|
;; "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 f f toggle focus follow on/off
|
||||||
;; SPC z +/- font scaling (volitelné, pro jemné doladění)
|
;; SPC z f m nastavit mód (always/keyboard/edge)
|
||||||
|
|
||||||
(defvar my/cursor-warp-enabled nil
|
;; --------------- state ---------------
|
||||||
"When non-nil, mouse is warped to text cursor on each keyboard command.")
|
|
||||||
|
|
||||||
;; Hide mouse pointer while typing (standard Emacs feature).
|
(defvar my/focus-follow-enabled nil
|
||||||
(setq make-pointer-invisible t)
|
"When non-nil, mouse is warped to text cursor after each command.")
|
||||||
|
|
||||||
(defun my/last-input-was-mouse-p ()
|
(defvar my/focus-follow-mode 'always
|
||||||
"Return non-nil if last input event was a mouse or scroll event."
|
"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
|
(and last-input-event
|
||||||
(or (mouse-event-p last-input-event)
|
(or (mouse-event-p last-input-event)
|
||||||
(mouse-movement-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
|
'(wheel-up wheel-down wheel-left wheel-right
|
||||||
mouse-4 mouse-5 mouse-6 mouse-7))))))
|
mouse-4 mouse-5 mouse-6 mouse-7))))))
|
||||||
|
|
||||||
(defun my/warp-mouse-to-cursor ()
|
;; --------------- warp decision ---------------
|
||||||
"Move mouse pointer to current text cursor position.
|
|
||||||
Skips if last input was a mouse event (let user pan freely with mouse).
|
|
||||||
|
|
||||||
Uses posn-at-point + window-pixel-edges to get frame-relative coordinates.
|
(defun my/focus-follow--should-warp-p ()
|
||||||
window-absolute-pixel-position is NOT used: on macOS it returns
|
"Return non-nil if warp should fire based on my/focus-follow-mode."
|
||||||
display-absolute coordinates, but set-mouse-pixel-position expects
|
(cond
|
||||||
frame-relative — causing incorrect warps to screen corners."
|
;; always: fire on every keyboard command
|
||||||
(when (and my/cursor-warp-enabled
|
((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)
|
(display-graphic-p)
|
||||||
(not (my/last-input-was-mouse-p))
|
(not (my/focus-follow--mouse-input-p))
|
||||||
(not (window-minibuffer-p (selected-window))))
|
(my/focus-follow--should-warp-p))
|
||||||
(when-let* ((posn (posn-at-point))
|
(when-let* ((pos (my/focus-follow--cursor-pos)))
|
||||||
(xy (posn-x-y posn)))
|
(set-mouse-pixel-position (selected-frame) (car pos) (cdr pos))))
|
||||||
(let* ((edges (window-pixel-edges (selected-window)))
|
;; Always update last-point (used by keyboard mode)
|
||||||
(x (+ (nth 0 edges) (car xy)))
|
(setq my/focus-follow--last-point (point)))
|
||||||
;; 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)))))
|
|
||||||
|
|
||||||
(add-hook 'post-command-hook #'my/warp-mouse-to-cursor)
|
;; --------------- post-command scheduler ---------------
|
||||||
|
|
||||||
(defun my/cursor-warp-toggle ()
|
(defun my/focus-follow--schedule ()
|
||||||
"Toggle macOS Zoom cursor tracking on/off."
|
"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)
|
(interactive)
|
||||||
(setq my/cursor-warp-enabled (not my/cursor-warp-enabled))
|
(setq my/focus-follow-enabled (not my/focus-follow-enabled))
|
||||||
(if my/cursor-warp-enabled
|
(message "Focus follow %s (mode: %s)"
|
||||||
(message "Cursor warp ON — macOS Zoom will follow text cursor")
|
(if my/focus-follow-enabled "ON" "OFF")
|
||||||
(message "Cursor warp 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