Fix set-font-size: preserve syntax colors, margin colors, and font size
ober
4dd79239e088a7aa12ce25b06f1c08e7243122c8
--- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -212,18 +212,17 @@ (lambda (win) (let* ([ed (qt-edit-window-editor win)] [buf (qt-edit-window-buffer win)]) - (sci-send/string - ed - SCI_STYLESETFONT - *default-font-family* - STYLE_DEFAULT) - (sci-send - ed - SCI_STYLESETSIZE - STYLE_DEFAULT - *default-font-size*) - (sci-send ed SCI_STYLECLEARALL) - (when buf (qt-setup-highlighting! buf)))) + (when buf (qt-setup-highlighting! app buf)) + (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-frame-windows fr))) (when *qt-app-ptr* (qt-app-set-style-sheet! *qt-app-ptr* (theme-stylesheet)))) --- a/lib/jerboa-emacs/qt/commands-parity5.sls +++ b/lib/jerboa-emacs/qt/commands-parity5.sls @@ -508,12 +508,14 @@ (let* ([fr (app-state-frame app)]) (for-each (lambda (win) - (let ([ed (qt-edit-window-editor win)]) + (let* ([ed (qt-edit-window-editor win)] + [buf (qt-edit-window-buffer win)]) (sci-send ed SCI_STYLESETBACK 32 16777215) (sci-send ed SCI_STYLESETFORE 32 0) (sci-send ed SCI_STYLECLEARALL 0) (sci-send ed SCI_SETCARETLINEVISIBLE 1) - (sci-send ed SCI_SETCARETLINEBACK 16777184))) + (sci-send ed SCI_SETCARETLINEBACK 16777184) + (when buf (qt-setup-highlighting! app buf)))) (qt-frame-windows fr)) (echo-message! (app-state-echo app) @@ -894,12 +896,14 @@ (let ([fr (app-state-frame app)]) (for-each (lambda (win) - (let ([ed (qt-edit-window-editor win)]) + (let* ([ed (qt-edit-window-editor win)] + [buf (qt-edit-window-buffer win)]) (sci-send ed SCI_STYLESETBACK 32 1973806) (sci-send ed SCI_STYLESETFORE 32 13489908) (sci-send ed SCI_STYLECLEARALL 0) (sci-send ed SCI_SETCARETLINEVISIBLE 1) - (sci-send ed SCI_SETCARETLINEBACK 3224132))) + (sci-send ed SCI_SETCARETLINEBACK 3224132) + (when buf (qt-setup-highlighting! app buf)))) (qt-frame-windows fr)) (echo-message! (app-state-echo app) "Doom theme applied"))) (def (cmd-rmail app) @@ -952,9 +956,11 @@ (let ([fr (app-state-frame app)]) (for-each (lambda (win) - (let ([ed (qt-edit-window-editor win)]) + (let* ([ed (qt-edit-window-editor win)] + [buf (qt-edit-window-buffer win)]) (sci-send ed SCI_STYLESETBACK 32 val) - (sci-send ed SCI_STYLECLEARALL 0))) + (sci-send ed SCI_STYLECLEARALL 0) + (when buf (qt-setup-highlighting! app buf)))) (qt-frame-windows fr)) (echo-message! (app-state-echo app) --- a/lib/jerboa-emacs/qt/highlight.sls +++ b/lib/jerboa-emacs/qt/highlight.sls @@ -10,7 +10,7 @@ qt-enable-code-folding! detect-language qt-org-table-separator? *search-highlight-active* *qt-show-paren-enabled* *qt-delete-selection-enabled* - ts-setup-styles!) + ts-setup-styles! restore-margin-colors!) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -263,6 +263,40 @@ SCI_STYLESETBACK STYLE_LINENUMBER (rgb->sci bg-r bg-g bg-b)))))) + (def (restore-margin-colors! ed) + "Restore line number margin and default face colors without SCI_STYLECLEARALL.\n Use after operations that may corrupt margin colors (e.g. setting font on all styles\n or re-creating a QsciLexer via setLexer)." + (let-values ([(fg-r fg-g fg-b) (face-fg-rgb 'default)]) + (sci-send + ed + SCI_STYLESETFORE + STYLE_DEFAULT + (rgb->sci fg-r fg-g fg-b))) + (let ([default-face (face-get 'default)]) + (when (and default-face (face-bg default-face)) + (let-values ([(bg-r bg-g bg-b) + (parse-hex-color (face-bg default-face))]) + (sci-send + ed + SCI_STYLESETBACK + STYLE_DEFAULT + (rgb->sci bg-r bg-g bg-b))))) + (let ([ln-face (face-get 'line-number)]) + (when ln-face + (when (face-fg ln-face) + (let-values ([(r g b) (parse-hex-color (face-fg ln-face))]) + (sci-send + ed + SCI_STYLESETFORE + STYLE_LINENUMBER + (rgb->sci r g b)))) + (when (face-bg ln-face) + (let-values ([(r g b) (parse-hex-color (face-bg ln-face))]) + (sci-send + ed + SCI_STYLESETBACK + STYLE_LINENUMBER + (rgb->sci r g b)) + (sci-send ed 2260 0 (rgb->sci r g b))))))) (def (setup-cpp-styles! ed keywords (types #f)) (let-values ([(r g b) (face-fg-rgb 'font-lock-comment-face)]) @@ -682,21 +716,7 @@ [(shell) (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)] [else (void)]) - (let-values ([(ln-r ln-g ln-b) (face-fg-rgb 'line-number)]) - (sci-send - ed - SCI_STYLESETFORE - STYLE_LINENUMBER - (rgb->sci ln-r ln-g ln-b))) - (let ([ln-face (face-get 'line-number)]) - (when (and ln-face (face-bg ln-face)) - (let-values ([(bg-r bg-g bg-b) - (parse-hex-color (face-bg ln-face))]) - (sci-send - ed - SCI_STYLESETBACK - STYLE_LINENUMBER - (rgb->sci bg-r bg-g bg-b))))) + (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." --- a/src/jerboa-emacs/qt/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -184,12 +184,19 @@ (lambda (win) (let* ((ed (qt-edit-window-editor win)) (buf (qt-edit-window-buffer win))) - (sci-send/string ed SCI_STYLESETFONT *default-font-family* STYLE_DEFAULT) - (sci-send ed SCI_STYLESETSIZE STYLE_DEFAULT *default-font-size*) - (sci-send ed SCI_STYLECLEARALL) - ;; Re-apply highlighting (STYLECLEARALL wipes QsciLexer colors) + ;; Re-apply highlighting (restores syntax colors) (when buf - (qt-setup-highlighting! buf)))) + (qt-setup-highlighting! app buf)) + ;; 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. + (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 and default colors (font loop may have corrupted them) + (restore-margin-colors! ed))) (qt-frame-windows fr))) ;; Update Qt stylesheet so chrome widgets match (when *qt-app-ptr* --- a/src/jerboa-emacs/qt/commands-parity5.ss +++ b/src/jerboa-emacs/qt/commands-parity5.ss @@ -451,14 +451,18 @@ ;; Reset all editors to default colors (for-each (lambda (win) - (let ((ed (qt-edit-window-editor win))) + (let* ((ed (qt-edit-window-editor win)) + (buf (qt-edit-window-buffer win))) ;; Reset to default white background, black foreground (sci-send ed SCI_STYLESETBACK 32 #xFFFFFF) ; STYLE_DEFAULT bg (sci-send ed SCI_STYLESETFORE 32 #x000000) ; STYLE_DEFAULT fg (sci-send ed SCI_STYLECLEARALL 0) ;; Reset caret line (sci-send ed SCI_SETCARETLINEVISIBLE 1) - (sci-send ed SCI_SETCARETLINEBACK #xFFFFE0))) + (sci-send ed SCI_SETCARETLINEBACK #xFFFFE0) + ;; Re-apply highlighting + (when buf + (qt-setup-highlighting! app buf)))) (qt-frame-windows fr)) (echo-message! (app-state-echo app) "Theme reset to defaults"))) @@ -811,14 +815,18 @@ (let ((fr (app-state-frame app))) (for-each (lambda (win) - (let ((ed (qt-edit-window-editor win))) + (let* ((ed (qt-edit-window-editor win)) + (buf (qt-edit-window-buffer win))) ;; Doom One dark theme colors (sci-send ed SCI_STYLESETBACK 32 #x1e1e2e) ;; Dark bg (catppuccin-ish) (sci-send ed SCI_STYLESETFORE 32 #xcdd6f4) ;; Light fg (sci-send ed SCI_STYLECLEARALL 0) ;; Caret line (sci-send ed SCI_SETCARETLINEVISIBLE 1) - (sci-send ed SCI_SETCARETLINEBACK #x313244))) + (sci-send ed SCI_SETCARETLINEBACK #x313244) + ;; Re-apply highlighting + (when buf + (qt-setup-highlighting! app buf)))) (qt-frame-windows fr)) (echo-message! (app-state-echo app) "Doom theme applied"))) @@ -867,9 +875,13 @@ (let ((fr (app-state-frame app))) (for-each (lambda (win) - (let ((ed (qt-edit-window-editor win))) + (let* ((ed (qt-edit-window-editor win)) + (buf (qt-edit-window-buffer win))) (sci-send ed SCI_STYLESETBACK 32 val) - (sci-send ed SCI_STYLECLEARALL 0))) + (sci-send ed SCI_STYLECLEARALL 0) + ;; Re-apply highlighting (STYLECLEARALL wipes syntax colors) + (when buf + (qt-setup-highlighting! app buf)))) (qt-frame-windows fr)) (echo-message! (app-state-echo app) (string-append "Background set to #" hex-str))) (echo-error! (app-state-echo app) "Invalid hex color")))))) --- a/src/jerboa-emacs/qt/highlight.ss +++ b/src/jerboa-emacs/qt/highlight.ss @@ -18,7 +18,8 @@ *search-highlight-active* *qt-show-paren-enabled* *qt-delete-selection-enabled* - ts-setup-styles!) + ts-setup-styles! + restore-margin-colors!) (import :std/sugar :chez-scintilla/constants @@ -306,6 +307,29 @@ (let-values (((bg-r bg-g bg-b) (parse-hex-color (face-bg ln-face)))) (sci-send ed SCI_STYLESETBACK STYLE_LINENUMBER (rgb->sci bg-r bg-g bg-b)))))) +(def (restore-margin-colors! ed) + "Restore line number margin and default face colors without SCI_STYLECLEARALL. + Use after operations that may corrupt margin colors (e.g. setting font on all styles + or re-creating a QsciLexer via setLexer)." + ;; Default face fg/bg + (let-values (((fg-r fg-g fg-b) (face-fg-rgb 'default))) + (sci-send ed SCI_STYLESETFORE STYLE_DEFAULT (rgb->sci fg-r fg-g fg-b))) + (let ((default-face (face-get 'default))) + (when (and default-face (face-bg default-face)) + (let-values (((bg-r bg-g bg-b) (parse-hex-color (face-bg default-face)))) + (sci-send ed SCI_STYLESETBACK STYLE_DEFAULT (rgb->sci bg-r bg-g bg-b))))) + ;; Line number margin: both STYLE_LINENUMBER (text bg) and SCI_SETMARGINBACKN (margin area bg) + (let ((ln-face (face-get 'line-number))) + (when ln-face + (when (face-fg ln-face) + (let-values (((r g b) (parse-hex-color (face-fg ln-face)))) + (sci-send ed SCI_STYLESETFORE STYLE_LINENUMBER (rgb->sci r g b)))) + (when (face-bg ln-face) + (let-values (((r g b) (parse-hex-color (face-bg ln-face)))) + (sci-send ed SCI_STYLESETBACK STYLE_LINENUMBER (rgb->sci r g b)) + ;; SCI_SETMARGINBACKN (2260) — sets the margin gutter background itself + (sci-send ed 2260 0 (rgb->sci r g b))))))) + ;;;============================================================================ ;;; Lexer style setup (via SCI messages — works with raw Lexilla) ;;;============================================================================ @@ -689,13 +713,8 @@ ((shell) (sci-send/string ed SCI_SETKEYWORDS *shell-keywords* 0)) (else (void))) - ;; Line number margin styling - (let-values (((ln-r ln-g ln-b) (face-fg-rgb 'line-number))) - (sci-send ed SCI_STYLESETFORE STYLE_LINENUMBER (rgb->sci ln-r ln-g ln-b))) - (let ((ln-face (face-get 'line-number))) - (when (and ln-face (face-bg ln-face)) - (let-values (((bg-r bg-g bg-b) (parse-hex-color (face-bg ln-face)))) - (sci-send ed SCI_STYLESETBACK STYLE_LINENUMBER (rgb->sci bg-r bg-g bg-b))))) + ;; Restore margin + default colors (QsciLexer setLexer() resets them) + (restore-margin-colors! ed) ;; Enable code folding (qt-enable-code-folding! ed)))) --- a/vendor/jerboa-repl-static.sls +++ b/vendor/jerboa-repl-static.sls @@ -1505,12 +1505,11 @@ (install-history-bindings! env) ;; Make repl-history-ref available in env - (eval '(define repl-history-ref #f) env) - (eval `(set! repl-history-ref ,repl-history-ref) env) + (define-top-level-value 'repl-history-ref repl-history-ref env) ;; Welcome banner (display (c-bold cfg "Jerboa REPL")) - (display (c-dim cfg (format " v1.0 [Chez Scheme ~a]" (scheme-version)))) + (display (c-dim cfg (format " v1.0 [~a]" (scheme-version)))) (newline) (display (c-dim cfg " Type ,help for commands, ,quit to exit\n")) (display (c-dim cfg " Results stored as $1, $2, ... and *, **, ***\n"))