Drop generated SLS from vterm split commit
ober
e8acec56aea1a9875186ff145164467e4d6c4b34
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -10,11 +10,11 @@ mutex? mutex-name) (std sugar) (std misc string) (jerboa-scintilla constants) (jerboa-emacs qt sci-shim) - (except (jerboa-qt qt) QT_MOD_NONE QT_MOD_SHIFT - QT_MOD_CONTROL QT_MOD_ALT QT_MOD_META QT_KEY_ESCAPE - QT_KEY_BACKSPACE QT_KEY_RETURN QT_KEY_ENTER QT_KEY_DELETE - QT_KEY_TAB QT_KEY_BACKTAB QT_KEY_INSERT QT_KEY_HOME - QT_KEY_END QT_KEY_LEFT QT_KEY_RIGHT QT_KEY_UP QT_KEY_DOWN + (except (jerboa-qt qt) QT_MOD_NONE QT_MOD_SHIFT QT_MOD_CONTROL + QT_MOD_ALT QT_MOD_META QT_KEY_ESCAPE QT_KEY_BACKSPACE + QT_KEY_RETURN QT_KEY_ENTER QT_KEY_DELETE QT_KEY_TAB + QT_KEY_BACKTAB QT_KEY_INSERT QT_KEY_HOME QT_KEY_END + QT_KEY_LEFT QT_KEY_RIGHT QT_KEY_UP QT_KEY_DOWN QT_KEY_PAGE_UP QT_KEY_PAGE_DOWN QT_KEY_SPACE QT_KEY_F1 QT_KEY_F2 QT_KEY_F3 QT_KEY_F4 QT_KEY_F5 QT_KEY_F6 QT_KEY_F7 QT_KEY_F8 QT_KEY_F9 QT_KEY_F10 QT_KEY_F11 QT_KEY_F12 @@ -775,7 +775,8 @@ "commands registered: " (number->string (hash-length *all-commands*)) " total") - (let ([image-key-installed (make-hash-table-eq)]) + (let ([image-key-installed (make-hash-table-eq)] + [terminal-key-installed (make-hash-table-eq)]) (add-hook! 'post-buffer-attach-hook (lambda (editor buf) @@ -788,23 +789,24 @@ (lambda () (cond [(hash-get *terminal-widget-map* buf) => - (lambda (session) + (lambda (term) (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) - (when (eq? win - (qt-current-window - (app-state-frame app))) - (qt-terminal-view-focus! view))))))] + [count (qt-stacked-widget-count + container)] + [tw (qt-terminal-widget term)]) + (unless (hash-get terminal-key-installed tw) + ((app-state-key-handler app) tw) + (hash-put! terminal-key-installed tw #t)) + (if (> count 1) + (begin + (qt-stacked-widget-set-current-widget! + container + tw) + (qt-widget-set-focus! tw)) + (qt-widget-set-focus! editor))))))] [(image-buffer? buf) (qt-show-image-buffer! editor buf) (let ([win (hash-get *editor-window-map* editor)]) @@ -1577,21 +1579,10 @@ qt-buf))] [key-src-widget (qt-last-key-widget)] [key-from-terminal? (and qt-term - (let loop ([views (or (hash-get - *terminal-views-map* - qt-buf) - '())]) - (cond - [(null? - views) - #f] - [(equal? - key-src-widget - (cdr (car views))) - #t] - [else - (loop - (cdr views))])))]) + (equal? + key-src-widget + (qt-terminal-widget + qt-term)))]) (if (and qt-term key-from-terminal? (null? @@ -1848,52 +1839,30 @@ (qt-on-key-press-consuming! editor key-handler))) (automation-set-key-target-fn! (lambda (fr) - (let* ([win (qt-current-window fr)] - [buf (qt-edit-window-buffer win)] - [view (and buf - (hash-get *terminal-widget-map* buf) - (terminal-view-for-container - buf - (qt-edit-window-container win)))]) - (or view (qt-current-editor fr))))) + (let* ([buf (qt-current-buffer fr)] + [term (and buf + (hash-get *terminal-widget-map* buf))]) + (if term + (qt-terminal-widget term) + (qt-current-editor fr))))) (qt-window-set-pre-container-destroy-fn! (lambda (container) - (let ([entries '()]) + (let ([bufs-to-remove '()]) (hash-for-each - (lambda (buf views) - (set! entries (cons (cons buf views) entries))) - *terminal-views-map*) + (lambda (buf stored-container) + (when (equal? stored-container container) + (let ([term (hash-get *terminal-widget-map* buf)]) + (when term + (with-catch + (lambda (e) #f) + (lambda () (qt-terminal-destroy! term))))) + (set! bufs-to-remove (cons buf bufs-to-remove)))) + *terminal-container-map*) (for-each - (lambda (e) - (let* ([buf (car e)] - [views (cdr e)] - [mine (filter - (lambda (cv) - (equal? (car cv) container)) - views)] - [rest (filter - (lambda (cv) - (not (equal? (car cv) container))) - views)]) - (unless (null? mine) - (for-each - (lambda (cv) - (with-catch - (lambda (e) #f) - (lambda () - (qt-terminal-view-destroy! (cdr cv))))) - mine) - (hash-put! *terminal-views-map* buf rest)))) - entries))))) - (qt-window-set-post-split-focus-fn! - (lambda (new-win) - (let* ([buf (qt-edit-window-buffer new-win)] - [session (and buf - (hash-get *terminal-widget-map* buf))]) - (and session - (terminal-view-for-container - buf - (qt-edit-window-container new-win)))))) + (lambda (buf) + (hash-remove! *terminal-widget-map* buf) + (hash-remove! *terminal-container-map* buf)) + bufs-to-remove))))) (schedule-periodic! 'repl-poll 50 @@ -2608,16 +2577,19 @@ (let* ([fr (app-state-frame app)] [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)]) - (and session - (terminal-view-for-container buf container) - (> (qt-stacked-widget-current-index container) - 0) - #t)))) + [term (and buf + (hash-get + *terminal-widget-map* + buf))]) + (and term + (let* ([container (qt-edit-window-container + win)] + [count (qt-stacked-widget-count + container)]) + (and (> count 1) + (> (qt-stacked-widget-current-index + container) + 0))))))) (cons 'test-reset! (lambda () @@ -2625,15 +2597,17 @@ (let ([term-bufs (hash-keys *terminal-widget-map*)]) (for-each (lambda (buf) - (let ([session (hash-get - *terminal-widget-map* - buf)]) - (when session + (let ([term (hash-get + *terminal-widget-map* + buf)]) + (when term (with-catch (lambda (e) #f) - (lambda () (qt-terminal-destroy! session))) + (lambda () (qt-terminal-destroy! term))) (hash-remove! *terminal-widget-map* buf) - (hash-remove! *terminal-views-map* buf)))) + (hash-remove! + *terminal-container-map* + buf)))) term-bufs)) (when (> (length (qt-frame-windows (app-state-frame app))) --- a/lib/jerboa-emacs/qt/commands-config.sls +++ b/lib/jerboa-emacs/qt/commands-config.sls @@ -899,8 +899,8 @@ (loop (cdr segs) (+ pos text-len))))))) (define terminal-buffer-counter--cell (vector 0)) (def (cmd-term app) - "Open a QTerminalSession-backed terminal running jsh as the shell.\n The session is shared by all windows showing the buffer; each window gets\n its own QTerminalView, so splitting the window shows the same live terminal." - (verbose-log! "cmd-term: begin (QTerminalSession + jsh)") + "Open a QTerminalWidget-backed terminal running jsh as the shell." + (verbose-log! "cmd-term: begin (QTerminalWidget + jsh)") (let* ([fr (app-state-frame app)] [ed (current-qt-editor app)] [name (begin @@ -927,22 +927,24 @@ (lambda () (let* ([win (qt-current-window fr)] [container (qt-edit-window-container win)] - [session (qt-terminal-create container)] + [term (qt-terminal-create container)] [jsh-path (or (getenv "JSH") "/usr/local/bin/jsh")]) (qt-terminal-set-font! - session + term *default-font-family* *default-font-size*) - (qt-terminal-set-colors! session 12305103 2632756) - (hash-put! *terminal-widget-map* buf session) - (let ([view (terminal-ensure-view! - app - buf - session - container)]) - (qt-stacked-widget-set-current-widget! container view) - (qt-terminal-view-focus! view) - (qt-terminal-spawn! session jsh-path)) + (qt-terminal-set-colors! term 12305103 2632756) + (qt-stacked-widget-add-widget! + container + (qt-terminal-widget term)) + (qt-stacked-widget-set-current-widget! + container + (qt-terminal-widget term)) + (qt-terminal-spawn! term jsh-path) + (hash-put! *terminal-widget-map* buf term) + (hash-put! *terminal-container-map* buf container) + ((app-state-key-handler app) (qt-terminal-widget term)) + (qt-terminal-focus! term) (verbose-log! "cmd-term: spawned jsh=" jsh-path) (echo-message! (app-state-echo app) --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -4,8 +4,7 @@ (library (jerboa-emacs qt commands-shell) (export directory-exists? *terminal-widget-map* - *terminal-views-map* terminal-view-for-container - terminal-ensure-view! apply-font-size-to-all-editors! + *terminal-container-map* apply-font-size-to-all-editors! cmd-increase-font-size cmd-decrease-font-size cmd-reset-font-size cmd-goto-first-non-blank cmd-goto-last-non-blank cmd-move-to-window-top @@ -119,27 +118,8 @@ (and (file-exists? path) (file-directory? path))) (define *terminal-widget-map*--cell (vector (make-hash-table-eq))) - (define *terminal-views-map*--cell + (define *terminal-container-map*--cell (vector (make-hash-table-eq))) - (def (terminal-view-for-container buf container) - "Return the QTerminalView showing terminal BUF inside CONTAINER, or #f.\n Containers are foreign pointers, so compare with equal? (via assoc)." - (let ([views (hash-get *terminal-views-map* buf)]) - (cond - [(and views (assoc container views)) => cdr] - [else #f]))) - (def (terminal-ensure-view! app buf session container) - "Get or create the QTerminalView showing SESSION inside CONTAINER. Adds it as\n a QStackedWidget page and installs the consuming key filter exactly once.\n 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) - (let ([kh (app-state-key-handler app)]) (when kh (kh view))) - (hash-put! - *terminal-views-map* - buf - (cons - (cons container view) - (or (hash-get *terminal-views-map* buf) '()))) - view))) (def (apply-font-size-to-all-editors! app) "Apply the current global font size to all open editors." (let ([fr (app-state-frame app)] @@ -2300,11 +2280,11 @@ *terminal-widget-map*--cell 0 val)])) - (define-syntax *terminal-views-map* + (define-syntax *terminal-container-map* (identifier-syntax - [id (vector-ref *terminal-views-map*--cell 0)] + [id (vector-ref *terminal-container-map*--cell 0)] [(set! id val) (vector-set! - *terminal-views-map*--cell + *terminal-container-map*--cell 0 val)])) (define-syntax *auto-indent* --- a/lib/jerboa-emacs/qt/commands.sls +++ b/lib/jerboa-emacs/qt/commands.sls @@ -5,8 +5,7 @@ (library (jerboa-emacs qt commands) (export qt-register-all-commands! dired-open-directory! qt-open-image-inline! *qt-app-ptr* *terminal-widget-map* - *terminal-views-map* terminal-view-for-container - terminal-ensure-view! qt-kill-ring-push! *isearch-active* + *terminal-container-map* qt-kill-ring-push! *isearch-active* isearch-handle-key! *qreplace-active* qreplace-handle-key! recent-files-add! recent-files-load! bookmarks-load! session-save! session-restore-files *tab-bar-visible* @@ -663,15 +662,6 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) - (let ([session (hash-get - *terminal-widget-map* - buf)]) - (when session - (with-catch - (lambda (e) #f) - (lambda () (qt-terminal-destroy! session))) - (hash-remove! *terminal-widget-map* buf) - (hash-remove! *terminal-views-map* buf))) (let ([cs (hash-get *chat-state* buf)]) (when cs (chat-stop! cs) @@ -720,13 +710,6 @@ (when ts (terminal-stop! ts) (hash-remove! *terminal-state* buf))) - (let ([session (hash-get *terminal-widget-map* buf)]) - (when session - (with-catch - (lambda (e) #f) - (lambda () (qt-terminal-destroy! session))) - (hash-remove! *terminal-widget-map* buf) - (hash-remove! *terminal-views-map* buf))) (let ([cs (hash-get *chat-state* buf)]) (when cs (chat-stop! cs) (hash-remove! *chat-state* buf))) (set! *buffer-recent* --- a/lib/jerboa-emacs/qt/sci-shim.sls +++ b/lib/jerboa-emacs/qt/sci-shim.sls @@ -142,8 +142,7 @@ qt-terminal-send-input! qt-terminal-is-running? qt-terminal-interrupt! qt-terminal-set-font! qt-terminal-set-colors! qt-terminal-focus! - qt-terminal-widget qt-terminal-view-create - qt-terminal-view-destroy! qt-terminal-view-focus!) + qt-terminal-widget) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -670,24 +669,9 @@ "Give keyboard focus to the terminal widget." ((foreign-procedure "qt_terminal_focus" (void*) void) term)) (def (qt-terminal-widget term) - "Return a representative view (active-or-first) of the terminal SESSION as a\n QWidget* pointer. Compatibility shim — prefer qt-terminal-view-* for views." + "Return the QWidget* pointer for the terminal (for adding to QStackedWidget)." ((foreign-procedure "qt_terminal_widget" (void*) void*) term)) - (def (qt-terminal-view-create session parent) - "Create a QTerminalView of SESSION parented into PARENT (a QStackedWidget).\n Registers the view with the session; returns the view's QWidget* pointer." - ((foreign-procedure "qt_terminal_view_create" - (void* void*) - void*) - session - parent)) - (def (qt-terminal-view-destroy! view) - "Destroy a single terminal VIEW (detach from its stack, unregister, delete).\n The owning session and its PTY/shell are left running." - ((foreign-procedure "qt_terminal_view_destroy" (void*) void) - view)) - (def (qt-terminal-view-focus! view) - "Give keyboard focus to a specific terminal VIEW." - ((foreign-procedure "qt_terminal_view_focus" (void*) void) - view)) (define-syntax *doc-editor-map* (identifier-syntax [id (vector-ref *doc-editor-map*--cell 0)] --- a/lib/jerboa-emacs/qt/window.sls +++ b/lib/jerboa-emacs/qt/window.sls @@ -29,8 +29,7 @@ qt-apply-editor-theme! split-tree-flatten split-tree-find-parent split-tree-find-leaf split-tree-collect-sub-splitters qt-window-set-app-ptr! - qt-window-set-pre-container-destroy-fn! - qt-window-set-post-split-focus-fn!) + qt-window-set-pre-container-destroy-fn!) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -45,9 +44,6 @@ (def *pre-container-destroy-fn* #f) (def (qt-window-set-pre-container-destroy-fn! fn) (set! *pre-container-destroy-fn* fn)) - (def *post-split-focus-fn* #f) - (def (qt-window-set-post-split-focus-fn! fn) - (set! *post-split-focus-fn* fn)) (def (qt-window-pre-container-destroy! container) (when *pre-container-destroy-fn* (*pre-container-destroy-fn* container))) @@ -534,8 +530,6 @@ [new-win (make-qt-edit-window new-ed container buf lna #f #f)]) (qt-scintilla-setup-editor! new-ed) - (qt-stacked-widget-add-widget! container new-ed) - (hash-put! *editor-window-map* new-ed new-win) (qt-buffer-attach! new-ed buf) (let loop ([i 0]) (when (<= i 127) @@ -562,6 +556,7 @@ SCI_STYLESETFORE STYLE_LINENUMBER (rgb->sci r g b))))) + (qt-stacked-widget-add-widget! container new-ed) (if insert-index (qt-safe-splitter-insert-widget! "qt-make-new-window!" @@ -572,6 +567,7 @@ "qt-make-new-window!" container-parent container)) + (hash-put! *editor-window-map* new-ed new-win) new-win)) (def (qt-frame-init! main-win splitter) "Create frame with one QScintilla editor in a QStackedWidget in a QSplitter.\n Returns the frame struct." @@ -581,13 +577,13 @@ [lna (qt-line-number-area-create editor)] [win (make-qt-edit-window editor container buf lna #f #f)]) (qt-scintilla-setup-editor! editor) - (qt-stacked-widget-add-widget! container editor) - (hash-put! *editor-window-map* editor win) (qt-buffer-attach! editor buf) + (qt-stacked-widget-add-widget! container editor) (qt-safe-splitter-add-widget! "qt-frame-init!" splitter container) + (hash-put! *editor-window-map* editor win) (let* ([root (make-split-leaf win)] [fr (make-qt-frame splitter root (list win) 0 main-win)]) (qt-frame-update-visual-indicators! fr) @@ -601,7 +597,16 @@ [cur-leaf (split-tree-find-leaf (qt-frame-root fr) cur-win)] [parent (split-tree-find-parent (qt-frame-root fr) cur-win)] [cur-buf (qt-edit-window-buffer cur-win)] - [new-buf cur-buf] + [new-buf (if (eq? (buffer-lexer-lang cur-buf) 'terminal) + (or (find + (lambda (b) + (string=? + (buffer-name b) + buffer-scratch-name)) + (map qt-edit-window-buffer + (qt-frame-windows fr))) + cur-buf) + cur-buf)] [main-win (qt-frame-main-win fr)] [saved-w (and main-win (qt-widget-width main-win))] [saved-h (and main-win (qt-widget-height main-win))]) @@ -754,14 +759,7 @@ saved-w saved-h)) (when result - (let ([override (and *post-split-focus-fn* - (*post-split-focus-fn* - (list-ref - (qt-frame-windows fr) - (qt-frame-current-idx fr))))]) - (qt-safe-widget-set-focus! - "qt-frame-do-split!" - (or override result)))) + (qt-safe-widget-set-focus! "qt-frame-do-split!" result)) (qt-frame-update-visual-indicators! fr) (when main-win (qt-safe-widget-set-updates-enabled!