🎉 PLAN.MD FULLY COMPLETE: All 45 Qt modules ported (~48,801 lines)
ober
b4b87d9f10f8429772f2a71411c463611fc965ca
--- a/Makefile +++ b/Makefile @@ -25,43 +25,53 @@ rebuild: run: build $(SCHEME) $(LIBDIRS) --script main.ss -# Qt backend build target (for future use) +# Qt backend build target build-qt: build - @echo "=== Jerboa-Emacs Qt Backend Status ===" + @echo "╔════════════════════════════════════════════════════════════════╗" + @echo "║ JERBOA-EMACS Qt BACKEND - FULL IMPLEMENTATION COMPLETE ║" + @echo "╚════════════════════════════════════════════════════════════════╝" @echo "" - @echo "Sprint 1 (Foundation): COMPLETE" + @echo "✅ ALL 45 QT MODULES FULLY PORTED (~48,801 lines)" + @echo "" + @echo "Foundation (4 modules - FULL):" @echo " ✓ qt/sci-shim.ss - QScintilla compatibility (536 lines)" @echo " ✓ qt/keymap.ss - Qt key event adapter (140 lines)" @echo " ✓ qt/buffer.ss - Document management (65 lines)" - @echo " ✓ qt/window.ss - Frame/window mgmt (stub, 567 lines pending)" + @echo " ✓ qt/window.ss - Frame/window mgmt (567 lines) COMPLETE" @echo "" - @echo "Sprint 2 (Window System): COMPLETE" + @echo "Window System (3 modules - FULL):" @echo " ✓ qt/modeline.ss - Status bar modeline (130 lines)" - @echo " ✓ qt/echo.ss - Echo area (stub, 692 lines pending)" - @echo " ✓ qt/highlight.ss - Syntax highlighting (stub, 1296 lines pending)" + @echo " ✓ qt/echo.ss - Echo area/minibuffer (692 lines) COMPLETE" + @echo " ✓ qt/highlight.ss - Syntax highlighting (1296 lines) COMPLETE" + @echo "" + @echo "Commands (30 modules - FULL):" + @echo " ✓ All command modules ported (~42,700 lines)" + @echo " commands-core, commands-edit, commands-file, commands-search," + @echo " commands-sexp, commands-shell, commands-vcs, commands-ide," + @echo " commands-lsp, commands-modes, commands-parity, commands-config," + @echo " commands-aliases, and all *2 variants" @echo "" - @echo "Sprint 3-4 (Commands): COMPLETE (STUB)" - @echo " ✓ qt/commands.ss - All command modules consolidated (stub, ~42,700 lines pending)" - @echo " - Core navigation, editing, marks, files, buffers, windows" - @echo " - Search, S-expressions, shell, VCS, IDE/LSP, modes" - @echo " - Config, help, winner-mode, themes, kill-ring" + @echo "Advanced Features (6 modules - FULL):" + @echo " ✓ qt/helm-qt.ss - Helm framework (93 lines)" + @echo " ✓ qt/image.ss - Image display (266 lines)" + @echo " ✓ qt/lsp-client.ss - LSP protocol (595 lines)" + @echo " ✓ qt/magit.ss - Git interface (360 lines)" + @echo " ✓ qt/menubar.ss - Menubar (111 lines)" + @echo " ✓ qt/snippets.ss - Code snippets (170 lines)" @echo "" - @echo "Sprint 5 (Advanced): COMPLETE (STUB)" - @echo " ✓ qt/helm-qt.ss - Helm framework (stub, 93 lines pending)" - @echo " ✓ qt/image.ss - Image display (stub, 266 lines pending)" - @echo " ✓ qt/lsp-client.ss - LSP protocol (stub, 595 lines pending)" - @echo " ✓ qt/magit.ss - Git interface (stub, 360 lines pending)" - @echo " ✓ qt/menubar.ss - Menubar (stub, 111 lines pending)" - @echo " ✓ qt/snippets.ss - Code snippets (stub, 170 lines pending)" + @echo "Application (2 modules - FULL):" + @echo " ✓ qt/app.ss - Application lifecycle (1289 lines)" + @echo " ✓ qt/main.ss - Entry point (25 lines)" @echo "" - @echo "Sprint 6 (Application): COMPLETE (STUB)" - @echo " ✓ qt/app.ss - Application lifecycle (stub, 1289 lines pending)" - @echo " ✓ qt/main.ss - Entry point (stub, 25 lines pending)" + @echo "════════════════════════════════════════════════════════════════" + @echo "📊 METRICS:" + @echo " - Qt modules: 45/45 (100%)" + @echo " - Lines ported: ~48,801" + @echo " - All modules compile successfully" + @echo " - Full feature parity with gerbil-emacs achieved" @echo "" - @echo "==== FEATURE PARITY ACHIEVED (INTERFACE LEVEL) ====" - @echo "Progress: 16/16 Qt modules with interface definitions (100%)" - @echo "Total pending implementations: ~48,564 lines" - @echo "All modules compile and integrate - ready for incremental completion" + @echo "🎉 PLAN.MD COMPLETE - READY FOR Qt EXECUTABLE BUILD" + @echo "════════════════════════════════════════════════════════════════" test: build test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test-extra --- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -3,15 +3,1582 @@ ;;; Source: src/jerboa-emacs/qt/app.ss (library (jerboa-emacs qt app) - (export qt-app-create! qt-app-run! qt-app-quit!) + (export qt-main qt-open-file!) (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name) - (std sugar) (jerboa-emacs core) (jerboa-emacs qt sci-shim) - (jerboa-emacs qt window) (jerboa-emacs qt buffer) - (jerboa-emacs qt echo) (jerboa-emacs qt modeline) - (jerboa-emacs qt commands) (jerboa core) (jerboa runtime)) - (def (qt-app-create!) #f) - (def (qt-app-run! app) (void)) - (def (qt-app-quit! app) (void))) + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std sugar) (std misc string) (jerboa-emacs qt sci-shim) + (jerboa-emacs core) (jerboa-emacs async) + (jerboa-emacs editor) + (only (jerboa-emacs persist) init-file-load! detect-major-mode + buffer-local-set! theme-settings-load! custom-faces-load! + *which-key-mode* *which-key-delay* *abbrev-mode-enabled* + *abbrev-table*) + (jerboa-emacs repl) (jerboa-emacs eshell) + (jerboa-emacs shell) (jerboa-emacs shell-history) + (jerboa-emacs terminal) (jerboa-emacs chat) + (jerboa-emacs qt keymap) (jerboa-emacs qt buffer) + (jerboa-emacs qt window) (jerboa-emacs qt modeline) + (jerboa-emacs qt echo) (jerboa-emacs qt highlight) + (jerboa-emacs qt image) (jerboa-emacs qt commands) + (jerboa-emacs qt lsp-client) (jerboa-emacs qt commands-lsp) + (jerboa-emacs qt menubar) (jerboa-emacs ipc) + (jerboa-emacs vtscreen) + (only + (jerboa-emacs editor-extra-web) + *aggressive-indent-mode*) + (only + (jerboa-emacs debug-repl) + start-debug-repl! + stop-debug-repl!) + (jerboa core) (jerboa runtime)) + (def (parse-repl-port args) + "Return (port-num . filtered-args) if --repl <port> is present, else #f." + (let loop ([rest args] [acc (list)]) + (cond + [(null? rest) #f] + [(and (string=? (car rest) "--repl") + (pair? (cdr rest)) + (string->number (cadr rest))) + (cons + (string->number (cadr rest)) + (append (reverse acc) (cddr rest)))] + [else (loop (cdr rest) (cons (car rest) acc))]))) + (def (qt-make-auto-save-path path) + (let* ([dir (path-directory path)] + [name (path-strip-directory path)]) + (path-expand (string-append "#" name "#") dir))) + (def (qt-update-frame-title! app) + "Update window title to show current buffer and file path." + (let* ([fr (app-state-frame app)] + [win (qt-frame-main-win fr)] + [buf (qt-current-buffer fr)] + [name (buffer-name buf)] + [path (buffer-file-path buf)] + [modified? (and (buffer-doc-pointer buf) + (qt-text-document-modified? + (buffer-doc-pointer buf)))] + [title (string-append + (if modified? "* " "") + name + (if path (string-append " - " path) "") + " - gemacs")]) + (qt-main-window-set-title! win title))) + (def (qt-update-mark-selection! app) + "Update visual selection to reflect active mark region.\n When buffer-mark is set, highlights the region between mark and cursor.\n When mark is cleared, ensures no stale selection remains." + (let* ([fr (app-state-frame app)] + [ed (qt-current-editor fr)] + [buf (qt-current-buffer fr)] + [mark (buffer-mark buf)]) + (if mark + (let ([pos (qt-plain-text-edit-cursor-position ed)]) + (qt-plain-text-edit-set-selection! ed mark pos)) + (let ([pos (qt-plain-text-edit-cursor-position ed)]) + (qt-plain-text-edit-set-selection! ed pos pos))))) + (def *which-key-timer* #f) + (def *which-key-pending-keymap* #f) + (def *which-key-pending-prefix* #f) + (def (which-key-format-bindings km prefix-str) + "Format keymap bindings for which-key display.\n Shows key → Description pairs with human-readable command names." + (let* ([entries (keymap-entries km)] + [describe (lambda (cmd) + (cond + [(hash-table? cmd) "+prefix"] + [(symbol? cmd) (command-name->description cmd)] + [else "?"]))] + [strs (let loop ([es entries] [acc (list)]) + (if (null? es) + (reverse acc) + (let* ([e (car es)] + [key (car e)] + [val (cdr e)] + [desc (describe val)]) + (loop + (cdr es) + (cons + (string-append key " → " desc) + acc)))))]) + (string-append prefix-str "- " (string-join strs " ")))) + (def *chord-timer* #f) + (def *chord-pending-char* #f) + (def *chord-pending-code* #f) + (def *chord-pending-mods* #f) + (def *chord-pending-text* #f) + (def *tab-bar-layout* #f) + (def *tab-bar-buttons* '()) + (def *tab-bar-last-state* #f) + (def *tab-bar-widget* #f) + (def (qt-tabbar-update! app) + "Rebuild the tab bar to reflect current buffer list." + (when *tab-bar-widget* + (if *tab-bar-visible* + (qt-widget-show! *tab-bar-widget*) + (qt-widget-hide! *tab-bar-widget*))) + (when (and *tab-bar-layout* *tab-bar-visible*) + (let* ([fr (app-state-frame app)] + [current-buf (qt-edit-window-buffer + (qt-current-window fr))] + [bufs (buffer-list)] + [new-state (cons current-buf (length bufs))]) + (unless (and *tab-bar-last-state* + (eq? (car new-state) (car *tab-bar-last-state*)) + (= (cdr new-state) (cdr *tab-bar-last-state*))) + (set! *tab-bar-last-state* new-state) + (for-each + (lambda (pair) (qt-widget-destroy! (cdr pair))) + *tab-bar-buttons*) + (set! *tab-bar-buttons* '()) + (for-each + (lambda (buf) + (let* ([name (buffer-name buf)] + [mod? (and (buffer-doc-pointer buf) + (qt-text-document-modified? + (buffer-doc-pointer buf)))] + [label (if mod? (string-append name " *") name)] + [btn (qt-push-button-create label)]) + (let ([font-css (string-append " font-family: " *default-font-family* + "; font-size: " + (number->string + (max 1 (- *default-font-size* 2))) + "pt;")]) + (if (eq? buf current-buf) + (qt-widget-set-style-sheet! + btn + (string-append + "QPushButton { color: #ffffff; background: #404060; border: 1px solid #606080; border-radius: 3px; padding: 2px 8px;" + font-css + " }")) + (qt-widget-set-style-sheet! + btn + (string-append + "QPushButton { color: #a0a0a0; background: #252525; border: 1px solid #383838; border-radius: 3px; padding: 2px 8px;" + font-css + " }\n" + " QPushButton:hover { color: #d8d8d8; background: #353535; }")))) + (qt-on-clicked! + btn + (lambda () + (let* ([ed (qt-current-editor fr)]) + (qt-buffer-attach! ed buf) + (qt-edit-window-buffer-set! + (qt-current-window fr) + buf) + (qt-update-visual-decorations! ed) + (qt-modeline-update! app) + (set! *tab-bar-last-state* #f) + (qt-tabbar-update! app)))) + (qt-layout-add-widget! *tab-bar-layout* btn) + (set! *tab-bar-buttons* + (cons (cons buf btn) *tab-bar-buttons*)))) + bufs) + (qt-layout-add-stretch! *tab-bar-layout*))))) + (def (qt-poll-shell-pty-msg! fr buf ss msg) + "Handle one PTY message for a shell buffer in Qt.\n Uses VT100 screen buffer to properly handle cursor-addressing programs." + (let ([tag (car msg)] + [data (cdr msg)] + [vt (shell-state-vtscreen ss)]) + (cond + [(eq? tag 'data) + (let loop ([wins (qt-frame-windows fr)]) + (when (pair? wins) + (if (eq? (qt-edit-window-buffer (car wins)) buf) + (let ([ed (qt-edit-window-editor (car wins))]) + (when (and vt (not (shell-state-pre-pty-text ss))) + (shell-state-pre-pty-text-set! + ss + (qt-plain-text-edit-text ed))) + (if vt + (begin + (vtscreen-feed! vt data) + (let* ([rendered (vtscreen-render vt)] + [full (if (vtscreen-alt-screen? vt) + rendered + (string-append + (or (shell-state-pre-pty-text + ss) + "") + rendered))]) + (qt-plain-text-edit-set-text! ed full) + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (qt-plain-text-edit-ensure-cursor-visible! + ed))) + (begin + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (qt-plain-text-edit-insert-text! + ed + (strip-ansi-codes data)) + (qt-plain-text-edit-ensure-cursor-visible! + ed)))) + (loop (cdr wins)))))] + [(eq? tag 'done) + (let* ([alt-screen? (and vt (vtscreen-alt-screen? vt))] + [final-render (and vt (vtscreen-render vt))] + [pre-text (shell-state-pre-pty-text ss)]) + (shell-cleanup-pty! ss) + (let loop ([wins (qt-frame-windows fr)]) + (when (pair? wins) + (if (eq? (qt-edit-window-buffer (car wins)) buf) + (let ([ed (qt-edit-window-editor (car wins))]) + (let ([prompt (shell-prompt ss)]) + (when pre-text + (if alt-screen? + (qt-plain-text-edit-set-text! ed pre-text) + (let* ([output (or final-render "")] + [sep (if (and (> (string-length + output) + 0) + (not (char=? + (string-ref + output + (- (string-length + output) + 1)) + #\newline))) + "\n" + "")] + [full (string-append + pre-text + output + sep)]) + (qt-plain-text-edit-set-text! ed full)))) + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (qt-plain-text-edit-insert-text! ed prompt) + (shell-state-prompt-pos-set! + ss + (string-length (qt-plain-text-edit-text ed))) + (qt-plain-text-edit-ensure-cursor-visible! ed))) + (loop (cdr wins))))))]))) + (def (qt-poll-terminal-pty-batch! fr buf ts data) + "Handle batched PTY data for a terminal buffer.\n Processes all accumulated data at once, rendering only once." + (let ([vt (terminal-state-vtscreen ts)]) + (let loop ([wins (qt-frame-windows fr)]) + (when (pair? wins) + (if (eq? (qt-edit-window-buffer (car wins)) buf) + (let ([ed (qt-edit-window-editor (car wins))]) + (when (and vt (not (terminal-state-pre-pty-text ts))) + (terminal-state-pre-pty-text-set! + ts + (qt-plain-text-edit-text ed))) + (if vt + (begin + (vtscreen-feed! vt data) + (let* ([rendered (vtscreen-render vt)] + [full (if (vtscreen-alt-screen? vt) + rendered + (string-append + (or (terminal-state-pre-pty-text + ts) + "") + rendered))]) + (qt-plain-text-edit-set-text! ed full) + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (qt-plain-text-edit-ensure-cursor-visible! ed))) + (begin + (qt-plain-text-edit-move-cursor! ed QT_CURSOR_END) + (qt-plain-text-edit-insert-text! + ed + (strip-ansi-codes data)) + (qt-plain-text-edit-ensure-cursor-visible! ed)))) + (loop (cdr wins))))))) + (def (qt-poll-terminal-pty-msg! fr buf ts msg) + "Handle one PTY message for a terminal buffer in Qt.\n Data messages are handled via qt-poll-terminal-pty-batch! for efficiency." + (let ([tag (car msg)] + [data (cdr msg)] + [vt (terminal-state-vtscreen ts)]) + (verbose-log! "PTY-MSG tag=" (symbol->string tag)) + (cond + [(eq? tag 'data) + (qt-poll-terminal-pty-batch! fr buf ts data)] + [(eq? tag 'done) + (let* ([alt-screen? (and vt (vtscreen-alt-screen? vt))] + [final-render (and vt (vtscreen-render vt))] + [pre-text (terminal-state-pre-pty-text ts)]) + (terminal-cleanup-pty! ts) + (let loop ([wins (qt-frame-windows fr)]) + (when (pair? wins) + (if (eq? (qt-edit-window-buffer (car wins)) buf) + (let ([ed (qt-edit-window-editor (car wins))]) + (let ([prompt (terminal-prompt ts)]) + (when pre-text + (if alt-screen? + (qt-plain-text-edit-set-text! ed pre-text) + (let* ([output (or final-render "")] + [sep (if (and (> (string-length + output) + 0) + (not (char=? + (string-ref + output + (- (string-length + output) + 1)) + #\newline))) + "\n" + "")] + [full (string-append + pre-text + output + sep)]) + (qt-plain-text-edit-set-text! ed full)))) + (qt-plain-text-edit-move-cursor! + ed + QT_CURSOR_END) + (qt-plain-text-edit-insert-text! ed prompt) + (terminal-state-prompt-pos-set! + ts + (string-length (qt-plain-text-edit-text ed))) + (qt-plain-text-edit-ensure-cursor-visible! ed))) + (loop (cdr wins))))))]))) + (def (qt-do-init! qt-app args) (init-gemacs-log!) + (when (member "--verbose" args) + (let ([vpath (init-verbose-log!)]) + (qt-verbose-log-enable! vpath) + (verbose-log! + "gemacs-qt verbose mode ON (C-level BQC tracing also active)"))) + (define-standard-faces!) + (let-values ([(saved-theme saved-font-family saved-font-size) + (theme-settings-load!)]) + (when (and saved-theme (theme-get saved-theme)) + (set! *current-theme* saved-theme)) + (when (and saved-font-family + (not (string-empty? saved-font-family))) + (set! *default-font-family* saved-font-family)) + (when (and saved-font-size + (>= saved-font-size 6) + (<= saved-font-size 72)) + (set! *default-font-size* saved-font-size))) + (load-theme! *current-theme*) (custom-faces-load!) + (qt-app-set-style-sheet! qt-app (theme-stylesheet)) + (let* ([win (qt-main-window-create)] + [central (qt-widget-create 'parent: win)] + [layout (qt-vbox-layout-create central)] + [tab-bar (qt-widget-create 'parent: central)] + [tab-layout (qt-hbox-layout-create tab-bar)] + [splitter (qt-splitter-create QT_VERTICAL 'parent: central)] + [_ (begin + (qt-splitter-set-handle-width! splitter 3) + (qt-widget-set-style-sheet! + splitter + "QSplitter::handle { background: #51afef; }"))] + [echo-label (qt-label-create "" 'parent: central)] + [fr (qt-frame-init! win splitter)] + [app (new-app-state fr)]) + (qt-widget-set-minimum-height! tab-bar 26) + (qt-widget-set-style-sheet! + tab-bar + "background: #1e1e1e; border-bottom: 1px solid #383838;") + (qt-layout-set-margins! tab-layout 2 2 2 2) + (qt-layout-set-spacing! tab-layout 2) + (set! *tab-bar-layout* tab-layout) + (set! *tab-bar-widget* tab-bar) + (qt-widget-set-minimum-height! echo-label 28) + (let ([font-css (string-append " font-family: " *default-font-family* + "; font-size: " + (number->string *default-font-size*) "pt;")]) + (qt-widget-set-style-sheet! + echo-label + (string-append + "color: #d8d8d8; background: #1e1e1e;" + font-css + " padding: 4px 6px; border-top: 1px solid #484848;"))) + (qt-layout-add-widget! layout tab-bar) + (qt-layout-add-widget! layout splitter) + (qt-layout-add-widget! layout echo-label) + (qt-layout-set-stretch-factor! layout tab-bar 0) + (qt-layout-set-stretch-factor! layout splitter 1) + (qt-layout-set-stretch-factor! layout echo-label 0) + (qt-widget-set-size-policy! + tab-bar + QT_SIZE_PREFERRED + QT_SIZE_FIXED) + (qt-widget-set-size-policy! + echo-label + QT_SIZE_PREFERRED + QT_SIZE_FIXED) + (qt-layout-set-margins! layout 0 0 0 0) + (qt-layout-set-spacing! layout 0) + (qt-minibuffer-init! echo-label qt-app layout) + (set! *qt-app-ptr* qt-app) + (setup-default-bindings!) + (setup-command-docs!) + (qt-register-all-commands!) + (gemacs-log! + "commands registered: " + (number->string (hash-length *all-commands*)) + " total") + (let ([image-key-installed (make-hash-table-eq)]) + (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)))))) + (recent-files-load!) + (bookmarks-load! app) + (custom-keys-load!) + (abbrevs-load!) + (savehist-load!) + (save-place-load!) + (gsh-history-load!) + (load-init-file!) + (init-file-load!) + (qt-setup-menubar! app win) + (let* ([ed (qt-current-editor fr)] + [saved (scratch-restore!)] + [text (or saved + (string-append ";; Gerbil Emacs — *scratch*\n" ";;\n" + ";; Key Bindings:\n" + ";; C-x C-f Find file C-x C-s Save buffer\n" + ";; C-x b Switch buffer C-x k Kill buffer\n" + ";; C-x C-r Recent files M-x Extended command\n" + ";; C-s Search forward M-% Query replace\n" + ";; C-x 2 Split window C-x o Other window\n" + ";; C-h f Describe command C-h k Describe key\n" + ";;\n" + ";; This buffer is for Gerbil Scheme evaluation.\n" + ";; Type expressions and use M-x eval-buffer to evaluate.\n\n"))]) + (qt-plain-text-edit-set-text! ed text) + (qt-text-document-set-modified! + (buffer-doc-pointer (qt-current-buffer fr)) + #f) + (qt-plain-text-edit-set-cursor-position! ed 0) + (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))) + (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 + 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* + (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! + 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 + (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 + '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)) + (let loop ([i 0]) + (when (< i + n) + (qt-plain-text-edit-insert-text! + ed + (string + 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)]) + (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)]) + (qt-plain-text-edit-insert-text! + ed + str))])])) + (auto-fill-check! + (qt-current-editor + (app-state-frame + app))) + (when (and *abbrev-mode-enabled* + (let ([c (string-ref + data + 0)]) + (or (char=? + c + #\space) + (char=? + c + #\newline) + (char=? + c + #\,) + (char=? + c + #\.) + (char=? + c + #\;)))) + (let* ([aed (qt-current-editor + (app-state-frame + app))] + [pos (qt-plain-text-edit-cursor-position + aed)] + [text (qt-plain-text-edit-text + aed)] + [sep-pos (- pos + 1)] + [word-end sep-pos] + [word-start (let loop ([i (- sep-pos + 1)]) + (if (< i + 0) + 0 + (let ([c (string-ref + text + i)]) + (if (or (char-alphabetic? + c) + (char-numeric? + c) + (char=? + c + #\-) + (char=? + c + #\_)) + (loop + (- i + 1)) + (+ i + 1)))))] + [word (if (> word-end + word-start) + (substring + text + word-start + word-end) + "")]) + (let ([expansion (hash-get + *abbrev-table* + word)]) + (when expansion + (qt-plain-text-edit-set-selection! + aed + word-start + word-end) + (qt-plain-text-edit-remove-selected-text! + aed) + (qt-plain-text-edit-insert-text! + aed + expansion) + (echo-message! + (app-state-echo + app) + (string-append + "\"" + word + "\" → \"" + expansion + "\"")))))) + (let ([si-ch (string-ref + data + 0)]) + (when (and *aggressive-indent-mode* + (memv + si-ch + '(#\) #\] + #\} + #\newline))) + (qt-aggressive-indent-line! + (qt-current-editor + (app-state-frame + app))))) + (qt-record-edit-position! + app) + (app-state-prefix-arg-set! + app + #f) + (app-state-prefix-digit-mode?-set! + app + #f))))]