Activate tree-sitter as primary syntax highlighter, fix chords and fonts
ober
6c3e31dfe07332bf5ca0d220650898daf07ec309
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -900,6 +900,11 @@ (= code (+ QT_KEY_A 6))))) + (not (and alt? + (not ctrl?) + (= code + (+ QT_KEY_A + 23)))) (let ([send! (cond [(terminal-buffer? buf) @@ -1588,60 +1593,90 @@ (string-ref text 0))]) - (if autorepeat? - (begin - (verbose-log! - "CHORD-AUTOREPEAT ignored ch=" - (string ch1)) - (void)) - (let ([chord-cmd (and ch2 - (chord-lookup - ch1 - ch2))]) - (verbose-log! "CHORD-RESOLVE ch1=" - (string ch1) " ch2=" - (if ch2 - (string ch2) - "#f") - " cmd=" - (if chord-cmd - (symbol->string - chord-cmd) - "#f")) - (qt-timer-stop! - *chord-timer*) - (set! *chord-pending-char* - #f) - (if chord-cmd - (begin - (execute-command! - app - chord-cmd) - (qt-update-visual-decorations! - (qt-current-editor - (app-state-frame - app))) - (qt-update-mark-selection! - app) - (qt-modeline-update! - app) - (qt-tabbar-update! - app) - (qt-update-frame-title! - app) - (qt-echo-draw! - (app-state-echo - app) - echo-label)) - (begin - (do-normal-key! - saved-code - saved-mods - saved-text) - (do-normal-key! - code - mods - text))))))] + (cond + [autorepeat? + (verbose-log! + "CHORD-AUTOREPEAT ignored ch=" + (string ch1)) + (void)] + [(and (not ch2) + (or (and (>= code + 16777248) + (<= code + 16777253)) + (= code 16777299) + (= code 16777300) + (= code + 16781571))) + (verbose-log! + "CHORD-IGNORE-MODIFIER pending=" + (string ch1) + " code=" + (number->string code)) + (void)] + [(not ch2) + (verbose-log! + "CHORD-CANCEL-NONCHORD pending=" + (string ch1) + " code=" + (number->string code)) + (qt-timer-stop! + *chord-timer*) + (set! *chord-pending-char* + #f) + (do-normal-key! + saved-code + saved-mods + saved-text) + (do-normal-key! + code + mods + text)] + [else + (let ([chord-cmd (chord-lookup + ch1 + ch2)]) + (verbose-log! "CHORD-RESOLVE ch1=" + (string ch1) " ch2=" + (string ch2) " cmd=" + (if chord-cmd + (symbol->string + chord-cmd) + "#f")) + (qt-timer-stop! + *chord-timer*) + (set! *chord-pending-char* + #f) + (if chord-cmd + (begin + (execute-command! + app + chord-cmd) + (qt-update-visual-decorations! + (qt-current-editor + (app-state-frame + app))) + (qt-update-mark-selection! + app) + (qt-modeline-update! + app) + (qt-tabbar-update! + app) + (qt-update-frame-title! + app) + (qt-echo-draw! + (app-state-echo + app) + echo-label)) + (begin + (do-normal-key! + saved-code + saved-mods + saved-text) + (do-normal-key! + code + mods + text))))]))] [(and (not autorepeat?) (= (string-length text) 1) (> (char->integer @@ -1660,15 +1695,7 @@ (app-state-key-state app))) (chord-start-char? - (string-ref text 0)) - (let ([cur-buf (qt-current-buffer - fr)]) - (not (or (terminal-buffer? - cur-buf) - (shell-buffer? - cur-buf) - (gsh-eshell-buffer? - cur-buf))))) + (string-ref text 0))) (verbose-log! "CHORD-PENDING ch=" (string (string-ref text 0)) " timeout=" --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -206,13 +206,11 @@ '("Monospace" "Courier" "Monaco") (sort fonts string<?))))))) (def (apply-font-to-all-editors! app) - "Apply the current global font family and size to all open editors." + "Apply the current global font family and size to all open editors.\n Does NOT re-apply highlighting — just forces font on all 128 styles." (let ([fr (app-state-frame app)]) (for-each (lambda (win) - (let* ([ed (qt-edit-window-editor win)] - [buf (qt-edit-window-buffer win)]) - (when buf (qt-setup-highlighting! app buf)) + (let ([ed (qt-edit-window-editor win)]) (let loop ([i 0]) (when (<= i 127) (sci-send/string --- a/lib/jerboa-emacs/qt/highlight.sls +++ b/lib/jerboa-emacs/qt/highlight.sls @@ -629,10 +629,16 @@ SCI_STYLESETFORE *ts-style-preproc* (rgb->sci r g b))) - (let loop ([s 90]) - (when (<= s 108) - (sci-send ed SCI_STYLESETBACK s 1579032) - (loop (+ s 1))))) + (let ([default-face (face-get 'default)]) + (let ([bg (if (and default-face (face-bg default-face)) + (let-values ([(r g b) + (parse-hex-color (face-bg default-face))]) + (rgb->sci r g b)) + 1579032)]) + (let loop ([s 1]) + (when (<= s 19) + (sci-send ed SCI_STYLESETBACK s bg) + (loop (+ s 1))))))) (def (qt-setup-highlighting! app buf) (let* ([ext-lang (detect-language (buffer-file-path buf))] [shebang-lang (and (not ext-lang) @@ -686,85 +692,183 @@ (qt-setup-org-styles! ed) (let ([text (qt-plain-text-edit-text ed)]) (qt-org-highlight-buffer-async! ed text))) - (when (and ed lexer-name) - (buffer-lexer-lang-set! buf lang) - (qt-scintilla-set-lexer-language! ed lexer-name) - (case lang - [(c) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* - (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] - [(javascript) - (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) - (when *js-builtins* - (sci-send/string ed SCI_SETKEYWORDS *js-builtins* 1))] - [(go) - (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) - (when *go-types* - (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))] - [(rust) - (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) - (when *rust-types* - (sci-send/string ed SCI_SETKEYWORDS *rust-types* 1))] - [(java haskell swift elixir) - (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) - (when *java-types* - (sci-send/string ed SCI_SETKEYWORDS *java-types* 1))] - [(zig nix) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* - (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] - [(shell) - (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)] - [else (void)]) - (restore-margin-colors! ed) - (qt-enable-code-folding! ed)))) + (when (and ed lang) + (let ([ts-name (language->ts-name lang)]) + (if ts-name + (begin + (buffer-lexer-lang-set! buf lang) + (sci-send ed 4033 0) + (when (not (ts-buffer-state buf)) + (ts-buffer-init! buf ts-name)) + (ts-setup-styles! ed) + (let loop ([i 0]) + (when (<= i 127) + (sci-send/string + ed + SCI_STYLESETFONT + *default-font-family* + i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + (let ([text (qt-plain-text-edit-text ed)]) + (when text (ts-buffer-reparse! buf text ed))) + (verbose-log! + "highlight: tree-sitter active for " + (symbol->string lang))) + (when lexer-name + (buffer-lexer-lang-set! buf lang) + (qt-scintilla-set-lexer-language! ed lexer-name) + (case lang + [(c) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* + (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] + [(javascript) + (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) + (when *js-builtins* + (sci-send/string + ed + SCI_SETKEYWORDS + *js-builtins* + 1))] + [(go) + (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) + (when *go-types* + (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))] + [(rust) + (sci-send/string + ed + SCI_SETKEYWORDS + *rust-keywords* + 0) + (when *rust-types* + (sci-send/string + ed + SCI_SETKEYWORDS + *rust-types* + 1))] + [(java haskell swift elixir) + (sci-send/string + ed + SCI_SETKEYWORDS + *java-keywords* + 0) + (when *java-types* + (sci-send/string + ed + SCI_SETKEYWORDS + *java-types* + 1))] + [(zig nix) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* + (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] + [(shell) + (sci-send/string + ed + SCI_SETKEYWORDS + *shell-keywords* + 0)] + [else (void)]) + (let loop ([i 0]) + (when (<= i 127) + (sci-send/string + ed + SCI_STYLESETFONT + *default-font-family* + i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + (qt-enable-code-folding! ed))))))) (def (qt-reapply-highlighting! ed buf) (let ([lang (buffer-lexer-lang buf)]) (when lang - (let ([lexer-name (and (not (memq - lang - '(dired repl eshell))) - (language->lexer-name lang))]) - (cond - [(eq? lang 'org) - (apply-base-theme! ed) - (sci-send ed 4033 0) - (qt-setup-org-styles! ed) - (let ([text (qt-plain-text-edit-text ed)]) - (qt-org-highlight-buffer-async! ed text))] - [lexer-name - (qt-scintilla-set-lexer-language! ed lexer-name) - (case lang - [(c) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* - (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] - [(javascript) - (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) - (when *js-builtins* - (sci-send/string ed SCI_SETKEYWORDS *js-builtins* 1))] - [(go) - (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) - (when *go-types* - (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))] - [(rust) - (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) - (when *rust-types* - (sci-send/string ed SCI_SETKEYWORDS *rust-types* 1))] - [(java haskell swift elixir) - (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) - (when *java-types* - (sci-send/string ed SCI_SETKEYWORDS *java-types* 1))] - [(zig nix) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* - (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] - [(shell) - (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)] - [else (void)]) - (restore-margin-colors! ed) - (qt-enable-code-folding! ed)]))))) + (cond + [(eq? lang 'org) + (apply-base-theme! ed) + (sci-send ed 4033 0) + (qt-setup-org-styles! ed) + (let ([text (qt-plain-text-edit-text ed)]) + (qt-org-highlight-buffer-async! ed text))] + [(ts-buffer-state buf) + (sci-send ed 4033 0) + (ts-setup-styles! ed) + (let loop ([i 0]) + (when (<= i 127) + (sci-send/string + ed + SCI_STYLESETFONT + *default-font-family* + i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + (let ([text (qt-plain-text-edit-text ed)]) + (when text (ts-buffer-reparse! buf text ed)))] + [else + (let ([lexer-name (and (not (memq + lang + '(dired repl eshell))) + (language->lexer-name lang))]) + (when lexer-name + (qt-scintilla-set-lexer-language! ed lexer-name) + (case lang + [(c) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* + (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] + [(javascript) + (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) + (when *js-builtins* + (sci-send/string + ed + SCI_SETKEYWORDS + *js-builtins* + 1))] + [(go) + (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) + (when *go-types* + (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))] + [(rust) + (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) + (when *rust-types* + (sci-send/string + ed + SCI_SETKEYWORDS + *rust-types* + 1))] + [(java haskell swift elixir) + (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) + (when *java-types* + (sci-send/string + ed + SCI_SETKEYWORDS + *java-types* + 1))] + [(zig nix) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* + (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))] + [(shell) + (sci-send/string + ed + SCI_SETKEYWORDS + *shell-keywords* + 0)] + [else (void)]) + (let loop ([i 0]) + (when (<= i 127) + (sci-send/string + ed + SCI_STYLESETFONT + *default-font-family* + i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + (qt-enable-code-folding! ed)))])))) (def (qt-enable-code-folding! ed) "Enable code folding margin and markers for QScintilla editor.\n Sets up margin 2 as fold margin with box-tree style markers.\n QScintilla lexers compute fold levels automatically." (sci-send ed SCI_SETMARGINTYPEN 2 SC_MARGIN_SYMBOL) --- a/src/jerboa-emacs/core.ss +++ b/src/jerboa-emacs/core.ss @@ -2172,14 +2172,14 @@ (def *chord-first-chars* (make-hash-table)) ;; Time window in milliseconds for second key of chord. -;; Emacs key-chord.el uses 100ms for two-key and 200ms for same-key chords. -;; Default 100ms matches Emacs key-chord.el. At this duration the pending -;; character delay is imperceptible to humans (<150ms), yet two intentional -;; simultaneous keystrokes (typically 30-80ms apart) are reliably caught. -;; The old 500ms default caused visible typing lag since almost every letter -;; is a chord-start character with 17+ chords defined. -(def *chord-timeout* 100) -(defvar! 'chord-timeout 100 "Milliseconds to wait for second key of a chord" +;; The Qt event loop drains the deferred callback queue every ~50ms. +;; A 100ms timeout can miss the second key when both keys land in +;; different drain cycles (worst case: 50ms drain delay × 2 + key interval). +;; 200ms reliably catches all chord pairs while remaining imperceptible +;; (below the ~250ms human perception threshold). Since chords use +;; uppercase-only characters, the delay only affects Shift+letter typing. +(def *chord-timeout* 200) +(defvar! 'chord-timeout 200 "Milliseconds to wait for second key of a chord" setter: (lambda (v) (set! *chord-timeout* v)) type: 'integer type-args: '(50 . 1000) group: 'keybindings) @@ -2191,28 +2191,18 @@ (def (key-chord-define-global two-char-str cmd) "Bind a 2-character chord to a command symbol. - Case-insensitive: 'MT' matches mt, Mt, mT, and MT. - Like Emacs key-chord.el, registers BOTH orderings so the chord fires - regardless of which key arrives first (e.g. 'MT' matches M→T and T→M)." - (let* ((c1 (string-ref two-char-str 0)) - (c2 (string-ref two-char-str 1)) - ;; All case variants of each character - (c1s (if (char-alphabetic? c1) - (list (char-upcase c1) (char-downcase c1)) - (list c1))) - (c2s (if (char-alphabetic? c2) - (list (char-upcase c2) (char-downcase c2)) - (list c2)))) - ;; Register all case combinations in both orderings - (for-each (lambda (a) - (for-each (lambda (b) - (hash-put! *chord-map* (string a b) cmd) - (when (not (char=? a b)) - (hash-put! *chord-map* (string b a) cmd)) - (hash-put! *chord-first-chars* a #t) - (hash-put! *chord-first-chars* b #t)) - c2s)) - c1s))) + Case-sensitive: 'MT' only matches M→T and T→M (uppercase). + Registers BOTH orderings so the chord fires regardless of which + key arrives first. Use uppercase chords to avoid interfering + with normal lowercase typing in terminal buffers." + (let ((c1 (string-ref two-char-str 0)) + (c2 (string-ref two-char-str 1))) + ;; Register both orderings: c1c2 and c2c1 + (hash-put! *chord-map* (string c1 c2) cmd) + (when (not (char=? c1 c2)) + (hash-put! *chord-map* (string c2 c1) cmd)) + (hash-put! *chord-first-chars* c1 #t) + (hash-put! *chord-first-chars* c2 #t))) (def (chord-lookup ch1 ch2) "Look up a chord by two characters." --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -927,10 +927,12 @@ (let* ((ctrl? (not (zero? (bitwise-and mods QT_MOD_CTRL)))) (alt? (not (zero? (bitwise-and mods QT_MOD_ALT)))) (buf (qt-current-buffer (app-state-frame app)))) - ;; Allow C-x and C-g to pass through to jemacs + ;; Allow C-x, C-g, and M-x to pass through to jemacs (and (not (and ctrl? (not alt?) (or (= code (+ QT_KEY_A 23)) ;; C-x (= code (+ QT_KEY_A 6))))) ;; C-g + (not (and alt? (not ctrl?) + (= code (+ QT_KEY_A 23)))) ;; M-x (let ((send! (cond ((terminal-buffer? buf) @@ -1242,14 +1244,36 @@ ;; Auto-repeat filter: Qt reports isAutoRepeat for held keys. ;; Always ignore auto-repeat when a chord is pending — even for ;; same-char chords (EE, GG) since auto-repeat is NOT two presses. - (if autorepeat? - (begin + (cond + (autorepeat? (verbose-log! "CHORD-AUTOREPEAT ignored ch=" (string ch1)) (void)) ;; ignore auto-repeat, timer keeps running - ;; Real second key — resolve the chord - (let ((chord-cmd (and ch2 (chord-lookup ch1 ch2)))) + ;; Ignore bare modifier key releases (Shift, Ctrl, Alt, Meta). + ;; When typing uppercase chord chars (TM), the Shift release + ;; arrives between T and M — don't let it cancel the chord. + ;; Qt key codes: Shift=#x01000020, Ctrl=#x01000021, Meta=#x01000022, + ;; Alt=#x01000023, Super=#x01000053, Hyper=#x01000054, AltGr=#x01001103 + ((and (not ch2) + (or (and (>= code #x01000020) (<= code #x01000025)) + (= code #x01000053) (= code #x01000054) + (= code #x01001103))) + (verbose-log! "CHORD-IGNORE-MODIFIER pending=" (string ch1) + " code=" (number->string code)) + (void)) ;; ignore bare modifier, timer keeps running + ;; Non-chord key while chord pending (e.g. M-x, C-s, Escape): + ;; cancel the chord, replay the pending key, process current key. + ((not ch2) + (verbose-log! "CHORD-CANCEL-NONCHORD pending=" (string ch1) + " code=" (number->string code)) + (qt-timer-stop! *chord-timer*) + (set! *chord-pending-char* #f) + (do-normal-key! saved-code saved-mods saved-text) + (do-normal-key! code mods text)) + (else + ;; Real second printable key — resolve the chord + (let ((chord-cmd (chord-lookup ch1 ch2))) (verbose-log! "CHORD-RESOLVE ch1=" (string ch1) - " ch2=" (if ch2 (string ch2) "#f") + " ch2=" (string ch2) " cmd=" (if chord-cmd (symbol->string chord-cmd) "#f")) (qt-timer-stop! *chord-timer*) (set! *chord-pending-char* #f) @@ -1267,11 +1291,12 @@ ;; No chord — replay saved key then process current key (begin (do-normal-key! saved-code saved-mods saved-text) - (do-normal-key! code mods text))))))) + (do-normal-key! code mods text)))))))) ;; Case 2: Printable key that could start a chord — save and wait - ;; Skip chord detection in terminal/shell buffers to avoid - ;; letter doubling/dropping when typing fast. + ;; Works in ALL buffer types including terminal/shell. + ;; If the chord doesn't match, the replayed keys go through + ;; do-normal-key! which sends them to the PTY as usual. ;; Skip auto-repeat keys — holding a key should not start a chord. ((and (not autorepeat?) (= (string-length text) 1) @@ -1279,11 +1304,7 @@ (zero? (bitwise-and mods QT_MOD_CTRL)) (zero? (bitwise-and mods QT_MOD_ALT)) (null? (key-state-prefix-keys (app-state-key-state app))) - (chord-start-char? (string-ref text 0)) - (let ((cur-buf (qt-current-buffer fr))) - (not (or (terminal-buffer? cur-buf) - (shell-buffer? cur-buf) - (gsh-eshell-buffer? cur-buf))))) + (chord-start-char? (string-ref text 0))) (verbose-log! "CHORD-PENDING ch=" (string (string-ref text 0)) " timeout=" (number->string *chord-timeout*) "ms") (set! *chord-pending-char* (string-ref text 0)) --- a/src/jerboa-emacs/qt/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -178,18 +178,14 @@ (sort fonts string<?))))))) (def (apply-font-to-all-editors! app) - "Apply the current global font family and size to all open editors." + "Apply the current global font family and size to all open editors. + Does NOT re-apply highlighting — just forces font on all 128 styles." (let ((fr (app-state-frame app))) (for-each (lambda (win) - (let* ((ed (qt-edit-window-editor win)) - (buf (qt-edit-window-buffer win))) - ;; Re-apply highlighting (restores syntax colors) - (when buf - (qt-setup-highlighting! app buf)) + (let ((ed (qt-edit-window-editor win))) ;; Force font family and size on ALL styles (0-127). - ;; QsciLexer's setLexer() controls style fonts, so we must override - ;; each style individually — SCI_STYLECLEARALL would wipe syntax colors. + ;; Must be done per-widget because QScintilla styles are per-widget. (let loop ((i 0)) (when (<= i 127) (sci-send/string ed SCI_STYLESETFONT *default-font-family* i) --- a/src/jerboa-emacs/qt/highlight.ss +++ b/src/jerboa-emacs/qt/highlight.ss @@ -626,11 +626,16 @@ (sci-send ed SCI_STYLESETFORE *ts-style-builtin* (rgb->sci r g b))) (let-values (((r g b) (face-fg-rgb 'font-lock-preprocessor-face))) (sci-send ed SCI_STYLESETFORE *ts-style-preproc* (rgb->sci r g b))) - ;; Set background for all tree-sitter styles - (let loop ((s 90)) - (when (<= s 108) - (sci-send ed SCI_STYLESETBACK s #x181818) - (loop (+ s 1))))) + ;; Set background for all tree-sitter styles (1-19) to match default face + (let ((default-face (face-get 'default))) + (let ((bg (if (and default-face (face-bg default-face)) + (let-values (((r g b) (parse-hex-color (face-bg default-face)))) + (rgb->sci r g b)) + #x181818))) + (let loop ((s 1)) + (when (<= s 19) + (sci-send ed SCI_STYLESETBACK s bg) + (loop (+ s 1))))))) ;;;============================================================================ ;;; Main setup and teardown @@ -678,88 +683,133 @@ ;; Apply full-buffer org highlighting in background (let ((text (qt-plain-text-edit-text ed))) (qt-org-highlight-buffer-async! ed text))) - ;; Use raw Lexilla via SCI_SETLEXERLANGUAGE (not QsciLexer wrappers). - ;; QsciLexer wrappers override SCI_STYLESETFORE/BACK, but raw Lexilla - ;; respects our style settings, so apply-base-theme! and setup-*-styles! work. - (when (and ed lexer-name) - ;; Store language in buffer - (set! (buffer-lexer-lang buf) lang) - ;; Use QsciLexer wrappers for tokenization. - ;; The C++ function now also sets dark paper on the lexer object - ;; after setLexer(), so the background is dark. - ;; QsciLexer's own foreground colors (designed for syntax highlighting) - ;; are kept as-is — they provide tokenized coloring out of the box. - (qt-scintilla-set-lexer-language! ed lexer-name) - ;; Set keywords per language (QsciLexer has some defaults, - ;; but we override to ensure completeness) - (case lang - ((c) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) - ((javascript) - (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) - (when *js-builtins* (sci-send/string ed SCI_SETKEYWORDS *js-builtins* 1))) - ((go) - (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) - (when *go-types* (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))) - ((rust) - (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) - (when *rust-types* (sci-send/string ed SCI_SETKEYWORDS *rust-types* 1))) - ((java haskell swift elixir) - (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) - (when *java-types* (sci-send/string ed SCI_SETKEYWORDS *java-types* 1))) - ((zig nix) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) - ((shell) - (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)) - (else (void))) - ;; Restore margin + default colors (QsciLexer setLexer() resets them) - (restore-margin-colors! ed) - ;; Enable code folding - (qt-enable-code-folding! ed)))) + ;; Tree-sitter first: use TS for the 14 supported languages. + ;; Falls back to Scintilla Lexilla for unsupported languages. + ;; TS highlighting uses SCI_STARTSTYLING/SCI_SETSTYLING directly — + ;; no setLexer() call, so fonts are NEVER reset. + (when (and ed lang) + (let ((ts-name (language->ts-name lang))) + (if ts-name + ;; Tree-sitter path + (begin + (set! (buffer-lexer-lang buf) lang) + ;; Disable any built-in Scintilla lexer + (sci-send ed 4033 0) ;; SCI_SETILEXER = 0 + ;; Initialize tree-sitter parser + query (idempotent if already init'd) + (when (not (ts-buffer-state buf)) + (ts-buffer-init! buf ts-name)) + ;; Configure face colors for TS style IDs 1-19 + (ts-setup-styles! ed) + ;; Force font on all styles (no lexer to interfere) + (let loop ((i 0)) + (when (<= i 127) + (sci-send/string ed SCI_STYLESETFONT *default-font-family* i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + ;; Initial parse + highlight + (let ((text (qt-plain-text-edit-text ed))) + (when text (ts-buffer-reparse! buf text ed))) + (verbose-log! "highlight: tree-sitter active for " (symbol->string lang))) + ;; Lexilla fallback for unsupported languages + (when lexer-name + (set! (buffer-lexer-lang buf) lang) + (qt-scintilla-set-lexer-language! ed lexer-name) + (case lang + ((c) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) + ((javascript) + (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) + (when *js-builtins* (sci-send/string ed SCI_SETKEYWORDS *js-builtins* 1))) + ((go) + (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) + (when *go-types* (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))) + ((rust) + (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) + (when *rust-types* (sci-send/string ed SCI_SETKEYWORDS *rust-types* 1))) + ((java haskell swift elixir) + (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) + (when *java-types* (sci-send/string ed SCI_SETKEYWORDS *java-types* 1))) + ((zig nix) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) + ((shell) + (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)) + (else (void))) + ;; Re-apply font after setLexer() resets all styles + (let loop ((i 0)) + (when (<= i 127) + (sci-send/string ed SCI_STYLESETFONT *default-font-family* i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + (qt-enable-code-folding! ed))))))) ;; Re-apply stored highlighting to a specific editor widget. -;; Called when a buffer is displayed in a new split/window — the lexer -;; must be set per-widget since QScintilla lexers are widget-local. +;; Called when a buffer is displayed in a new split/window — styles +;; must be set per-widget since QScintilla styles are widget-local. (def (qt-reapply-highlighting! ed buf) (let ((lang (buffer-lexer-lang buf))) (when lang - (let ((lexer-name (and (not (memq lang '(dired repl eshell))) - (language->lexer-name lang)))) - (cond - ((eq? lang 'org) - (apply-base-theme! ed) - (sci-send ed 4033 0) ;; SCI_SETILEXER — disable built-in lexer - (qt-setup-org-styles! ed) - (let ((text (qt-plain-text-edit-text ed))) - (qt-org-highlight-buffer-async! ed text))) - (lexer-name - (qt-scintilla-set-lexer-language! ed lexer-name) - (case lang - ((c) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) - ((javascript) - (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) - (when *js-builtins* (sci-send/string ed SCI_SETKEYWORDS *js-builtins* 1))) - ((go) - (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) - (when *go-types* (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))) - ((rust) - (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) - (when *rust-types* (sci-send/string ed SCI_SETKEYWORDS *rust-types* 1))) - ((java haskell swift elixir) - (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) - (when *java-types* (sci-send/string ed SCI_SETKEYWORDS *java-types* 1))) - ((zig nix) - (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) - (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) - ((shell) - (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)) - (else (void))) - (restore-margin-colors! ed) - (qt-enable-code-folding! ed))))))) + (cond + ;; Org mode: manual styling + ((eq? lang 'org) + (apply-base-theme! ed) + (sci-send ed 4033 0) + (qt-setup-org-styles! ed) + (let ((text (qt-plain-text-edit-text ed))) + (qt-org-highlight-buffer-async! ed text))) + ;; Tree-sitter path: buffer has TS state + ((ts-buffer-state buf) + (sci-send ed 4033 0) ;; Disable built-in lexer + (ts-setup-styles! ed) + ;; Force font on all styles (no lexer reset!) + (let loop ((i 0)) + (when (<= i 127) + (sci-send/string ed SCI_STYLESETFONT *default-font-family* i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + ;; Re-highlight from existing parse tree + (let ((text (qt-plain-text-edit-text ed))) + (when text (ts-buffer-reparse! buf text ed)))) + ;; Lexilla fallback + (else + (let ((lexer-name (and (not (memq lang '(dired repl eshell))) + (language->lexer-name lang)))) + (when lexer-name + (qt-scintilla-set-lexer-language! ed lexer-name) + (case lang + ((c) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) + ((javascript) + (sci-send/string ed SCI_SETKEYWORDS *js-keywords* 0) + (when *js-builtins* (sci-send/string ed SCI_SETKEYWORDS *js-builtins* 1))) + ((go) + (sci-send/string ed SCI_SETKEYWORDS *go-keywords* 0) + (when *go-types* (sci-send/string ed SCI_SETKEYWORDS *go-types* 1))) + ((rust) + (sci-send/string ed SCI_SETKEYWORDS *rust-keywords* 0) + (when *rust-types* (sci-send/string ed SCI_SETKEYWORDS *rust-types* 1))) + ((java haskell swift elixir) + (sci-send/string ed SCI_SETKEYWORDS *java-keywords* 0) + (when *java-types* (sci-send/string ed SCI_SETKEYWORDS *java-types* 1))) + ((zig nix) + (sci-send/string ed SCI_SETKEYWORDS *c-keywords* 0) + (when *c-types* (sci-send/string ed SCI_SETKEYWORDS *c-types* 1))) + ((shell) + (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)) + (else (void))) + ;; Re-apply font after setLexer() resets + (let loop ((i 0)) + (when (<= i 127) + (sci-send/string ed SCI_STYLESETFONT *default-font-family* i) + (sci-send ed SCI_STYLESETSIZE i *default-font-size*) + (loop (+ i 1)))) + (restore-margin-colors! ed) + (qt-enable-code-folding! ed)))))))) ;;;============================================================================ ;;; Code folding margin setup --- a/vendor/chez-qt-qt.ss +++ b/vendor/chez-qt-qt.ss @@ -854,15 +854,18 @@ (define (qt-app-exec! app . args) ;; qt_application_exec is a no-op in the C shim — the Qt event loop ;; runs in a background pthread. Poll until the event loop exits. - ;; Optional first argument: a tick callback invoked every 50ms iteration. + ;; Optional first argument: a tick callback invoked every 10ms iteration. ;; This allows the caller to merge periodic work (e.g. master timer) into ;; the same Chez thread, eliminating multi-thread GC rendezvous deadlocks. + ;; 10ms (100 ticks/sec) keeps key chord detection responsive — at 50ms, + ;; the deferred callback queue drains too slowly and chord timers can + ;; expire before the second key is processed. (ffi-qt-app-exec app) (let ((tick (if (null? args) #f (car args)))) (let loop () (when (= (ffi-qt-app-is-running) 1) (when tick (tick)) - (sleep (make-time 'time-duration 50000000 0)) + (sleep (make-time 'time-duration 10000000 0)) (loop))))) (define (qt-app-quit! app) (ffi-qt-app-quit app)) (define (qt-app-process-events! app) (ffi-qt-app-process-events app))