;;; $DOOMDIR/config.el -*- lexical-binding: t; -*- ;;; ============================================================ ;;; USER IDENTITY ;;; ============================================================ (setq user-full-name "Martin Sukany" user-mail-address "martin@sukany.cz") ;;; ============================================================ ;;; THEME & FONT ;;; ============================================================ (setq doom-theme 'modus-vivendi-deuteranopia doom-variable-pitch-font nil) ;; Font: JetBrains Mono preferred; fallback to Menlo (always on macOS) ;; Install: brew install --cask font-jetbrains-mono (setq doom-font (if (find-font (font-spec :name "JetBrains Mono")) (font-spec :family "JetBrains Mono" :size 14) (font-spec :family "Menlo" :size 14))) (setq display-line-numbers-type t) ;;; ============================================================ ;;; UI & DISPLAY ;;; ============================================================ (setq doom-modeline-refresh-rate 1.0) (setq which-key-idle-delay 0.8 which-key-idle-secondary-delay 0.05) ;; Centered cursor mode — safe with macOS Zoom set to "Follow mouse cursor" ;; (NOT "Follow keyboard focus" — that causes viewport jumping) (use-package! centered-cursor-mode :config (setq ccm-vpos-init 0.5 ; cursor uprostřed obrazovky ccm-step-size 2 ; plynulejší scroll ccm-recenter-at-end-of-file t) ;; Vypnout v terminálu a speciálních módech (define-globalized-minor-mode my/global-ccm centered-cursor-mode (lambda () (unless (memq major-mode '(vterm-mode eshell-mode term-mode treemacs-mode pdf-view-mode)) (centered-cursor-mode 1)))) (my/global-ccm +1)) ;;; ============================================================ ;;; MACOS / PLATFORM ;;; ============================================================ (setq mouse-autoselect-window t focus-follows-mouse t select-enable-clipboard t select-enable-primary t inhibit-splash-screen t) ;; PATH: add MacTeX binaries (setenv "PATH" (concat "/Library/TeX/texbin:" (getenv "PATH"))) (add-to-list 'exec-path "/Library/TeX/texbin") ;; macOS clipboard integration via pbcopy/pbpaste (works in terminal Emacs too) (defun my/pbcopy (text &optional _push) "Send TEXT to the macOS clipboard using pbcopy." (let ((process-connection-type nil)) (let ((proc (start-process "pbcopy" "*pbcopy*" "pbcopy"))) (process-send-string proc text) (process-send-eof proc)))) (defun my/pbpaste () "Return text from the macOS clipboard using pbpaste." (when (executable-find "pbpaste") (string-trim-right (shell-command-to-string "pbpaste")))) (setq interprogram-cut-function #'my/pbcopy interprogram-paste-function #'my/pbpaste) ;; Let Evil use the system clipboard (y/d/c go to system) (after! evil (setq evil-want-clipboard t)) ;; macOS Zoom accessibility — cancel persp-mode's 2.5s cache timer after startup ;; (reduces unnecessary redraws that cause Zoom to jump) (run-with-timer 3 nil (lambda () (when (and (boundp 'persp-frame-buffer-predicate-buffer-list-cache--timer) (timerp persp-frame-buffer-predicate-buffer-list-cache--timer)) (cancel-timer persp-frame-buffer-predicate-buffer-list-cache--timer) (setq persp-frame-buffer-predicate-buffer-list-cache--timer nil) (message "persp-mode 2.5s cache timer cancelled for Zoom accessibility")))) ;;; ============================================================ ;;; MACOS GUI — FIXES ;;; ============================================================ ;; Fix A: Ensure dashboard buffer starts in normal state (required for SPC leader) (after! evil (evil-set-initial-state '+doom-dashboard-mode 'normal)) ;; Fix B: Standard macOS modifier keys for GUI Emacs (when (display-graphic-p) (setq mac-command-modifier 'super mac-option-modifier 'meta mac-right-option-modifier 'none)) ;;; ============================================================ ;;; PERFORMANCE & GC ;;; ============================================================ (setq gc-cons-threshold (* 100 1024 1024) ; 100 MB gc-cons-percentage 0.6) ;; GCMH — Doom's GC manager; increase idle delay to reduce redraws (after! gcmh (setq gcmh-idle-delay 'auto gcmh-auto-idle-delay-factor 20 gcmh-high-cons-threshold (* 200 1024 1024))) ; 200 MB (add-hook 'focus-out-hook #'garbage-collect) ;; Auto-save all buffers on idle (replaces noisy #file# autosave) (setq auto-save-default nil) (defun my/save-all-buffers () (save-some-buffers t)) (run-with-idle-timer 10 t #'my/save-all-buffers) ;; !!! WARNING: TLS verification disabled globally !!! ;; Required for self-signed certs on local services (ai.apps.sukany.cz etc.) (setq gnutls-verify-error nil gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3") ;;; ============================================================ ;;; ORG MODE — CORE ;;; ============================================================ (after! org (require 'ox-hugo) (setq org-directory "~/org/") (setq org-default-notes-file (expand-file-name "inbox.org" org-directory)) ;; Helper: return absolute path to a file inside org-directory (defun ms/org-file (name) "Return absolute path to NAME inside `org-directory`." (expand-file-name name org-directory)) (setq org-todo-keywords '((sequence "TODO(t)" "NEXT(n)" "WAIT(w@/!)" "|" "DONE(d!)" "CANCELLED(c@)"))) (setq org-log-done 'time) (setq org-refile-targets '((org-agenda-files :maxlevel . 5)) org-outline-path-complete-in-steps nil org-refile-use-outline-path 'file) ;; Return path to project.org in current Projectile project, if it exists (defun my/project-org-file () "Return path to ./project.org in current Projectile project, if it exists." (when-let ((root (projectile-project-root))) (let ((f (expand-file-name "project.org" root))) (when (file-exists-p f) f)))) ;; Update all dynamic blocks before export (add-hook 'org-export-before-processing-hook (lambda (_backend) (org-update-all-dblocks))) ;; Restore window layout after capture quit (setq org-capture-restore-window-after-quit t)) ;;; ============================================================ ;;; ORG MODE — CAPTURE ;;; ============================================================ (after! org (setq org-capture-templates `(("i" "Inbox task" entry (file ,(ms/org-file "inbox.org")) "* TODO %?\n%U\n%a\n") ("n" "Note" entry (file+headline ,(ms/org-file "inbox.org") "Notes") "* %?\n%U\n%a\n") ("p" "Project task" entry (file ,(ms/org-file "inbox.org")) "* TODO %? :project:\n%U\n%a\n") ("s" "Clocked subtask" entry (clock) "* TODO %?\n%U\n%a\n%i" :empty-lines 1) ("j" "Journal" entry (file+olp+datetree ,(ms/org-file "journal.org")) "\n* %<%I:%M %p> - Journal :journal:\n\n%?\n\n" :clock-in :clock-resume :empty-lines 1) ("m" "Meeting" entry (file+olp+datetree ,(ms/org-file "journal.org")) "* %<%I:%M %p> - %^{Meeting title} :meetings:\nContext: %a\n\n%?\n\n" :clock-in :clock-resume :empty-lines 1) ("e" "Checking Email" entry (file+olp+datetree ,(ms/org-file "journal.org")) "* Checking Email :email:\n\n%?" :clock-in :clock-resume :empty-lines 1) ("w" "Weight" table-line (file+headline ,(ms/org-file "metrics.org") "Weight") "| %U | %^{Weight} | %^{Notes} |" :kill-buffer t)))) ;;; ============================================================ ;;; ORG MODE — AGENDA ;;; ============================================================ (after! org (setq org-agenda-files (list org-directory (expand-file-name "projects" org-directory) (expand-file-name "roam" org-directory) (expand-file-name "notes" org-directory)))) ;;; ============================================================ ;;; ORG MODE — LATEX EXPORT ;;; ============================================================ ;; Count data columns in an Org table line (defun my/org-count-table-columns (line) "Count the number of data columns in Org table LINE." (length (cl-remove-if (lambda (s) (string-match-p "^-*$" (string-trim s))) (cdr (butlast (split-string line "|")))))) ;; Generate tabularx column spec: first column left-aligned, rest Y (auto-width) (defun my/org-table-attr-latex-spec (ncols) "Return tabularx column spec for NCOLS columns: first l, rest Y." (concat "l" (make-string (max 0 (1- ncols)) ?Y))) ;; Automatically insert #+ATTR_LATEX tabularx before tables on LaTeX export (defun my/org-auto-tabularx (backend) "Insert #+ATTR_LATEX tabularx before each table when exporting to LaTeX." (when (org-export-derived-backend-p backend 'latex) (save-excursion (goto-char (point-min)) (while (not (eobp)) (cond ((looking-at "^|") (let ((prev-line (save-excursion (forward-line -1) (buffer-substring-no-properties (line-beginning-position) (line-end-position))))) (when (not (string-match-p "^|" prev-line)) (when (not (string-match-p "^#\\+ATTR_LATEX" prev-line)) (let* ((table-line (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (ncols (my/org-count-table-columns table-line)) (spec (my/org-table-attr-latex-spec ncols)) (attr (format "#+ATTR_LATEX: :environment tabularx :width \\textwidth :align %s\n" spec))) (when (> ncols 0) (insert attr))))) (forward-line)) (t (forward-line)))))))) (add-hook 'org-export-before-processing-hook #'my/org-auto-tabularx) ;; Optional: enable booktabs style (horizontal rules in tables) ;; (setq org-latex-tables-booktabs t) ;;; ============================================================ ;;; ORG MODE — CUSTOM BEHAVIOR ;;; ============================================================ ;; Org agenda: position cursor at task name (after TODO keyword and priority) ;; Works with n/p (or j/k in evil mode) — skips TODO keyword and [#A] priority. (defun my/org-agenda-goto-task-name (&rest _) "Move cursor to the task name on the current org-agenda line. Skips past the TODO keyword and optional priority indicator [#A]." (when (get-text-property (line-beginning-position) 'org-hd-marker) (beginning-of-line) (let* ((bol (point)) (eol (line-end-position)) (todo-end nil) (pos bol)) ;; Find end of TODO keyword by face (org-todo or org-agenda-done) (while (< pos eol) (let* ((face (get-text-property pos 'face)) (next (or (next-single-property-change pos 'face nil eol) eol))) (when (and face (or (and (symbolp face) (memq face '(org-todo org-agenda-done))) (and (listp face) (cl-intersection face '(org-todo org-agenda-done))))) (setq todo-end next)) (setq pos next))) ;; Move past TODO keyword and optional priority [#X] (when todo-end (goto-char todo-end) (skip-chars-forward " \t") (when (looking-at "\\[#.\\][ \t]+") (goto-char (match-end 0))))))) (advice-add 'org-agenda-next-line :after #'my/org-agenda-goto-task-name) (advice-add 'org-agenda-previous-line :after #'my/org-agenda-goto-task-name) ;;; ============================================================ ;;; GPTEL — AI INTEGRATION (OpenWebUI / OpenRouter) ;;; ============================================================ (use-package! gptel :config ;; API key from environment variable (no secrets in config) (defun my/openwebui-key () (or (getenv "OPENWEBUI_API_KEY") (user-error "Missing OPENWEBUI_API_KEY env var"))) ;; Fetch available models from OpenWebUI /api/models (defun my/openwebui-fetch-model-ids () "Return list of model ids from OpenWebUI /api/models." (require 'url) (require 'json) (let* ((url-request-method "GET") (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " (funcall #'my/openwebui-key)))))) (with-current-buffer (url-retrieve-synchronously "https://ai.apps.sukany.cz/api/models" t t 15) (goto-char (point-min)) (re-search-forward "\n\n" nil 'move) (let* ((json-object-type 'alist) (json-array-type 'list) (json-key-type 'symbol) (obj (json-read)) (data (alist-get 'data obj)) (ids (delq nil (mapcar (lambda (it) (alist-get 'id it)) data)))) (kill-buffer (current-buffer)) ids)))) (defvar my/openwebui-models-cache nil) (defun my/openwebui-models () "Return cached list of model ids; falls back to a minimal list on failure." (or my/openwebui-models-cache (setq my/openwebui-models-cache (condition-case err (my/openwebui-fetch-model-ids) (error (message "OpenWebUI models fetch failed: %s" err) '("openai/gpt-4o-mini" "openai/gpt-4.1-mini")))))) (defun my/openwebui-refresh-models () "Clear model cache and refetch from OpenWebUI." (interactive) (setq my/openwebui-models-cache nil) (message "OpenWebUI models refreshed: %d" (length (my/openwebui-models)))) ;; Register OpenWebUI as an OpenAI-compatible backend (setq gptel-backend (gptel-make-openai "OpenWebUI" :host "ai.apps.sukany.cz" :protocol "https" :key #'my/openwebui-key :endpoint "/api/chat/completions" :stream t :curl-args '("--http1.1") :models (my/openwebui-models))) ;; Default model: prefer gpt-5-mini, fall back to first available (let* ((models (my/openwebui-models)) (preferred "openai/gpt-5-mini")) (setq gptel-model (if (member preferred models) preferred (car models)))) ;; Presets for quick task-specific model switching (gptel-make-preset 'fast :description "Default (fast/cheap) — everyday work" :backend "OpenWebUI" :model "openai/gpt-4o-mini" :system "Reply in Czech. Be specific and step-by-step. No fluff." :temperature 0.2) (gptel-make-preset 'coding :description "Code / refactor / review" :backend "OpenWebUI" :model "openai/gpt-4.1-mini" :system "You are a strict code reviewer. Propose concrete changes and flag risks." :temperature 0.1) (gptel-make-preset 'deep :description "Complex analysis / architecture" :backend "OpenWebUI" :model "openai/gpt-4.1" :system "Work systematically. Provide alternatives, tradeoffs, and a recommendation." :temperature 0.2)) ;; CLI helper: call gptel from emacs --batch (defun my/gptel-cli (prompt &optional model system) "Send PROMPT via gptel and print response to stdout." (require 'gptel) (let* ((done nil) (result nil) (gptel-model (or model gptel-model)) (gptel--system-message (or system gptel--system-message))) (gptel-request prompt :callback (lambda (response _info) (setq result response) (setq done t))) (while (not done) (accept-process-output nil 0.05)) (princ result))) ;; GPTel keybindings under SPC o g (after! gptel (map! :leader (:prefix ("o g" . "GPTel") :desc "Send (region or buffer)" "s" #'gptel-send :desc "Menu (model/scope/preset)" "m" #'gptel-menu :desc "Chat buffer" "c" #'gptel :desc "Abort request" "x" #'gptel-abort :desc "Refresh OpenWebUI models" "R" #'my/openwebui-refresh-models))) ;;; ============================================================ ;;; COMPLETION — CORFU + CAPE ;;; ============================================================ (after! corfu (setq corfu-auto t corfu-auto-delay 0.15 corfu-auto-prefix 2 corfu-cycle t corfu-preselect 'prompt corfu-quit-no-match 'separator corfu-preview-current nil) (global-corfu-mode)) ;; Cape: additional completion-at-point sources (use-package! cape :after corfu :config (defun martin/cape-capf-setup () "Set up cape completion sources for prog-mode and text-mode." (add-to-list 'completion-at-point-functions #'cape-dabbrev 0) ; words from buffers (add-to-list 'completion-at-point-functions #'cape-file 0) ; file paths (add-to-list 'completion-at-point-functions #'cape-keyword 0) ; language keywords (add-to-list 'completion-at-point-functions #'cape-elisp-symbol 0)) (add-hook 'prog-mode-hook #'martin/cape-capf-setup) (add-hook 'text-mode-hook #'martin/cape-capf-setup)) ;; Corfu popup in terminal (iTerm2 / SSH / tmux) (use-package! corfu-terminal :when (not (display-graphic-p)) :after corfu :config (corfu-terminal-mode +1)) ;;; ============================================================ ;;; EMAIL — MU4E ;;; ============================================================ (add-to-list 'load-path (expand-file-name "/opt/homebrew/opt/mu/share/emacs/site-lisp/mu/mu4e")) (after! mu4e (setq mu4e-maildir "~/.mail" mu4e-get-mail-command "mbsync personal" mu4e-update-interval 300 mu4e-change-filenames-when-moving t mu4e-view-show-images t mu4e-sent-folder "/personal/Sent" mu4e-drafts-folder "/personal/Drafts" mu4e-trash-folder "/personal/Trash" mu4e-refile-folder "/personal/Archive" mu4e-headers-show-threads t mu4e-headers-include-related t mu4e-use-fancy-chars t mu4e-headers-mark-for-thread t mu4e-headers-fields '((:human-date . 12) (:flags . 6) (:from . 22) (:subject)))) (after! mu4e (setq sendmail-program "msmtp" message-send-mail-function #'message-send-mail-with-sendmail mail-specify-envelope-from t message-sendmail-envelope-from 'header)) ;;; ============================================================ ;;; RSS — ELFEED ;;; ============================================================ (map! :leader :desc "Elfeed" "o r" #'elfeed) (after! org (setq rmh-elfeed-org-files (list (expand-file-name "elfeed.org" org-directory)))) (after! elfeed (require 'elfeed-org) (elfeed-org)) ;;; ============================================================ ;;; PLANTUML ;;; ============================================================ (add-to-list 'auto-mode-alist '("\\.puml\\'" . plantuml-mode)) (add-to-list 'auto-mode-alist '("\\.plantuml\\'" . plantuml-mode)) (after! plantuml-mode (setq plantuml-default-exec-mode 'server plantuml-server-url "https://www.plantuml.com/plantuml" plantuml-output-type "svg" plantuml-verbose t)) (defun my/plantuml-encode-hex (text) "Encode TEXT using PlantUML HEX encoding (~h + hex(UTF-8 bytes))." (let* ((utf8 (encode-coding-string text 'utf-8 t))) (concat "~h" (apply #'concat (mapcar (lambda (b) (format "%02x" b)) (append utf8 nil)))))) (defun my/plantuml-fix-png-header (file) "Strip any bytes before the PNG signature in FILE." (let ((sig (unibyte-string #x89 ?P ?N ?G ?\r ?\n #x1a ?\n))) (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-literally file) (goto-char (point-min)) (unless (looking-at (regexp-quote sig)) (let ((pos (search-forward sig nil t))) (unless pos (user-error "PNG signature not found")) (delete-region (point-min) (- pos (length sig))) (let ((coding-system-for-write 'binary)) (write-region (point-min) (point-max) file nil 'silent))))))) (defun my/plantuml-render-server (type) "Render current .puml buffer via PlantUML server to TYPE (png or svg)." (interactive (list (completing-read "Type: " '("png" "svg") nil t "png"))) (unless buffer-file-name (user-error "Open .puml as a file first")) (let* ((text (buffer-substring-no-properties (point-min) (point-max))) (encoded (my/plantuml-encode-hex text)) (server (string-remove-suffix "/" plantuml-server-url)) (url (format "%s/%s/%s" server type encoded)) (out (concat (file-name-sans-extension buffer-file-name) "." type))) (url-copy-file url out t) (when (string-equal type "png") (my/plantuml-fix-png-header out)) (message "PlantUML saved: %s" out) out)) (after! plantuml-mode (define-key plantuml-mode-map (kbd "C-c C-p") (lambda () (interactive) (my/plantuml-render-server "png"))) (define-key plantuml-mode-map (kbd "C-c C-s") (lambda () (interactive) (my/plantuml-render-server "svg")))) ;;; ============================================================ ;;; TRAMP & REMOTE ;;; ============================================================ (after! tramp (setq projectile-git-command "git ls-files -zco --exclude-standard" projectile-indexing-method 'alien)) ;; Disable VC and Projectile over TRAMP — main cause of hangs (setq vc-ignore-dir-regexp (format "%s\\|%s" vc-ignore-dir-regexp tramp-file-name-regexp)) (defadvice projectile-project-root (around ignore-remote first activate) (unless (file-remote-p default-directory) ad-do-it)) (setq remote-file-name-inhibit-cache nil tramp-verbose 1) ;;; ============================================================ ;;; DIRED ;;; ============================================================ (after! dired (put 'dired-find-alternate-file 'disabled nil) (map! :map dired-mode-map "RET" #'dired-find-alternate-file "^" #'dired-up-directory)) ;;; ============================================================ ;;; PROJECTILE ;;; ============================================================ (after! projectile (setq projectile-enable-caching nil projectile-indexing-method 'alien) (when (executable-find "fd") (setq projectile-generic-command "fd . -0 --type f --hidden --follow --exclude .git --color=never"))) ;;; ============================================================ ;;; PYTHON ;;; ============================================================ (setq python-shell-interpreter "python3") (after! org (setq org-babel-python-command "python3") (require 'ob-python)) ;;; ============================================================ ;;; ACCESSIBILITY — EMACSPEAK ;;; ============================================================ ;;; Default: OFF. Toggle with SPC t s (on) / SPC t S (off). (defconst my/emacspeak-dir (expand-file-name "~/.emacspeak")) (defconst my/emacspeak-wrapper (expand-file-name "~/.local/bin/emacspeak-mac")) (setq dtk-program my/emacspeak-wrapper) (defvar my/emacspeak-loaded nil) (defvar my/emacspeak-enabled nil) ;; Hard inhibit: when non-nil, Emacspeak server will not start/restart (defvar my/emacspeak-inhibit-server t) (defun my/emacspeak--ensure-loaded () "Load Emacspeak once, safely, without breaking Doom startup." (unless my/emacspeak-loaded (setq my/emacspeak-loaded t) (setq emacspeak-directory my/emacspeak-dir) (load-file (expand-file-name "lisp/emacspeak-setup.el" emacspeak-directory)) (with-eval-after-load 'dtk-speak (dolist (fn '(dtk-initialize dtk-start-process dtk-speak)) (when (fboundp fn) (advice-add fn :around (lambda (orig &rest args) (if my/emacspeak-inhibit-server nil ; OFF: do nothing, don't restart (apply orig args))))))))) (defun my/emacspeak-on () "Enable speech and allow TTS server to start." (interactive) (setq my/emacspeak-inhibit-server nil) (my/emacspeak--ensure-loaded) (setq my/emacspeak-enabled t) (when (fboundp 'dtk-restart) (ignore-errors (dtk-restart))) (when (fboundp 'dtk-speak) (ignore-errors (dtk-speak "Emacspeak on."))) (message "Emacspeak ON")) (defun my/emacspeak-off () "Disable speech and prevent auto-restart." (interactive) (setq my/emacspeak-enabled nil my/emacspeak-inhibit-server t) (when (fboundp 'dtk-stop) (ignore-errors (dtk-stop))) (when (boundp 'dtk-speaker-process) (let ((p dtk-speaker-process)) (when (processp p) (ignore-errors (set-process-sentinel p nil)) (ignore-errors (delete-process p)))) (setq dtk-speaker-process nil)) (message "Emacspeak OFF (server restart inhibited)")) (map! :leader (:prefix ("t" . "toggle") :desc "Speech ON" "s" #'my/emacspeak-on :desc "Speech OFF" "S" #'my/emacspeak-off)) (with-eval-after-load 'dtk-speak (setq dtk-speech-rate-base 300) (setq-default dtk-punctuation-mode 'none)) (with-eval-after-load 'emacspeak (setq-default emacspeak-character-echo nil emacspeak-word-echo t emacspeak-line-echo t)) ;; Apply global default speech rate after TTS init/restart (setq dtk-default-speech-rate 400) (with-eval-after-load 'dtk-speak (defun my/dtk-apply-global-default-rate (&rest _) "Apply global default speech rate after TTS init/restart." (when (fboundp 'dtk-set-rate) (ignore-errors (dtk-set-rate dtk-default-speech-rate t)))) (advice-add 'dtk-initialize :after #'my/dtk-apply-global-default-rate)) ;;; ============================================================ ;;; ACCESSIBILITY — GLOBAL TEXT SCALING (SPC z) ;;; ============================================================ ;; Screen magnifier: scales the global `default' face — all buffers, ;; help windows, doom menus, org-agenda, magit, which-key included. ;; ;; Modeline + header-line + tabs are PINNED to base size (always visible). ;; which-key shows at full zoom in 90 % of frame height — more keys fit. ;; No face-remap hooks (avoid accumulation bugs with timers). ;; ;; Step: ×1.5 per step (multiplicative). From 14pt base: ;; +1 ≈ 21pt +2 ≈ 32pt +3 ≈ 47pt ;; +4 ≈ 71pt +5 ≈ 106pt +6 ≈ 159pt ;; ;; SPC z + / = zoom in ;; SPC z - zoom out ;; SPC z 0 reset to default (saves level for restore) ;; SPC z z restore zoom before last reset ;; In which-key popup: C-h pages to next group of bindings ;; --------------- state --------------- (defvar my/zoom-base-height 140 "Default face height before any zoom, in 1/10 pt. Captured at Doom init.") (defvar my/zoom-steps 0 "Current zoom step count. 0 = default, positive = bigger.") (defvar my/zoom-saved-steps nil "Step count saved before last `my/zoom-reset', for `my/zoom-restore'.") ;; --------------- pinned faces (always at base) --------------- (defvar my/zoom-pinned-faces '(mode-line mode-line-inactive mode-line-active header-line tab-bar tab-bar-tab tab-bar-tab-inactive) "Faces kept at `my/zoom-base-height' regardless of zoom. Keeps the status bar and tab bar fully visible at any zoom level.") (defun my/zoom-pin-ui () "Set all pinned UI faces to base height." (dolist (face my/zoom-pinned-faces) (when (facep face) (set-face-attribute face nil :height my/zoom-base-height)))) ;; --------------- which-key: max side-window height --------------- ;; which-key scales with global zoom (same as all other buffers). ;; Give it 90 % of frame height so more bindings are visible at once. ;; Press C-h while which-key is open to page through remaining bindings. (after! which-key (setq which-key-side-window-max-height 0.90 which-key-max-display-columns nil)) ;; --------------- core zoom engine --------------- (defun my/zoom--apply (steps) "Scale global default face to base × 1.5^STEPS and re-pin UI faces." (let ((new-h (max 80 (round (* my/zoom-base-height (expt 1.5 steps)))))) (set-face-attribute 'default nil :height new-h) (my/zoom-pin-ui) (when (fboundp 'corfu--popup-hide) (ignore-errors (corfu--popup-hide))) (message "Zoom %+d ×%.2f ≈%dpt" steps (expt 1.5 steps) (/ new-h 10)))) ;; Capture base height once Doom finishes font setup. (add-hook 'doom-after-init-hook (lambda () (let ((h (face-attribute 'default :height nil t))) (when (and (integerp h) (> h 0)) (setq my/zoom-base-height h))))) ;; Re-pin UI faces after theme reloads (Doom resets faces on theme change). (add-hook 'doom-load-theme-hook #'my/zoom-pin-ui) ;; --------------- interactive commands --------------- (defun my/zoom-in () "Zoom in one step (×1.5) — all buffers, help, menus, which-key." (interactive) (cl-incf my/zoom-steps) (my/zoom--apply my/zoom-steps)) (defun my/zoom-out () "Zoom out one step (÷1.5) — all buffers." (interactive) (cl-decf my/zoom-steps) (my/zoom--apply my/zoom-steps)) (defun my/zoom-reset () "Reset to default font size. Saves current level for restore." (interactive) (if (= my/zoom-steps 0) (message "Zoom: already at default") (setq my/zoom-saved-steps my/zoom-steps) (my/zoom--apply 0) (setq my/zoom-steps 0) (message "Zoom reset (SPC z z to restore %+d)" my/zoom-saved-steps))) (defun my/zoom-restore () "Restore zoom level saved before last reset." (interactive) (if (null my/zoom-saved-steps) (message "Zoom: nothing to restore") (my/zoom--apply my/zoom-saved-steps) (setq my/zoom-steps my/zoom-saved-steps my/zoom-saved-steps nil))) ;;; ============================================================ ;;; ACCESSIBILITY — SPLIT-SCREEN MAGNIFIER (SPC z m) ;;; ============================================================ ;; Pure Emacs-native split-screen magnifier. Žádné externí procesy, žádné macOS API. ;; ;; Architektura: ;; LEFT pane (40%): normální editace — zde pracuješ ;; RIGHT pane (60%): zvětšený pohled — indirect buffer, sleduje cursor ;; ;; Funkce: ;; - Sleduje cursor v aktivním okně (post-command-hook) ;; - Přepíná automaticky při změně bufferu/okna (buffer switch) ;; - SPC z + / SPC z = zoom in (jen magnifier, ne globálně) ;; - SPC z - zoom out (jen magnifier) ;; - SPC z 0 reset zoom magnifieru na výchozí ;; - SPC z m toggle on/off ;; - Všechny zoom příkazy jsou no-op pokud magnifier vypnut ;; - Kurzor v magnifier pane skrytý (cursor-type nil) ;; - Magnifier pane je read-only zobrazení (žádné edit v indirect buf) ;; - Správné cleanup při window-configuration-change (defvar my/mag--active nil "Non-nil when split magnifier is enabled.") (defvar my/mag--window nil "The magnified (right) window.") (defvar my/mag--buffer nil "Current indirect buffer for magnification.") (defvar my/mag--source nil "Buffer currently being magnified.") (defvar my/mag--zoom-level 4 "Current text-scale-set value for magnifier (4 ≈ 2× default).") (defvar my/mag--zoom-default 4 "Default zoom level for reset.") (defun my/mag--kill-indirect () "Kill the current magnifier indirect buffer if it exists." (when (and my/mag--buffer (buffer-live-p my/mag--buffer)) (kill-buffer my/mag--buffer)) (setq my/mag--buffer nil)) (defun my/mag--switch-source () "Switch magnifier to track the current buffer." (cl-block my/mag--switch-source (let* ((new-source (current-buffer)) (mag-name (format "*mag:%s*" (buffer-name new-source)))) ;; Don't switch to transient/minibuffer buffers (when (or (minibufferp new-source) (string-prefix-p " " (buffer-name new-source))) (cl-return-from my/mag--switch-source)) (my/mag--kill-indirect) (setq my/mag--source new-source) (setq my/mag--buffer (make-indirect-buffer new-source mag-name t)) (when (and my/mag--window (window-live-p my/mag--window)) (set-window-buffer my/mag--window my/mag--buffer) (with-selected-window my/mag--window (text-scale-set my/mag--zoom-level) (setq-local cursor-type 'box) (setq-local scroll-margin 0) (when (bound-and-true-p display-line-numbers-mode) (display-line-numbers-mode -1)) (when (bound-and-true-p hl-line-mode) (hl-line-mode -1))))))) (defun my/mag--sync () "Sync magnified pane to current cursor position." (when my/mag--active ;; Skip when minibuffer is active (M-x, vertico, which-key, etc.) (when (or (active-minibuffer-window) (window-minibuffer-p)) (cl-return-from my/mag--sync)) ;; Ignore if we're in the magnifier pane itself (when (eq (selected-window) my/mag--window) (cl-return-from my/mag--sync)) ;; Check magnifier window is still alive (unless (and my/mag--window (window-live-p my/mag--window)) (cl-return-from my/mag--sync)) ;; Switch source if buffer changed (unless (eq (current-buffer) my/mag--source) (my/mag--switch-source)) ;; Sync point + recenter (when (and my/mag--buffer (buffer-live-p my/mag--buffer)) (let ((pt (point))) (with-selected-window my/mag--window (goto-char pt) (recenter)))))) (defun my/mag--on-window-change () "Clean up if magnifier window was closed by user." (when (and my/mag--active (not (active-minibuffer-window)) (not (and my/mag--window (window-live-p my/mag--window)))) (my/mag--disable))) (defun my/mag--enable () "Enable split-screen magnifier." (delete-other-windows) (setq my/mag--source (current-buffer)) (let ((mag-name (format "*mag:%s*" (buffer-name my/mag--source)))) ;; Clean up stale buffer (when-let ((old (get-buffer mag-name))) (kill-buffer old)) (setq my/mag--buffer (make-indirect-buffer my/mag--source mag-name t))) ;; Split: left 40%, right 60% (setq my/mag--window (split-window (selected-window) (floor (* 0.4 (window-total-width))) 'right)) (set-window-buffer my/mag--window my/mag--buffer) (with-selected-window my/mag--window (text-scale-set my/mag--zoom-level) (setq-local cursor-type 'box) (setq-local scroll-margin 0) (when (bound-and-true-p display-line-numbers-mode) (display-line-numbers-mode -1)) (when (bound-and-true-p hl-line-mode) (hl-line-mode -1))) (setq my/mag--active t) (add-hook 'post-command-hook #'my/mag--sync) (add-hook 'window-configuration-change-hook #'my/mag--on-window-change) (message "Split magnifier ON (zoom %+d)" my/mag--zoom-level)) (defun my/mag--disable () "Disable split-screen magnifier." (remove-hook 'post-command-hook #'my/mag--sync) (remove-hook 'window-configuration-change-hook #'my/mag--on-window-change) (when (and my/mag--window (window-live-p my/mag--window)) (delete-window my/mag--window)) ;; Kill all *mag:* buffers (dolist (buf (buffer-list)) (when (string-prefix-p "*mag:" (buffer-name buf)) (kill-buffer buf))) (setq my/mag--active nil my/mag--window nil my/mag--buffer nil my/mag--source nil) (message "Split magnifier OFF")) (defun my/mag-toggle () "Toggle split-screen magnifier on/off." (interactive) (if my/mag--active (my/mag--disable) (my/mag--enable))) (defun my/mag-zoom-in () "Increase magnifier zoom level." (interactive) (when my/mag--active (cl-incf my/mag--zoom-level) (when (and my/mag--window (window-live-p my/mag--window)) (with-selected-window my/mag--window (text-scale-set my/mag--zoom-level))) (message "Magnifier zoom %+d" my/mag--zoom-level))) (defun my/mag-zoom-out () "Decrease magnifier zoom level." (interactive) (when my/mag--active (cl-decf my/mag--zoom-level) (when (and my/mag--window (window-live-p my/mag--window)) (with-selected-window my/mag--window (text-scale-set my/mag--zoom-level))) (message "Magnifier zoom %+d" my/mag--zoom-level))) (defun my/mag-zoom-reset () "Reset magnifier zoom to default." (interactive) (when my/mag--active (setq my/mag--zoom-level my/mag--zoom-default) (when (and my/mag--window (window-live-p my/mag--window)) (with-selected-window my/mag--window (text-scale-set my/mag--zoom-level))) (message "Magnifier zoom reset to %+d" my/mag--zoom-level))) (defun my/mag-or-global-zoom-in () "Zoom in: magnifier if active, otherwise global." (interactive) (if my/mag--active (my/mag-zoom-in) (my/zoom-in))) (defun my/mag-or-global-zoom-out () "Zoom out: magnifier if active, otherwise global." (interactive) (if my/mag--active (my/mag-zoom-out) (my/zoom-out))) (defun my/mag-or-global-zoom-reset () "Reset zoom: magnifier if active, otherwise global." (interactive) (if my/mag--active (my/mag-zoom-reset) (my/zoom-reset))) ;; --------------- keybindings --------------- (map! :leader (:prefix ("z" . "zoom") :desc "Zoom in (global ×1.5)" "+" #'my/mag-or-global-zoom-in :desc "Zoom in (global ×1.5)" "=" #'my/mag-or-global-zoom-in :desc "Zoom out (global ÷1.5)" "-" #'my/mag-or-global-zoom-out :desc "Reset zoom" "0" #'my/mag-or-global-zoom-reset :desc "Restore global zoom" "z" #'my/zoom-restore :desc "Split magnifier" "m" #'my/mag-toggle)) ;;; ============================================================ ;;; KEYBINDINGS ;;; ============================================================ (map! :leader (:prefix ("h" . "help") :desc "Describe bindings (buffer-local)" "B" #'describe-bindings))