refactor: cursor tracking redesign based on research; clean SPC z
This commit is contained in:
289
config.el
289
config.el
@@ -813,117 +813,55 @@ Keeps the status bar and tab bar fully visible at any zoom level.")
|
||||
(setq my/zoom-steps my/zoom-saved-steps
|
||||
my/zoom-saved-steps nil)))
|
||||
|
||||
(defun my/zoom-readable ()
|
||||
"Přepne na čitelný zoom preset (32pt ≈ step +2)."
|
||||
(interactive)
|
||||
(setq my/zoom-steps 2)
|
||||
(my/zoom--apply my/zoom-steps))
|
||||
|
||||
|
||||
;;; ============================================================
|
||||
;;; ACCESSIBILITY — SPLIT-SCREEN MAGNIFIER (SPC z m)
|
||||
;;; ACCESSIBILITY — MACOS ZOOM CURSOR TRACKING (SPC z t)
|
||||
;;; ============================================================
|
||||
;; Dual-view: hlavní okno (normální font) + magnified okno (zvětšený).
|
||||
;; Indirect buffer sdílí obsah, ale má vlastní text-scale.
|
||||
;; Cursor pozice se synchronizuje přes post-command-hook.
|
||||
;; Warps mouse pointer to text cursor so macOS Zoom ("Follow mouse cursor")
|
||||
;; tracks editing position. Uses window-absolute-pixel-position (Emacs 26+)
|
||||
;; paired with set-mouse-absolute-pixel-position — no manual coordinate math.
|
||||
;;
|
||||
;; Debounced via run-with-idle-timer 0.05s: rapid j/k spam produces one warp.
|
||||
;; CCM compatible: idle timer fires after ccm recenter + redisplay.
|
||||
;;
|
||||
;; SETUP macOS: System Settings → Accessibility → Zoom → Full Screen
|
||||
;; "When zoomed in, the screen image moves: Continuously with pointer"
|
||||
;;
|
||||
;; SPC z t toggle cursor tracking on/off
|
||||
|
||||
(defvar my/mag--buffer nil "Indirect buffer pro magnified view.")
|
||||
(defvar my/mag--source nil "Source buffer pro magnifier.")
|
||||
(defvar my/mag--active nil "Je magnifier aktivní?")
|
||||
(defvar my/mag--zoom-level 4
|
||||
"Zoom level pro magnified view (text-scale steps). 4 ≈ 2.3× zvětšení.")
|
||||
(defvar my/warp-timer nil "Debounce timer for cursor warp.")
|
||||
|
||||
(defun my/mag-toggle ()
|
||||
"Toggle split-screen magnifier. Vytvoří/zruší zvětšené okno vpravo."
|
||||
(interactive)
|
||||
(if my/mag--active
|
||||
(my/mag--disable)
|
||||
(my/mag--enable)))
|
||||
(defun my/warp-mouse-to-cursor ()
|
||||
"Schedule debounced mouse warp to current cursor position."
|
||||
(when my/warp-timer (cancel-timer my/warp-timer))
|
||||
(setq my/warp-timer
|
||||
(run-with-idle-timer 0.05 nil
|
||||
(lambda ()
|
||||
(setq my/warp-timer nil)
|
||||
(when (display-graphic-p)
|
||||
(when-let ((pos (window-absolute-pixel-position)))
|
||||
(set-mouse-absolute-pixel-position (car pos) (cdr pos))))))))
|
||||
|
||||
(defun my/mag--enable ()
|
||||
"Zapni magnified split view pro aktuální buffer."
|
||||
(let* ((src (current-buffer))
|
||||
(mag-name (format "*mag:%s*" (buffer-name src)))
|
||||
(mag (or (get-buffer mag-name)
|
||||
(make-indirect-buffer src mag-name t))))
|
||||
(setq my/mag--buffer mag
|
||||
my/mag--source src
|
||||
my/mag--active t)
|
||||
(with-current-buffer mag
|
||||
(text-scale-set my/mag--zoom-level)
|
||||
(setq-local display-line-numbers nil))
|
||||
(split-window-right (floor (* 0.6 (window-width))))
|
||||
(save-selected-window
|
||||
(other-window 1)
|
||||
(switch-to-buffer mag)
|
||||
(goto-char (with-current-buffer src (point)))
|
||||
(recenter))
|
||||
(add-hook 'post-command-hook #'my/mag--sync)
|
||||
(add-hook 'kill-buffer-hook #'my/mag--on-kill nil t)
|
||||
(message "Magnifier ON (zoom +%d)" my/mag--zoom-level)))
|
||||
(defun my/refresh-frame-position ()
|
||||
"Workaround for bug#71912: stale frame position after sleep/fullscreen."
|
||||
(when (display-graphic-p)
|
||||
(ignore-errors
|
||||
(let ((p (frame-position)))
|
||||
(set-frame-position (selected-frame) (car p) (cdr p))))))
|
||||
|
||||
(defun my/mag--disable ()
|
||||
"Vypni magnifier a zavři magnified okno."
|
||||
(remove-hook 'post-command-hook #'my/mag--sync)
|
||||
(when (and my/mag--buffer (buffer-live-p my/mag--buffer))
|
||||
(when-let ((win (get-buffer-window my/mag--buffer)))
|
||||
(delete-window win))
|
||||
(kill-buffer my/mag--buffer))
|
||||
(setq my/mag--buffer nil
|
||||
my/mag--source nil
|
||||
my/mag--active nil)
|
||||
(message "Magnifier OFF"))
|
||||
(define-minor-mode my/cursor-zoom-mode
|
||||
"Warp mouse to text cursor for macOS Zoom accessibility tracking."
|
||||
:global t
|
||||
(if my/cursor-zoom-mode
|
||||
(progn
|
||||
(add-hook 'post-command-hook #'my/warp-mouse-to-cursor)
|
||||
(add-hook 'window-size-change-functions
|
||||
(lambda (_) (my/refresh-frame-position)))
|
||||
(run-with-timer 60 60 #'my/refresh-frame-position))
|
||||
(remove-hook 'post-command-hook #'my/warp-mouse-to-cursor)))
|
||||
|
||||
(defun my/mag--on-kill ()
|
||||
"Cleanup když se zavře source buffer."
|
||||
(when (and my/mag--active
|
||||
(eq (current-buffer) my/mag--source))
|
||||
(my/mag--disable)))
|
||||
|
||||
(defun my/mag--sync ()
|
||||
"Synchronizuj pozici kurzoru v magnified view."
|
||||
(when (and my/mag--active
|
||||
my/mag--buffer
|
||||
(buffer-live-p my/mag--buffer)
|
||||
my/mag--source
|
||||
(eq (current-buffer) my/mag--source))
|
||||
(let ((pos (point)))
|
||||
(when-let ((win (get-buffer-window my/mag--buffer)))
|
||||
(with-selected-window win
|
||||
(goto-char pos)
|
||||
(recenter))))))
|
||||
|
||||
(defun my/mag--follow-buffer ()
|
||||
"Přepni magnifier na nový buffer když uživatel změní aktivní buffer."
|
||||
(when (and my/mag--active
|
||||
(not (eq (current-buffer) my/mag--source))
|
||||
(not (minibufferp))
|
||||
(not (string-prefix-p " " (buffer-name)))
|
||||
(not (string-prefix-p "*mag:" (buffer-name))))
|
||||
(my/mag--disable)
|
||||
(my/mag--enable)))
|
||||
|
||||
(add-hook 'window-selection-change-functions
|
||||
(lambda (_frame) (when my/mag--active
|
||||
(run-with-idle-timer 0.1 nil #'my/mag--follow-buffer))))
|
||||
|
||||
(defun my/mag-zoom-in ()
|
||||
"Zvětši zoom magnified view."
|
||||
(interactive)
|
||||
(cl-incf my/mag--zoom-level)
|
||||
(when (and my/mag--buffer (buffer-live-p my/mag--buffer))
|
||||
(with-current-buffer my/mag--buffer
|
||||
(text-scale-set my/mag--zoom-level))
|
||||
(message "Mag zoom: +%d" my/mag--zoom-level)))
|
||||
|
||||
(defun my/mag-zoom-out ()
|
||||
"Zmenši zoom magnified view."
|
||||
(interactive)
|
||||
(cl-decf my/mag--zoom-level)
|
||||
(when (and my/mag--buffer (buffer-live-p my/mag--buffer))
|
||||
(with-current-buffer my/mag--buffer
|
||||
(text-scale-set my/mag--zoom-level))
|
||||
(message "Mag zoom: +%d" my/mag--zoom-level)))
|
||||
;; Enable by default
|
||||
(my/cursor-zoom-mode 1)
|
||||
|
||||
;; --------------- keybindings ---------------
|
||||
|
||||
@@ -934,150 +872,7 @@ Keeps the status bar and tab bar fully visible at any zoom level.")
|
||||
:desc "Zoom out (÷1.5)" "-" #'my/zoom-out
|
||||
:desc "Reset na výchozí" "0" #'my/zoom-reset
|
||||
:desc "Restore předchozí" "z" #'my/zoom-restore
|
||||
:desc "Readable (32pt)" "r" #'my/zoom-readable
|
||||
: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
|
||||
(: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 FOCUS FOLLOW (SPC z f)
|
||||
;;; ============================================================
|
||||
;; 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.
|
||||
;;
|
||||
;; 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
|
||||
;;
|
||||
;; 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"
|
||||
;;
|
||||
;; SPC z f f toggle focus follow on/off
|
||||
;; SPC z f m nastavit mód (always/keyboard/edge)
|
||||
|
||||
;; --------------- state ---------------
|
||||
|
||||
(defvar my/focus-follow-enabled nil
|
||||
"When non-nil, mouse is warped to text cursor after each command.")
|
||||
|
||||
(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)
|
||||
(and (listp last-input-event)
|
||||
(memq (car last-input-event)
|
||||
'(wheel-up wheel-down wheel-left wheel-right
|
||||
mouse-4 mouse-5 mouse-6 mouse-7))))))
|
||||
|
||||
;; --------------- warp decision ---------------
|
||||
|
||||
(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/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)))
|
||||
|
||||
;; --------------- post-command scheduler ---------------
|
||||
|
||||
(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/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))
|
||||
:desc "Toggle cursor track" "t" #'my/cursor-zoom-mode))
|
||||
|
||||
|
||||
;;; ============================================================
|
||||
|
||||
Reference in New Issue
Block a user