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
|
(setq my/zoom-steps my/zoom-saved-steps
|
||||||
my/zoom-saved-steps nil)))
|
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ý).
|
;; Warps mouse pointer to text cursor so macOS Zoom ("Follow mouse cursor")
|
||||||
;; Indirect buffer sdílí obsah, ale má vlastní text-scale.
|
;; tracks editing position. Uses window-absolute-pixel-position (Emacs 26+)
|
||||||
;; Cursor pozice se synchronizuje přes post-command-hook.
|
;; 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/warp-timer nil "Debounce timer for cursor warp.")
|
||||||
(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í.")
|
|
||||||
|
|
||||||
(defun my/mag-toggle ()
|
(defun my/warp-mouse-to-cursor ()
|
||||||
"Toggle split-screen magnifier. Vytvoří/zruší zvětšené okno vpravo."
|
"Schedule debounced mouse warp to current cursor position."
|
||||||
(interactive)
|
(when my/warp-timer (cancel-timer my/warp-timer))
|
||||||
(if my/mag--active
|
(setq my/warp-timer
|
||||||
(my/mag--disable)
|
(run-with-idle-timer 0.05 nil
|
||||||
(my/mag--enable)))
|
(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 ()
|
(defun my/refresh-frame-position ()
|
||||||
"Zapni magnified split view pro aktuální buffer."
|
"Workaround for bug#71912: stale frame position after sleep/fullscreen."
|
||||||
(let* ((src (current-buffer))
|
(when (display-graphic-p)
|
||||||
(mag-name (format "*mag:%s*" (buffer-name src)))
|
(ignore-errors
|
||||||
(mag (or (get-buffer mag-name)
|
(let ((p (frame-position)))
|
||||||
(make-indirect-buffer src mag-name t))))
|
(set-frame-position (selected-frame) (car p) (cdr p))))))
|
||||||
(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/mag--disable ()
|
(define-minor-mode my/cursor-zoom-mode
|
||||||
"Vypni magnifier a zavři magnified okno."
|
"Warp mouse to text cursor for macOS Zoom accessibility tracking."
|
||||||
(remove-hook 'post-command-hook #'my/mag--sync)
|
:global t
|
||||||
(when (and my/mag--buffer (buffer-live-p my/mag--buffer))
|
(if my/cursor-zoom-mode
|
||||||
(when-let ((win (get-buffer-window my/mag--buffer)))
|
(progn
|
||||||
(delete-window win))
|
(add-hook 'post-command-hook #'my/warp-mouse-to-cursor)
|
||||||
(kill-buffer my/mag--buffer))
|
(add-hook 'window-size-change-functions
|
||||||
(setq my/mag--buffer nil
|
(lambda (_) (my/refresh-frame-position)))
|
||||||
my/mag--source nil
|
(run-with-timer 60 60 #'my/refresh-frame-position))
|
||||||
my/mag--active nil)
|
(remove-hook 'post-command-hook #'my/warp-mouse-to-cursor)))
|
||||||
(message "Magnifier OFF"))
|
|
||||||
|
|
||||||
(defun my/mag--on-kill ()
|
;; Enable by default
|
||||||
"Cleanup když se zavře source buffer."
|
(my/cursor-zoom-mode 1)
|
||||||
(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)))
|
|
||||||
|
|
||||||
;; --------------- keybindings ---------------
|
;; --------------- 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 "Zoom out (÷1.5)" "-" #'my/zoom-out
|
||||||
:desc "Reset na výchozí" "0" #'my/zoom-reset
|
:desc "Reset na výchozí" "0" #'my/zoom-reset
|
||||||
:desc "Restore předchozí" "z" #'my/zoom-restore
|
:desc "Restore předchozí" "z" #'my/zoom-restore
|
||||||
:desc "Readable (32pt)" "r" #'my/zoom-readable
|
:desc "Toggle cursor track" "t" #'my/cursor-zoom-mode))
|
||||||
: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))
|
|
||||||
|
|
||||||
|
|
||||||
;;; ============================================================
|
;;; ============================================================
|
||||||
|
|||||||
Reference in New Issue
Block a user