P1.5: Per-window modelines
ober
874abdc9bbe0ac47115125ef5609a0ec0d84eb37
--- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -1102,9 +1102,9 @@ => (lambda (session) (let ((win (hash-get *editor-window-map* editor))) (when win - (let* ((container (qt-edit-window-container win)) - (view (terminal-ensure-view! app buf session container))) - (qt-stacked-widget-set-current-widget! container view) + (let* ((stacked (qt-edit-window-stacked-widget win)) + (view (terminal-ensure-view! app buf session stacked))) + (qt-stacked-widget-set-current-widget! stacked view) ;; Only steal focus when this is the selected window; ;; background attaches (splits, previews) must not — the ;; post-split-focus hook focuses the split's new view. @@ -1725,14 +1725,14 @@ (lambda (fr) (let* ((win (qt-current-window fr)) (buf (qt-edit-window-buffer win)) - (container (qt-edit-window-container win)) + (stacked (qt-edit-window-stacked-widget win)) ;; Only target the live terminal view when it is actually the ;; shown widget (stack page > 0). In vterm copy mode the stack ;; shows the editor (page 0), so keys must go to the editor. (view (and buf (hash-get *terminal-widget-map* buf) - (> (qt-stacked-widget-current-index container) 0) - (terminal-view-for-container buf container)))) + (> (qt-stacked-widget-current-index stacked) 0) + (terminal-view-for-container buf stacked)))) (or view (qt-current-editor fr))))) ;; Install pre-container-destroy hook: when any window container @@ -1771,11 +1771,11 @@ (qt-window-set-post-split-focus-fn! (lambda (win) (let* ((buf (qt-edit-window-buffer win)) - (container (qt-edit-window-container win)) + (stacked (qt-edit-window-stacked-widget win)) (session (and buf (hash-get *terminal-widget-map* buf))) (view (and session - (> (qt-stacked-widget-current-index container) 0) - (terminal-view-for-container buf container)))) + (> (qt-stacked-widget-current-index stacked) 0) + (terminal-view-for-container buf stacked)))) (and session view (begin @@ -2365,10 +2365,10 @@ (win (qt-current-window fr)) (buf (qt-edit-window-buffer win)) (session (and buf (hash-get *terminal-widget-map* buf))) - (container (qt-edit-window-container win))) + (stacked (qt-edit-window-stacked-widget win))) (and session - (terminal-view-for-container buf container) - (> (qt-stacked-widget-current-index container) 0) + (terminal-view-for-container buf stacked) + (> (qt-stacked-widget-current-index stacked) 0) #t)))) ;; Reset editor to a clean single-window state between tests. ;; Clears key prefix state, collapses to one window, destroys terminals. --- a/src/jerboa-emacs/qt/commands-config.ss +++ b/src/jerboa-emacs/qt/commands-config.ss @@ -782,16 +782,16 @@ modified so the next save uses the new encoding." (string-append "Terminal failed: " msg)))) (lambda () (let* ((win (qt-current-window fr)) - (container (qt-edit-window-container win)) - (session (qt-terminal-create container)) + (stacked (qt-edit-window-stacked-widget win)) + (session (qt-terminal-create stacked)) (jsh-path (or (getenv "JSH") "/usr/local/bin/jsh"))) (qt-terminal-set-font! session *default-font-family* *default-font-size*) (apply-terminal-theme-to-session! session) ;; Map the session BEFORE creating the view: the post-buffer-attach ;; hook may fire re-entrantly and must find the session to attach a view. (hash-put! *terminal-widget-map* buf session) - (let ((view (terminal-ensure-view! app buf session container))) - (qt-stacked-widget-set-current-widget! container view) + (let ((view (terminal-ensure-view! app buf session stacked))) + (qt-stacked-widget-set-current-widget! stacked view) ;; Focus before spawning so the session sizes the PTY from the real ;; pane before the shell prints its prompt. (qt-terminal-view-focus! view) @@ -1023,13 +1023,13 @@ modified so the next save uses the new encoding." (session (if (hash-get *terminal-copy-mode* buf) (echo-message! echo "Already in copy mode (vterm-copy-mode-done to exit)") - (let ((container (qt-edit-window-container win)) + (let ((stacked (qt-edit-window-stacked-widget win)) (text (qt-terminal-get-screen-text session))) (qt-plain-text-edit-set-read-only! ed #f) ;; allow the screen dump in (qt-plain-text-edit-set-text! ed text) (qt-terminal-apply-screen-styles! session ed) (qt-plain-text-edit-set-read-only! ed #t) - (qt-stacked-widget-set-current-widget! container ed) + (qt-stacked-widget-set-current-widget! stacked ed) (qt-widget-set-focus! ed) (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) (hash-put! *terminal-copy-mode* buf #t) @@ -1061,10 +1061,10 @@ modified so the next save uses the new encoding." (qt-plain-text-edit-copy! ed)))) ;; also to the system clipboard (qt-plain-text-edit-set-read-only! ed #f) ;; Restore the live terminal view for this window. - (let* ((container (qt-edit-window-container win)) - (view (terminal-view-for-container buf container))) + (let* ((stacked (qt-edit-window-stacked-widget win)) + (view (terminal-view-for-container buf stacked))) (when view - (qt-stacked-widget-set-current-widget! container view) + (qt-stacked-widget-set-current-widget! stacked view) (qt-terminal-view-focus! view))) (hash-put! *terminal-copy-mode* buf #f) (echo-message! echo "Copy mode done")) --- a/src/jerboa-emacs/qt/commands-core.ss +++ b/src/jerboa-emacs/qt/commands-core.ss @@ -1253,7 +1253,10 @@ Returns (path . line) or #f. Handles file:line format." (when text (qt-plain-text-edit-set-text! ed text) (qt-text-document-set-modified! (buffer-doc-pointer buf) #f) - (check-so-long! app buf text) + (let ((so-long? (check-so-long! app buf text))) + (if so-long? + (verbose-log! "revert: so-long skip highlighting") + (qt-setup-highlighting! app buf))) (qt-plain-text-edit-set-cursor-position! ed 0) (file-mtime-record! path) (echo-message! echo (string-append "Reverted " path)))) --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -74,24 +74,24 @@ ;; tear down only the view(s) in a dying container while the session lives on. (def *terminal-views-map* (make-hash-table-eq)) -(def (terminal-view-for-container buf container) - "Return the QTerminalView showing terminal BUF inside CONTAINER, or #f. - Containers are foreign pointers, so compare with equal? (via assoc)." +(def (terminal-view-for-container buf stacked) + "Return the QTerminalView showing terminal BUF inside STACKED, or #f. + Stacked widgets are foreign pointers, so compare with equal? (via assoc)." (let ((views (hash-get *terminal-views-map* buf))) - (cond ((and views (assoc container views)) => cdr) + (cond ((and views (assoc stacked views)) => cdr) (else #f)))) -(def (terminal-ensure-view! app buf session container) - "Get or create the QTerminalView showing SESSION inside CONTAINER. Adds it as +(def (terminal-ensure-view! app buf session stacked) + "Get or create the QTerminalView showing SESSION inside STACKED. Adds it as a QStackedWidget page and installs the consuming key filter exactly once. Returns the view." - (or (terminal-view-for-container buf container) - (let ((view (qt-terminal-view-create session container))) - (qt-stacked-widget-add-widget! container view) + (or (terminal-view-for-container buf stacked) + (let ((view (qt-terminal-view-create session stacked))) + (qt-stacked-widget-add-widget! stacked view) (let ((kh (app-state-key-handler app))) (when kh (kh view))) (hash-put! *terminal-views-map* buf - (cons (cons container view) + (cons (cons stacked view) (or (hash-get *terminal-views-map* buf) '()))) view))) --- a/src/jerboa-emacs/qt/image.ss +++ b/src/jerboa-emacs/qt/image.ss @@ -41,9 +41,9 @@ Creates QScrollArea + QLabel lazily on first call." (unless (qt-edit-window-image-scroll win) (verbose-log! "IMG: qt-ensure-image-widget! creating widgets") - (let* ((container (qt-edit-window-container win))) + (let* ((stacked (qt-edit-window-stacked-widget win))) (verbose-log! "IMG: creating scroll area") - (let ((scroll (qt-scroll-area-create container))) + (let ((scroll (qt-scroll-area-create stacked))) (verbose-log! "IMG: scroll area created, creating label") (let ((label (qt-label-create "" scroll))) (verbose-log! "IMG: label created, configuring") @@ -52,7 +52,7 @@ (qt-widget-set-style-sheet! scroll "background: #202020;") (qt-label-set-alignment! label (bitwise-ior QT_ALIGN_CENTER QT_ALIGN_CENTER)) (verbose-log! "IMG: adding scroll to stacked widget") - (qt-stacked-widget-add-widget! container scroll) + (qt-stacked-widget-add-widget! stacked scroll) (verbose-log! "IMG: stacked widget add done") (set! (qt-edit-window-image-scroll win) scroll) (set! (qt-edit-window-image-label win) label)))))) @@ -71,7 +71,7 @@ (when win (qt-ensure-image-widget! win) (let* ((state (hash-get *image-buffer-state* buf)) - (container (qt-edit-window-container win)) + (stacked (qt-edit-window-stacked-widget win)) (label (qt-edit-window-image-label win))) (when state (let* ((pixmap (list-ref state 0)) @@ -92,15 +92,15 @@ (let ((scaled (qt-pixmap-scaled pixmap new-w new-h))) (qt-label-set-pixmap! label scaled) (qt-widget-set-minimum-size! label new-w new-h)))))) - (qt-stacked-widget-set-current-index! container 1) + (qt-stacked-widget-set-current-index! stacked 1) (verbose-log! "IMG: display done"))))))) (def (qt-hide-image-buffer! editor) "Switch the stacked widget back to the editor view (index 0)." (let ((win (hash-get *editor-window-map* editor))) (when win - (let ((container (qt-edit-window-container win))) - (qt-stacked-widget-set-current-index! container 0))))) + (let ((stacked (qt-edit-window-stacked-widget win))) + (qt-stacked-widget-set-current-index! stacked 0))))) (def (qt-image-zoom! app editor buf factor) "Zoom the image buffer by FACTOR. Use 'fit for fit-to-window, 'reset for 100%." --- a/src/jerboa-emacs/qt/modeline.ss +++ b/src/jerboa-emacs/qt/modeline.ss @@ -74,64 +74,71 @@ (def *modeline-overwrite-provider* (box #f)) (def *modeline-narrow-provider* (box #f)) -(def (qt-modeline-update-dired! app ed buf) +(def (update-dired-modeline modeline-label ed buf) (let* ((line (+ 1 (qt-plain-text-edit-cursor-line ed))) (info (string-append "-U:%%- " (buffer-name buf) " L" (number->string line) " (Dired)"))) - (qt-main-window-set-status-bar-text! (qt-frame-main-win (app-state-frame app)) info))) + (qt-label-set-text! modeline-label info))) + +(def (update-regular-modeline modeline-label ed buf) + (let* ((line (+ 1 (qt-plain-text-edit-cursor-line ed))) + (col (+ 1 (qt-plain-text-edit-cursor-column ed))) + (total-lines (qt-plain-text-edit-line-count ed)) + (mod? (qt-text-document-modified? (buffer-doc-pointer buf))) + (ro? (qt-plain-text-edit-read-only? ed)) + (pct (cond + ((<= total-lines 1) "All") + ((= line 1) "Top") + ((= line total-lines) "Bot") + (else (string-append + (number->string + (inexact->exact (round (* 100 (/ (- line 1) + (max 1 (- total-lines 1))))))) + "%")))) + (state-str (cond + ((and ro? mod?) "%*") + (ro? "%%") + (mod? "**") + (else "--"))) + (mode (mode-name-for-buffer buf)) + (eol (buffer-eol-indicator buf)) + (branch (git-branch-for-file (buffer-file-path buf))) + (lsp-provider (unbox *lsp-modeline-provider*)) + (lsp-str (if lsp-provider (lsp-provider) #f)) + (ovr-provider (unbox *modeline-overwrite-provider*)) + (ovr? (and ovr-provider (ovr-provider))) + (nar-provider (unbox *modeline-narrow-provider*)) + (nar? (and nar-provider (nar-provider buf))) + (info (string-append + "-U:" state-str "- " + (if nar? "Narrow " "") + (buffer-name buf) " " + "L" (number->string line) + " C" (number->string col) + " " pct + " (" mode + (if ovr? " Ovwrt" "") + " " eol ")" + (if branch + (string-append " " branch) + "") + (if lsp-str + (string-append " " lsp-str) + "")))) + (qt-label-set-text! modeline-label info))) (def (qt-modeline-update! app) (let* ((fr (app-state-frame app)) - (win (qt-current-window fr)) - (ed (qt-edit-window-editor win)) - (buf (qt-edit-window-buffer win))) - (if (eq? (buffer-lexer-lang buf) 'dired) - (qt-modeline-update-dired! app ed buf) - (let* ((line (+ 1 (qt-plain-text-edit-cursor-line ed))) - (col (+ 1 (qt-plain-text-edit-cursor-column ed))) - (total-lines (qt-plain-text-edit-line-count ed)) - (mod? (qt-text-document-modified? (buffer-doc-pointer buf))) - (ro? (qt-plain-text-edit-read-only? ed)) - (pct (cond - ((<= total-lines 1) "All") - ((= line 1) "Top") - ((= line total-lines) "Bot") - (else (string-append - (number->string - (inexact->exact (round (* 100 (/ (- line 1) - (max 1 (- total-lines 1))))))) - "%")))) - (state-str (cond - ((and ro? mod?) "%*") - (ro? "%%") - (mod? "**") - (else "--"))) - (mode (mode-name-for-buffer buf)) - (eol (buffer-eol-indicator buf)) - (branch (git-branch-for-file (buffer-file-path buf))) - (lsp-provider (unbox *lsp-modeline-provider*)) - (lsp-str (if lsp-provider (lsp-provider) #f)) - (ovr-provider (unbox *modeline-overwrite-provider*)) - (ovr? (and ovr-provider (ovr-provider))) - (nar-provider (unbox *modeline-narrow-provider*)) - (nar? (and nar-provider (nar-provider buf))) - (info (string-append - "-U:" state-str "- " - (if nar? "Narrow " "") - (buffer-name buf) " " - "L" (number->string line) - " C" (number->string col) - " " pct - " (" mode - (if ovr? " Ovwrt" "") - " " eol ")" - (if branch - (string-append " " branch) - "") - (if lsp-str - (string-append " " lsp-str) - "")))) - (qt-main-window-set-status-bar-text! (qt-frame-main-win fr) info))))) + (windows (qt-frame-windows fr))) + (for-each (lambda (win) + (let* ((ed (qt-edit-window-editor win)) + (buf (qt-edit-window-buffer win)) + (modeline-label (qt-edit-window-modeline-label win))) + (when modeline-label + (if (eq? (buffer-lexer-lang buf) 'dired) + (update-dired-modeline modeline-label ed buf) + (update-regular-modeline modeline-label ed buf))))) + windows))) --- a/src/jerboa-emacs/qt/window.ss +++ b/src/jerboa-emacs/qt/window.ss @@ -95,11 +95,13 @@ (defstruct qt-edit-window (editor ; QScintilla editor pointer - container ; QStackedWidget wrapping editor + image widget + container ; QWidget wrapper (parent widget in splitter) buffer ; buffer struct line-number-area ; line-number-area pointer or #f image-scroll ; QScrollArea for image display, or #f (lazy) - image-label) ; QLabel inside scroll area, or #f (lazy) + image-label ; QLabel inside scroll area, or #f (lazy) + stacked-widget ; QStackedWidget inside container, or #f + modeline-label) ; QLabel at bottom of container, or #f transparent: #t) ;;; A split-leaf wraps a single edit window. @@ -556,16 +558,30 @@ When INSERT-INDEX is provided, insert the container at that splitter index." (qt-window-check-handle! "qt-make-new-window!" "container parent" container-parent) - (let* ((container (qt-stacked-widget-create container-parent)) - (new-ed (qt-plain-text-edit-create parent: container)) + (let* ((container (qt-widget-create container-parent)) + (vbox (qt-vbox-layout-create container)) + (stacked (qt-stacked-widget-create container)) + (modeline-label (qt-label-create "" container)) + (new-ed (qt-plain-text-edit-create parent: stacked)) (lna (qt-line-number-area-create new-ed)) - (new-win (make-qt-edit-window new-ed container buf lna #f #f))) + (new-win (make-qt-edit-window new-ed container buf lna #f #f + stacked modeline-label))) (qt-scintilla-setup-editor! new-ed) + ;; Layout: stacked widget fills most of the space, modeline label at bottom + (qt-layout-add-widget! vbox stacked 1) + (qt-layout-add-widget! vbox modeline-label 0) + (qt-layout-set-margins! vbox 0 0 0 0) + (qt-layout-set-spacing! vbox 0) + (qt-widget-set-minimum-height! modeline-label 18) + (qt-widget-set-maximum-height! modeline-label 18) + ;; Modeline label style: dark background, lighter text + (qt-widget-set-style-sheet! modeline-label + "background: #303030; color: #d4d4d4; font-size: 10px; padding: 1px 4px;") ;; Add the editor as stacked page 0 and register the window BEFORE attaching ;; the buffer. qt-buffer-attach! runs the post-buffer-attach hook, which for a ;; terminal buffer adds a QTerminalView as a later page — it needs the editor ;; already present as page 0 and the window resolvable via *editor-window-map*. - (qt-stacked-widget-add-widget! container new-ed) + (qt-stacked-widget-add-widget! stacked new-ed) (hash-put! *editor-window-map* new-ed new-win) (qt-buffer-attach! new-ed buf) ;; Force font family+size on all styles (0-127). @@ -599,15 +615,28 @@ (def (qt-frame-init! main-win splitter) "Create frame with one QScintilla editor in a QStackedWidget in a QSplitter. Returns the frame struct." - (let* ((container (qt-stacked-widget-create splitter)) - (editor (qt-plain-text-edit-create parent: container)) + (let* ((container (qt-widget-create splitter)) + (vbox (qt-vbox-layout-create container)) + (stacked (qt-stacked-widget-create container)) + (modeline-label (qt-label-create "" container)) + (editor (qt-plain-text-edit-create parent: stacked)) (buf (qt-buffer-create! buffer-scratch-name editor)) (lna (qt-line-number-area-create editor)) - (win (make-qt-edit-window editor container buf lna #f #f))) + (win (make-qt-edit-window editor container buf lna #f #f + stacked modeline-label))) (qt-scintilla-setup-editor! editor) + ;; Layout: stacked widget fills most, modeline label at bottom + (qt-layout-add-widget! vbox stacked 1) + (qt-layout-add-widget! vbox modeline-label 0) + (qt-layout-set-margins! vbox 0 0 0 0) + (qt-layout-set-spacing! vbox 0) + (qt-widget-set-minimum-height! modeline-label 18) + (qt-widget-set-maximum-height! modeline-label 18) + (qt-widget-set-style-sheet! modeline-label + "background: #303030; color: #d4d4d4; font-size: 10px; padding: 1px 4px;") ;; Register the window and add the editor as page 0 before attaching the ;; buffer (keeps the post-buffer-attach hook's window/page lookups valid). - (qt-stacked-widget-add-widget! container editor) + (qt-stacked-widget-add-widget! stacked editor) (hash-put! *editor-window-map* editor win) (qt-buffer-attach! editor buf) (qt-safe-splitter-add-widget! "qt-frame-init!" splitter container)