Fix image open hang and helm file narrowing extension drop
ober
04945e7283678aead41f911e037739655390d6c6
--- a/.gitignore +++ b/.gitignore @@ -10,3 +10,6 @@ lib/**/*.wpo # Build symlinks / local artifacts libjsh-ffi.so + +# Vendored repos (cloned, not submodules) +vendor/jerboa-shell/ --- a/Makefile +++ b/Makefile @@ -1,10 +1,10 @@ SCHEME = scheme JERBOA = $(HOME)/mine/jerboa -JSH = $(HOME)/mine/jerboa-shell/src +JSH = vendor/jerboa-shell/src GHERKIN = $(HOME)/mine/gherkin/src LIBDIRS = --libdirs lib:$(JERBOA)/lib:$(JSH):$(GHERKIN):$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla/src:$(HOME)/mine/chez-qt JERBUILD = $(SCHEME) --libdirs $(JERBOA)/lib --script $(JERBOA)/jerbuild.ss -export LD_LIBRARY_PATH := .:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/chez-qt:$(HOME)/mine/gerbil-qt/vendor:$(HOME)/mine/jerboa-shell:$(LD_LIBRARY_PATH) +export LD_LIBRARY_PATH := .:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/chez-qt:$(HOME)/mine/gerbil-qt/vendor:vendor/jerboa-shell:$(LD_LIBRARY_PATH) export CHEZ_SCINTILLA_LIB := $(HOME)/mine/chez-scintilla export CHEZ_PCRE2_LIB := $(HOME)/mine/chez-pcre2 export CHEZ_QT_LIB := $(HOME)/mine/chez-qt @@ -14,7 +14,7 @@ export CHEZ_QT_SHIM_DIR := $(HOME)/mine/gerbil-qt/vendor test-org-duration test-org-element test-org-fold test-org-footnote \ test-org-lint test-org-num test-org-property test-org-src test-org-tempo \ test-vtscreen test-debug-repl test-qt build-qt binary binary-qt \ - test-emacs test-functional test-term-hang \ + test-pty test-emacs test-functional test-term-hang \ docker-deps static-qt clean-docker check-root build-jemacs-qt-static all: build test @@ -33,7 +33,18 @@ run: build repl_shim.so: support/repl_shim.c gcc -shared -fPIC -O2 -o repl_shim.so support/repl_shim.c -Wall -run-qt: build repl_shim.so +QT_INC := $(shell qmake6 -query QT_INSTALL_HEADERS 2>/dev/null || echo /usr/include/x86_64-linux-gnu/qt6) +QT_SHIM_H := $(HOME)/mine/gerbil-qt/vendor + +libqt_shim.so: vendor/qt_shim.cpp + g++ -shared -fPIC -std=c++17 -O2 \ + -DJEMACS_CHEZ_SMP -DQT_SCINTILLA_AVAILABLE \ + -I$(QT_SHIM_H) -I$(QT_INC) -I$(QT_INC)/QtCore -I$(QT_INC)/QtGui -I$(QT_INC)/QtWidgets -I$(QT_INC)/Qsci \ + vendor/qt_shim.cpp \ + -o libqt_shim.so \ + -lQt6Core -lQt6Gui -lQt6Widgets -lqscintilla2_qt6 + +run-qt: build repl_shim.so libqt_shim.so $(SCHEME) $(LIBDIRS) --script qt-main.ss # Qt backend build target @@ -170,7 +181,8 @@ test-debug-repl: $(SCHEME) $(LIBDIRS) --program tests/test-debug-repl.ss test-qt: build - QT_QPA_PLATFORM=offscreen $(SCHEME) $(LIBDIRS) --script tests/test-qt.ss + QT_QPA_PLATFORM=offscreen LD_PRELOAD=./qt_chez_shim.so $(SCHEME) $(LIBDIRS) --script tests/test-qt.ss + QT_QPA_PLATFORM=offscreen LD_PRELOAD=./qt_chez_shim.so $(SCHEME) $(LIBDIRS) --script tests/test-qt-part2.ss test-emacs: $(SCHEME) $(LIBDIRS) --program tests/test-emacs.ss @@ -178,6 +190,9 @@ test-emacs: test-functional: $(SCHEME) $(LIBDIRS) --program tests/test-functional.ss +test-pty: + $(SCHEME) $(LIBDIRS) --script tests/test-pty.ss + test-term-hang: $(SCHEME) $(LIBDIRS) --program tests/test-term-hang.ss @@ -248,7 +263,7 @@ build-jemacs-qt-static: check-root -I/opt/qt6-static/include/QtGui -I/opt/qt6-static/include/QtWidgets") && \ QSCI_FLAGS="-DQT_SCINTILLA_AVAILABLE -I/opt/qt6-static/include -I/opt/qt6-static/include/Qsci" && \ cp /src/vendor/qt_shim.cpp /deps/gerbil-qt/vendor/qt_shim.cpp && \ - g++ -c -fPIC -std=c++17 $$QT_CFLAGS $$QSCI_FLAGS \ + g++ -c -fPIC -std=c++17 -DJEMACS_CHEZ_SMP $$QT_CFLAGS $$QSCI_FLAGS \ /deps/gerbil-qt/vendor/qt_shim.cpp \ -o /deps/gerbil-qt/vendor/qt_shim_static.o && \ ar rcs /deps/gerbil-qt/vendor/libqt_shim.a \ --- a/build-binary-qt.ss +++ b/build-binary-qt.ss @@ -69,7 +69,7 @@ (format "~a/mine/gherkin/src" home))) (define jsh-dir (or (getenv "JSH_DIR") - (format "~a/mine/jerboa-shell/src" home))) + (format "~a/mine/jerboa-emacs/vendor/jerboa-shell/src" home))) (define pcre2-dir (or (getenv "CHEZ_PCRE2_DIR") (format "~a/mine/chez-pcre2" home))) @@ -96,8 +96,8 @@ (exit 1))) (list (format "~a/jerboa/core.so" jerboa-dir) (if jemacs-static? - (format "~a/qt_chez_shim.o" qt-dir) - (format "~a/qt_chez_shim.so" qt-dir)) + "jemacs-qt-chez-shim.o" ;; built locally from vendor/qt_chez_shim.c + "qt_chez_shim.so") (if jemacs-static? (format "~a/pcre2_shim.o" pcre2-dir) (format "~a/pcre2_shim.so" pcre2-dir)) @@ -183,23 +183,49 @@ "runtime/mop")) ;; compat/gambit lives in jsh (not gherkin) (list (format "~a/compat/gambit.so" jsh-dir)) - ;; jsh modules (WPO-missing) + ;; jsh modules (WPO-missing, all needed transitively) (map (lambda (m) (format "~a/jsh/~a.so" jsh-dir m)) '("embed" "embed-data" + "ffi" + "static-compat" + "pregexp-compat" + "util" "arithmetic" - "functions" "ast" "environment" "registry" - "ffi" - "static-compat")) + "functions" + "signals" + "glob" + "expander" + "lexer" + "parser" + "redirect" + "pipeline" + "jobs" + "builtins" + "executor" + "control" + "script" + "macros" + "completion" + "fuzzy" + "fzf" + "history" + "prompt" + "lineedit" + "startup" + "stage" + "lib")) ;; chez-pcre2 (compiled by step 1) (map (lambda (m) (format "~a/chez-pcre2/~a.so" pcre2-dir m)) '("ffi" "pcre2")) - ;; chez-scintilla: ffi (patched to skip load-shared-object in static builds) + constants + ;; std/net/request (WPO-missing) + (list (format "~a/std/net/request.so" jerboa-dir)) + ;; chez-scintilla (all modules — WPO-missing) (map (lambda (m) (format "~a/chez-scintilla/~a.so" sci-dir m)) - '("ffi" "constants")) + '("ffi" "constants" "style" "lexer" "scintilla" "tui")) ;; chez-qt (map (lambda (m) (format "~a/chez-qt/~a.so" qt-dir m)) '("ffi" "qt")) @@ -312,13 +338,21 @@ (display "Error: pcre2 shim compilation failed\n") (exit 1))) -;; qt_chez_shim -(let* ((qt-cflags (shell-output "pkg-config --cflags Qt6Widgets" "")) - (cmd (format "gcc -c -O2 -DQT_SCINTILLA_AVAILABLE -o jemacs-qt-chez-shim.o ~a/qt_chez_shim.c -I~a ~a -Wall 2>&1" - qt-dir qt-shim-dir qt-cflags))) - (unless (= 0 (system cmd)) - (display "Error: qt_chez_shim compilation failed\n") - (exit 1))) +;; qt_chez_shim — use jerboa-emacs deferred-callback version (avoids Sactivate_thread GC deadlock) +(let* ((qt-cflags (shell-output "pkg-config --cflags Qt6Widgets" ""))) + ;; Static .o for static builds + (let ((cmd (format "gcc -c -O2 -DQT_SCINTILLA_AVAILABLE -o jemacs-qt-chez-shim.o vendor/qt_chez_shim.c -I~a ~a -Wall 2>&1" + qt-shim-dir qt-cflags))) + (unless (= 0 (system cmd)) + (display "Error: qt_chez_shim compilation failed\n") + (exit 1))) + ;; Shared .so for dynamic builds + (unless jemacs-static? + (let ((cmd (format "gcc -shared -fPIC -O2 -DQT_SCINTILLA_AVAILABLE -o qt_chez_shim.so vendor/qt_chez_shim.c -I~a ~a -Wall 2>&1" + qt-shim-dir qt-cflags))) + (unless (= 0 (system cmd)) + (display "Error: qt_chez_shim.so compilation failed\n") + (exit 1))))) ;; Static: generate + compile foreign symbol registration table ;; (dlopen(NULL) is a stub in musl static builds, so we use Sforeign_symbol instead) @@ -457,8 +491,10 @@ qt_static_symbols.o \ ;; ─── Dynamic link (default local build) ──────────────────────────────── (let* ((pcre2-libs (shell-output "pkg-config --libs libpcre2-8" "-lpcre2-8")) (qt-libs (shell-output "pkg-config --libs Qt6Widgets" "-lQt6Widgets -lQt6Gui -lQt6Core")) - (cmd (format "g++ -rdynamic -o jemacs-qt jemacs-qt-main.o jemacs-qt-chez-shim.o jemacs-qt-pcre2-shim.o ~a ~a -L~a -lkernel -llz4 -lz -lm -ldl -lpthread -luuid -lncurses -lstdc++ -L~a -lqt_shim -lqscintilla2_qt6 -Wl,-rpath,~a -Wl,-rpath,~a 2>&1" - pcre2-libs qt-libs chez-dir qt-shim-dir chez-dir qt-shim-dir))) + ;; Link against ./libqt_shim.so (local copy with JEMACS_CHEZ_SMP) + ;; rather than qt-shim-dir (gerbil-qt vendor — no Sdeactivate) + (cmd (format "g++ -rdynamic -o jemacs-qt jemacs-qt-main.o jemacs-qt-chez-shim.o jemacs-qt-pcre2-shim.o ~a ~a -L~a -lkernel -llz4 -lz -lm -ldl -lpthread -luuid -lncurses -lstdc++ -L. -lqt_shim -lqscintilla2_qt6 -Wl,-rpath,~a -Wl,-rpath,'$ORIGIN' 2>&1" + pcre2-libs qt-libs chez-dir chez-dir))) (printf " ~a~n" cmd) (unless (= 0 (system cmd)) (display "Error: Link failed\n") @@ -493,7 +529,7 @@ qt_static_symbols.o \ (begin ;; Copy shim .so files alongside binary for dynamic builds (system (format "cp ~a/libqt_shim.so . 2>/dev/null; true" qt-shim-dir)) - (system (format "cp ~a/qt_chez_shim.so . 2>/dev/null; true" qt-dir)) + ;; qt_chez_shim.so already built locally from vendor/qt_chez_shim.c (system (format "cp ~a/pcre2_shim.so . 2>/dev/null; true" pcre2-dir)) (printf "~nBundle (keep these together):~n") (printf " ./jemacs-qt~n") --- a/lib/jerboa-emacs/async.sls +++ b/lib/jerboa-emacs/async.sls @@ -86,7 +86,10 @@ (when found (with-catch (lambda (e) - (jemacs-log! "UI queue error: " (format "~a" e))) + (verbose-log! + "UI-QUEUE-ERROR: " + (with-output-to-string + (lambda () (display-exception e))))) action) (loop (+ n 1))))))) (def *scheduled-tasks* '()) @@ -110,14 +113,23 @@ [thunk (cadddr task)]) (if (>= (- now last) interval) (begin + (verbose-log! + "TICK " + (symbol->string name) + " begin") (with-catch (lambda (e) - (jemacs-log! - "Timer error in " - name + (verbose-log! + "TIMER-ERROR in " + (symbol->string name) ": " - (format "~a" e))) + (with-output-to-string + (lambda () (display-exception e))))) thunk) + (verbose-log! + "TICK " + (symbol->string name) + " end") (list name interval now thunk)) task))) *scheduled-tasks*)))) --- a/lib/jerboa-emacs/pty.sls +++ b/lib/jerboa-emacs/pty.sls @@ -7,6 +7,7 @@ (library (jerboa-emacs pty) (export pty-spawn pty-read + pty-last-errno pty-write pty-close! pty-kill! @@ -62,6 +63,8 @@ (foreign-procedure "pty_waitpid" (int int) int)) (define ffi-pty-waitpid-status (foreign-procedure "pty_get_wait_status" () int)) + (define ffi-pty-last-errno + (foreign-procedure "pty_last_errno" () int)) ;;; ======================================================================== ;;; Scheme-level API @@ -75,12 +78,22 @@ (values #f #f)))) (def (pty-read master-fd) + "Read from PTY master fd. + Returns: string (data), #f (EAGAIN/retry), 'eof (true EOF), or 'error (fatal)." (let* ((buf (make-bytevector 4096 0)) (n (ffi-pty-read master-fd buf 4095))) (cond - ((> n 0) (utf8->string (bytevector-copy buf 0 n))) - ((= n 0) #f) - (else 'eof)))) + ((> n 0) + (let ((sub (make-bytevector n))) + (bytevector-copy! buf 0 sub 0 n) + (utf8->string sub))) + ((= n 0) #f) ; EAGAIN/EIO/ENXIO — retry + ((= n -1) 'eof) ; true EOF (read returned 0) + (else 'error)))) ; fatal error — check pty-last-errno + + (def (pty-last-errno) + "Return the errno from the last pty_read call." + (ffi-pty-last-errno)) (def (pty-write master-fd str) (ffi-pty-write master-fd str (string-length str))) --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -133,6 +133,7 @@ (let ([pos (qt-plain-text-edit-cursor-position ed)]) (qt-plain-text-edit-set-selection! ed pos pos))))) (def *master-timer-tick-fn* #f) + (def *pty-poll-logged?* #f) (def *which-key-timer* #f) (def *which-key-pending-keymap* #f) (def *which-key-pending-prefix* #f) @@ -396,9 +397,8 @@ (qt-plain-text-edit-ensure-cursor-visible! ed))) (loop (cdr wins))))))]))) (def (qt-do-init! qt-app args) (init-jemacs-log!) - (when (member "--verbose" args) - (let ([vpath (init-verbose-log!)]) - (verbose-log! "gemacs-qt verbose mode ON"))) + (init-verbose-log!) + (verbose-log! "gemacs-qt verbose mode ON") (define-standard-faces!) (let-values ([(saved-theme saved-font-family saved-font-size) (theme-settings-load!)]) @@ -463,6 +463,7 @@ (qt-layout-set-spacing! layout 0) (qt-minibuffer-init! echo-label qt-app layout) (set! *qt-app-ptr* qt-app) + (qt-window-set-app-ptr! qt-app) (setup-default-bindings!) (setup-command-docs!) (qt-register-all-commands!) @@ -474,19 +475,30 @@ (add-hook! 'post-buffer-attach-hook (lambda (editor buf) - (if (image-buffer? buf) - (begin - (qt-show-image-buffer! editor buf) - (let ([win (hash-get *editor-window-map* editor)]) - (when (and win (qt-edit-window-image-scroll win)) - (let ([scroll (qt-edit-window-image-scroll win)]) - (unless (hash-get image-key-installed scroll) - ((app-state-key-handler app) scroll) - (hash-put! image-key-installed scroll #t)) - (qt-widget-set-focus! scroll))))) - (begin - (qt-hide-image-buffer! editor) - (qt-widget-set-focus! editor)))))) + (with-catch + (lambda (e) + (verbose-log! + "post-buffer-attach-hook ERROR: " + (with-output-to-string + (lambda () (display-exception e))))) + (lambda () + (if (image-buffer? buf) + (begin + (qt-show-image-buffer! editor buf) + (let ([win (hash-get *editor-window-map* editor)]) + (when (and win + (qt-edit-window-image-scroll win)) + (let ([scroll (qt-edit-window-image-scroll + win)]) + (unless (hash-get + image-key-installed + scroll) + ((app-state-key-handler app) scroll) + (hash-put! image-key-installed scroll #t)) + (qt-widget-set-focus! scroll))))) + (begin + (qt-hide-image-buffer! editor) + (qt-widget-set-focus! editor)))))))) (recent-files-load!) (bookmarks-load! app) (custom-keys-load!) @@ -519,250 +531,220 @@ (scratch-update-text! text)) (run-hooks! 'after-init-hook app) (let ([key-handler (lambda () - (let* ([code (qt-last-key-code)] - [mods (normalize-qt-mods - (qt-last-key-modifiers))] - [raw-text (qt-last-key-text)] - [text (if (= (string-length raw-text) - 1) - (string - (key-translate-char - (string-ref - raw-text - 0))) - raw-text)]) - (let ([ks (qt-key-event->string - code - mods - text)]) - (when ks - (key-lossage-record! app ks) - (verbose-log! "KEY " ks " code=" - (number->string code) " mods=" - (number->string mods)))) - (cond - [*isearch-active* - (let ([handled (isearch-handle-key! - app - code - mods - text)]) - (qt-update-visual-decorations! - (qt-current-editor - (app-state-frame app))) + (when (not *minibuffer-active?*) + (let* ([code (qt-last-key-code)] + [mods (normalize-qt-mods + (qt-last-key-modifiers))] + [raw-text (qt-last-key-text)] + [text (if (= (string-length + raw-text) + 1) + (string + (key-translate-char + (string-ref + raw-text + 0))) + raw-text)]) + (let ([ks (qt-key-event->string + code + mods + text)]) + (when ks + (key-lossage-record! app ks) + (verbose-log! "KEY " ks " code=" + (number->string code) " mods=" + (number->string mods)))) + (cond + [*isearch-active* + (let ([handled (isearch-handle-key! + app + code + mods + text)]) + (qt-update-visual-decorations! + (qt-current-editor + (app-state-frame app))) + (qt-modeline-update! app) + (qt-echo-draw! + (app-state-echo app) + echo-label) + (when (not handled) + (let-values ([(action data new-state) + (qt-key-state-feed! + (app-state-key-state + app) + code + mods + text)]) + (app-state-key-state-set! + app + new-state) + (when (eq? action 'command) + (execute-command! + app + data)))))] + [*qreplace-active* + (qreplace-handle-key! + app + code + mods + text) (qt-modeline-update! app) (qt-echo-draw! (app-state-echo app) - echo-label) - (when (not handled) - (let-values ([(action data new-state) - (qt-key-state-feed! - (app-state-key-state - app) - code - mods - text)]) - (app-state-key-state-set! - app - new-state) - (when (eq? action 'command) - (execute-command! app data)))))] - [*qreplace-active* - (qreplace-handle-key! - app - code - mods - text) - (qt-modeline-update! app) - (qt-echo-draw! - (app-state-echo app) - echo-label)] - [else - (letrec ([do-normal-key! (lambda (code - mods - text) - (if (and (active-repeat-map) - (let* ([ks (qt-key-event->string + echo-label)] + [else + (letrec ([do-normal-key! (lambda (code + mods + text) + (if (and (active-repeat-map) + (let* ([ks (qt-key-event->string + code + mods + text)] + [repeat-cmd (and ks + (repeat-map-lookup + ks))]) + (if repeat-cmd + (begin + (execute-command! + app + repeat-cmd) + #t) + (begin + (clear-repeat-map!) + #f)))) + (void) + (let-values ([(action data new-state) + (qt-key-state-feed! + (app-state-key-state + app) code mods - text)] - [repeat-cmd (and ks - (repeat-map-lookup - ks))]) - (if repeat-cmd - (begin - (execute-command! - app - repeat-cmd) - #t) - (begin - (clear-repeat-map!) - #f)))) - (void) - (let-values ([(action data new-state) - (qt-key-state-feed! - (app-state-key-state - app) - code - mods - text)]) - (app-state-key-state-set! - app - new-state) - (when (and *which-key-timer* + text)]) + (app-state-key-state-set! + app + new-state) + (when (and *which-key-timer* + (not (eq? action + 'prefix))) + (qt-timer-stop! + *which-key-timer*) + (set! *which-key-pending-keymap* + #f)) + (if (and *qt-describe-key-pending* (not (eq? action 'prefix))) - (qt-timer-stop! - *which-key-timer*) - (set! *which-key-pending-keymap* - #f)) - (if (and *qt-describe-key-pending* - (not (eq? action - 'prefix))) - (let ([ks (qt-key-event->string - code - mods - text)]) - (qt-describe-key-result! - app - ks - action - data)) - (if *qt-quoted-insert-pending* - (qt-quoted-insert-handle! + (let ([ks (qt-key-event->string + code + mods + text)]) + (qt-describe-key-result! app - (if (and text - (> (string-length - text) - 0)) - text - (qt-key-event->string - code - mods - text))) - (case action - [(command) - (when (and (app-state-macro-recording - app) - (not (memq - data - '(start-kbd-macro - end-kbd-macro - call-last-kbd-macro - call-named-kbd-macro - name-last-kbd-macro - list-kbd-macros - save-kbd-macros - load-kbd-macros)))) - (app-state-macro-recording-set! - app - (cons + ks + action + data)) + (if *qt-quoted-insert-pending* + (qt-quoted-insert-handle! + app + (if (and text + (> (string-length + text) + 0)) + text + (qt-key-event->string + code + mods + text))) + (case action + [(command) + (when (and (app-state-macro-recording + app) + (not (memq + data + '(start-kbd-macro + end-kbd-macro + call-last-kbd-macro + call-named-kbd-macro + name-last-kbd-macro + list-kbd-macros + save-kbd-macros + load-kbd-macros)))) + (app-state-macro-recording-set! + app (cons - 'command - data) - (app-state-macro-recording - app)))) - (when (and (echo-state-message - (app-state-echo - app)) - (null? - (key-state-prefix-keys - new-state))) - (echo-clear! - (app-state-echo - app))) - (execute-command! - app - data)] - [(self-insert) - (let* ([buf (qt-current-buffer - (app-state-frame - app))] - [mode-cmd (mode-keymap-lookup - buf - data)]) - (if mode-cmd - (execute-command! - app - mode-cmd) - (begin - (when (app-state-macro-recording - app) - (app-state-macro-recording-set! - app - (cons + (cons + 'command + data) + (app-state-macro-recording + app)))) + (when (and (echo-state-message + (app-state-echo + app)) + (null? + (key-state-prefix-keys + new-state))) + (echo-clear! + (app-state-echo + app))) + (execute-command! + app + data)] + [(self-insert) + (let* ([buf (qt-current-buffer + (app-state-frame + app))] + [mode-cmd (mode-keymap-lookup + buf + data)]) + (if mode-cmd + (execute-command! + app + mode-cmd) + (begin + (when (app-state-macro-recording + app) + (app-state-macro-recording-set! + app (cons - 'self-insert - data) - (app-state-macro-recording - app)))) - (let* ([ed (qt-current-editor - (app-state-frame - app))] - [ch (string-ref - data - 0)] - [close-ch (and *auto-pair-mode* - (let ([cc (auto-pair-char - (char->integer - ch))]) - (and cc - (integer->char - cc))))] - [n (get-prefix-arg - app)]) - (cond - [(dired-buffer? - buf) - (void)] - [(image-buffer? - buf) - (void)] - [(repl-buffer? - buf) - (let* ([pos (qt-plain-text-edit-cursor-position - ed)] - [rs (hash-get - *repl-state* - buf)]) - (when (and rs - (>= pos - (repl-state-prompt-pos - rs))) - (let loop ([i 0]) - (when (< i - n) - (qt-plain-text-edit-insert-text! - ed - (string - ch)) - (loop - (+ i - 1))))))] - [(eshell-buffer? - buf) - (let loop ([i 0]) - (when (< i - n) - (qt-plain-text-edit-insert-text! - ed - (string - ch)) - (loop - (+ i - 1))))] - [(terminal-buffer? - buf) - (let ([ts (hash-get - *terminal-state* - buf)]) - (if (and ts - (terminal-pty-busy? - ts)) - (terminal-send-input! - ts - (string - ch)) + (cons + 'self-insert + data) + (app-state-macro-recording + app)))) + (let* ([ed (qt-current-editor + (app-state-frame + app))] + [ch (string-ref + data + 0)] + [close-ch (and *auto-pair-mode* + (let ([cc (auto-pair-char + (char->integer + ch))]) + (and cc + (integer->char + cc))))] + [n (get-prefix-arg + app)]) + (cond + [(dired-buffer? + buf) + (void)] + [(image-buffer? + buf) + (void)] + [(repl-buffer? + buf) + (let* ([pos (qt-plain-text-edit-cursor-position + ed)] + [rs (hash-get + *repl-state* + buf)]) + (when (and rs + (>= pos + (repl-state-prompt-pos + rs))) (let loop ([i 0]) (when (< i n) @@ -773,341 +755,376 @@ (loop (+ i 1))))))] - [(shell-buffer? - buf) - (let ([ss (hash-get - *shell-state* - buf)]) - (if (and ss - (shell-pty-busy? - ss)) - (shell-send-input! - ss + [(eshell-buffer? + buf) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed (string ch)) - (let loop ([i 0]) - (when (< i - n) - (qt-plain-text-edit-insert-text! - ed - (string - ch)) - (loop - (+ i - 1))))))] - [else - (when (not *qt-delete-selection-enabled*) - (let ([pos (qt-plain-text-edit-cursor-position - ed)]) - (sci-send - ed - SCI_SETSEL - pos - pos))) - (cond - [(and *auto-pair-mode* - (= n - 1) - (auto-pair-closing? - (char->integer - ch))) - (let* ([pos (qt-plain-text-edit-cursor-position - ed)] - [text (qt-plain-text-edit-text - ed)] - [next-ch (and (< pos - (string-length - text)) - (string-ref - text - pos))]) - (if (and next-ch - (char=? - next-ch + (loop + (+ i + 1))))] + [(terminal-buffer? + buf) + (let ([ts (hash-get + *terminal-state* + buf)]) + (if (and ts + (terminal-pty-busy? + ts)) + (terminal-send-input! + ts + (string + ch)) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed + (string ch)) - (qt-plain-text-edit-set-cursor-position! - ed - (+ pos - 1)) - (qt-plain-text-edit-insert-text! - ed - (string - ch))))] - [(and close-ch - (= n - 1)) - (let ([pos (qt-plain-text-edit-cursor-position - ed)]) - (qt-plain-text-edit-insert-text! - ed - (string - ch - close-ch)) - (qt-plain-text-edit-set-cursor-position! - ed - (+ pos - 1)))] - [else - (let ([str (make-string - n - ch)]) + (loop + (+ i + 1))))))] + [(shell-buffer? + buf) + (let ([ss (hash-get + *shell-state* + buf)]) + (if (and ss + (shell-pty-busy? + ss)) + (shell-send-input! + ss + (string + ch)) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed + (string + ch)) + (loop + (+ i + 1))))))] + [else + (when (not *qt-delete-selection-enabled*) + (let ([pos (qt-plain-text-edit-cursor-position + ed)]) + (sci-send + ed + SCI_SETSEL + pos + pos))) + (cond + [(and *auto-pair-mode* + (= n + 1) + (auto-pair-closing? + (char->integer + ch))) + (let* ([pos (qt-plain-text-edit-cursor-position + ed)] + [text (qt-plain-text-edit-text + ed)] + [next-ch (and (< pos + (string-length + text)) + (string-ref + text + pos))]) + (if (and next-ch + (char=? + next-ch + ch)) + (qt-plain-text-edit-set-cursor-position! + ed + (+ pos + 1)) + (qt-plain-text-edit-insert-text! + ed + (string + ch))))] + [(and close-ch + (= n + 1)) + (let ([pos (qt-plain-text-edit-cursor-position + ed)])