P1: LSP language awareness, async auto-save, snippet undo, helm actions, stub purge
ober
472e5c219407007a68d0ecf9462b72a1cb3f5497
--- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -31,8 +31,8 @@ qt-plain-text-edit-create qt-plain-text-edit-set-text! qt-plain-text-edit-text qt-plain-text-edit-append! qt-plain-text-edit-clear! qt-plain-text-edit-set-read-only! - qt-plain-text-edit-read-only? qt-plain-text-edit-set-placeholder! - qt-plain-text-edit-line-count qt-plain-text-edit-set-max-block-count! + qt-plain-text-edit-read-only? + qt-plain-text-edit-line-count qt-plain-text-edit-cursor-line qt-plain-text-edit-cursor-column qt-plain-text-edit-set-line-wrap! qt-plain-text-edit-cursor-position qt-plain-text-edit-set-cursor-position! @@ -48,15 +48,9 @@ qt-plain-text-edit-line-from-position qt-plain-text-edit-line-end-position qt-plain-text-edit-find-text qt-plain-text-edit-ensure-cursor-visible! qt-plain-text-edit-center-cursor! - qt-text-document-create qt-plain-text-document-create - qt-text-document-destroy! - qt-plain-text-edit-document qt-plain-text-edit-set-document! - qt-text-document-modified? qt-text-document-set-modified! - qt-syntax-highlighter-create qt-syntax-highlighter-destroy! - qt-syntax-highlighter-add-rule! qt-syntax-highlighter-add-keywords! - qt-syntax-highlighter-add-multiline-rule! - qt-syntax-highlighter-clear-rules! qt-syntax-highlighter-rehighlight! - qt-line-number-area-create qt-line-number-area-destroy! + qt-plain-text-edit-document qt-plain-text-edit-set-document! + qt-text-document-modified? qt-text-document-set-modified! + qt-line-number-area-create qt-line-number-area-set-visible! qt-line-number-area-set-bg-color! qt-line-number-area-set-fg-color!) :jerboa-emacs/core @@ -1242,9 +1236,17 @@ (qreplace-handle-key! app code mods text) (qt-modeline-update! app) (qt-echo-draw! (app-state-echo app) echo-label)) - (*snake-active* - (snake-handle-key! app code mods text)) - ((and (or (= code QT_KEY_RETURN) (= code QT_KEY_ENTER)) + (*snake-active* + (snake-handle-key! app code mods text)) + ;; Occur buffer: Enter → jump to source match line + ((and (or (= code QT_KEY_RETURN) (= code QT_KEY_ENTER)) + (zero? (bitwise-and mods QT_MOD_CTRL)) + (zero? (bitwise-and mods QT_MOD_ALT)) + (string=? "*Occur*" + (buffer-name (qt-current-buffer (app-state-frame app))))) + (execute-command! app 'occur-goto) + (qt-refresh-after-key! app echo-label "occur-goto")) + ((and (or (= code QT_KEY_RETURN) (= code QT_KEY_ENTER)) (zero? (bitwise-and mods QT_MOD_CTRL)) (zero? (bitwise-and mods QT_MOD_ALT)) (terminal-copy-mode-active? @@ -1989,17 +1991,13 @@ (set! save-jobs (cons (cons auto-path text) save-jobs))) (loop (cdr wins)))))))) (buffer-list)) - ;; Phase 2: Write auto-save files synchronously (avoids GC deadlock) + ;; Phase 2: Write auto-save files in background threads (for-each (lambda (job) - (with-catch - (lambda (e) (jemacs-log! "Auto-save error: " - (with-output-to-string (lambda () (display-condition e))))) - (lambda () - (let* ((safe-auto-path (check-untainted-file-path (car job))) - (p (open-output-file safe-auto-path 'replace))) - (display (cdr job) p) - (close-port p))))) + (async-write-file! (car job) (cdr job) + (lambda (ok) + (unless ok + (jemacs-log! "Auto-save error: " (car job)))))) save-jobs)) ;; Cache scratch buffer text for persistence (fast, stays on UI thread) (let ((scratch (buffer-by-name "*scratch*"))) --- a/src/jerboa-emacs/qt/automation.ss +++ b/src/jerboa-emacs/qt/automation.ss @@ -32,8 +32,8 @@ qt-plain-text-edit-create qt-plain-text-edit-set-text! qt-plain-text-edit-text qt-plain-text-edit-append! qt-plain-text-edit-clear! qt-plain-text-edit-set-read-only! - qt-plain-text-edit-read-only? qt-plain-text-edit-set-placeholder! - qt-plain-text-edit-line-count qt-plain-text-edit-set-max-block-count! + qt-plain-text-edit-read-only? + qt-plain-text-edit-line-count qt-plain-text-edit-cursor-line qt-plain-text-edit-cursor-column qt-plain-text-edit-set-line-wrap! qt-plain-text-edit-cursor-position qt-plain-text-edit-set-cursor-position! @@ -49,15 +49,9 @@ qt-plain-text-edit-line-from-position qt-plain-text-edit-line-end-position qt-plain-text-edit-find-text qt-plain-text-edit-ensure-cursor-visible! qt-plain-text-edit-center-cursor! - qt-text-document-create qt-plain-text-document-create - qt-text-document-destroy! - qt-plain-text-edit-document qt-plain-text-edit-set-document! - qt-text-document-modified? qt-text-document-set-modified! - qt-syntax-highlighter-create qt-syntax-highlighter-destroy! - qt-syntax-highlighter-add-rule! qt-syntax-highlighter-add-keywords! - qt-syntax-highlighter-add-multiline-rule! - qt-syntax-highlighter-clear-rules! qt-syntax-highlighter-rehighlight! - qt-line-number-area-create qt-line-number-area-destroy! + qt-plain-text-edit-document qt-plain-text-edit-set-document! + qt-text-document-modified? qt-text-document-set-modified! + qt-line-number-area-create qt-line-number-area-set-visible! qt-line-number-area-set-bg-color! qt-line-number-area-set-fg-color!) :jerboa-emacs/core --- a/src/jerboa-emacs/qt/commands-lsp.ss +++ b/src/jerboa-emacs/qt/commands-lsp.ss @@ -63,21 +63,25 @@ ;;;============================================================================ (def (lsp-maybe-auto-start! app buf) - "Auto-start LSP when opening a Scheme file if not running." + "Auto-start LSP when opening a file with a supported language. + Uses *lsp-language-server-alist* to pick the right server per language." (when (and (not (lsp-running?)) (not *lsp-initializing*) (buffer-file-path buf)) - (let ((path (buffer-file-path buf))) - (when (and path - (let ((ext (path-extension path))) - (or (string=? ext ".ss") (string=? ext ".sls") - (string=? ext ".scm")))) - (let ((root (lsp-find-project-root path))) - (when root - (echo-message! (app-state-echo app) "LSP: starting jerboa-lsp...") - (if (lsp-start! root) - (echo-message! (app-state-echo app) "LSP: initializing...") - (echo-error! (app-state-echo app) "LSP: failed to start jerboa-lsp")))))))) + (let* ((path (buffer-file-path buf)) + (lang (detect-language path))) + (when lang + (let* ((lsp-lang (lexer-lang->lsp-language lang)) + (cmd (lsp-server-for-language lsp-lang))) + (when lsp-lang + (let ((root (lsp-find-project-root path))) + (when root + (echo-message! (app-state-echo app) + (string-append "LSP: starting " cmd "...")) + (if (lsp-start! root lsp-lang) + (echo-message! (app-state-echo app) "LSP: initializing...") + (echo-error! (app-state-echo app) + (string-append "LSP: failed to start " cmd))))))))))) (def (lsp-find-project-root path) "Walk up from PATH to find a directory containing a project marker." @@ -1389,15 +1393,18 @@ (echo-message! (app-state-echo app) "LSP: stopped")) (let* ((buf (current-qt-buffer app)) (path (buffer-file-path buf)) - (root (and path (lsp-find-project-root path)))) + (root (and path (lsp-find-project-root path))) + (lang (and path (detect-language path))) + (lsp-lang (and lang (lexer-lang->lsp-language lang)))) (if root - (begin - (lsp-start! root) + (let ((cmd (lsp-server-for-language lsp-lang))) + (lsp-start! root lsp-lang) (lsp-install-handlers! app) ;; Proactively set up diagnostic margin so indicators are visible immediately (let ((ed (current-qt-editor app))) (lsp-ensure-diagnostic-margin! ed)) - (echo-message! (app-state-echo app) "LSP: starting jerboa-lsp...")) + (echo-message! (app-state-echo app) + (string-append "LSP: starting " cmd "..."))) (echo-error! (app-state-echo app) "LSP: no project root found"))))) ;;;============================================================================ --- a/src/jerboa-emacs/qt/echo.ss +++ b/src/jerboa-emacs/qt/echo.ss @@ -79,6 +79,10 @@ (def *mb-file-narrowing?* #f) ; When #t, narrowing browses filesystem (def *mb-file-dir* "") ; Current directory for file narrowing (def *mb-user-selected?* #f) ; Whether user explicitly navigated the list +;; Helm session hook — when set, TAB shows action menu instead of moving selection. +(def *mb-helm-session* #f) +(def *mb-helm-tab-handler* #f) + ;; Prompt-scoped minibuffer history. M-p/M-n navigate the active prompt's ;; entries while accepted inputs are also recorded in the shared history. (def *mb-history-table* (make-hash-table)) @@ -538,10 +542,14 @@ (cond ((= key QT_KEY_ESCAPE) (set! *mb-result* (list))) - ((= key QT_KEY_TAB) - (if *mb-narrowing?* - (narrowing-move-selection! 1) - (mb-handle-tab! input))) + ((= key QT_KEY_TAB) + (cond + (*mb-helm-tab-handler* + (*mb-helm-tab-handler*)) + (*mb-narrowing?* + (narrowing-move-selection! 1)) + (else + (mb-handle-tab! input)))) ;; C-n / Down = next candidate in narrowing, or newer history otherwise. ((or (= key QT_KEY_DOWN) (and (= key QT_KEY_N) (= mods QT_MOD_CTRL))) --- a/src/jerboa-emacs/qt/helm-qt.ss +++ b/src/jerboa-emacs/qt/helm-qt.ss @@ -64,13 +64,47 @@ ;; Reverse to preserve original order (set! all-display-strings (reverse all-display-strings)) - ;; Use the existing narrowing UI + ;; Use the existing narrowing UI with helm TAB action menu. + ;; *mb-helm-tab-handler* is a closure that captures display-to-candidate + ;; and the helm session so TAB can show source-level actions. (let* ((prompt (if multi-source? "Helm" (helm-source-name (car sources)))) + (tab-handler + (lambda () + (let* ((filtered *mb-filtered*) + (idx *mb-selected-index*) + (selected (vector-ref filtered idx)) + (cand (hash-get display-to-candidate selected)) + (src (and cand (helm-candidate-source cand))) + (actions (and src (helm-source-actions src)))) + (if (and actions (> (length actions) 1)) + ;; Show action menu via nested narrowing + (let ((action-names (map car actions)) + (action-fns (map cdr actions)) + (action-result + (qt-echo-read-with-narrowing app + (string-append "Action for " (helm-source-name src) ": ") + action-names))) + (when action-result + (let* ((action-idx (list-index + (lambda (n) (string=? n action-result)) + action-names)) + (action (list-ref action-fns action-idx))) + ;; Run action on the candidate + (action (helm-candidate-real cand)) + ;; End the outer helm session + (set! *mb-result* (cons action-result '()))))) + ;; Single or zero actions — no-op (RET already does default) + (void))))) + (*mb-helm-tab-handler* tab-handler) + (*mb-helm-session* session) (result (qt-echo-read-with-narrowing app (string-append prompt ": ") all-display-strings))) + ;; Clear helm globals + (set! *mb-helm-tab-handler* #f) + (set! *mb-helm-session* #f) (if result ;; Look up the helm-candidate for this display string (let ((cand (hash-get display-to-candidate result))) --- a/src/jerboa-emacs/qt/lsp-client.ss +++ b/src/jerboa-emacs/qt/lsp-client.ss @@ -99,6 +99,37 @@ ;; Server capabilities from initialize response (def *lsp-server-capabilities* (make-hash-table)) +;; Per-language server command alist: (language-name . command-string) +;; Used to dispatch to the right LSP server per file type. +(def *lsp-language-server-alist* + (list (cons "Scheme" "jerboa-lsp") + (cons "C" "clangd") + (cons "C++" "clangd") + (cons "Rust" "rust-analyzer") + (cons "Python" "pyright") + (cons "Go" "gopls") + (cons "Java" "jdt-language-server") + (cons "TypeScript" "typescript-language-server") + (cons "JavaScript" "typescript-language-server"))) + +;; Lexer language symbol → language name for LSP dispatch. +(def (lexer-lang->lsp-language lang) + (case lang + ((scheme) "Scheme") + ((lisp) "Scheme") ;; Lisp uses same LSP server + ((python) "Python") + ((c) "C") + ((cpp) "C++") + ((javascript) "JavaScript") + ((typescript) "TypeScript") + ((go) "Go") + ((java) "Java") + ((rust) "Rust") + (else #f))) + +;; Track which language each server instance serves (for restart). +(def *lsp-server-language* #f) + ;; Connection state (def *lsp-initialized* #f) (def *lsp-initializing* #f) @@ -413,28 +444,39 @@ ;;; Process management ;;;============================================================================ -(def (lsp-start! workspace-root) - "Start the LSP server subprocess and begin initialization." +(def (lsp-server-for-language (language #f)) + "Return the server command string for LANGUAGE, or the default." + (if language + (let ((entry (assoc language *lsp-language-server-alist*))) + (if entry (cdr entry) *lsp-server-command*)) + *lsp-server-command*)) + +(def (lsp-start! workspace-root (language #f)) + "Start the LSP server subprocess and begin initialization. + LANGUAGE determines which server command to use from + *lsp-language-server-alist*. When #f, uses *lsp-server-command*." (when (or *lsp-process* *lsp-initializing*) (lsp-stop!)) (set! *lsp-initializing* #t) (set! *lsp-workspace-root* workspace-root) - (let ((proc (with-catch - (lambda (e) #f) - (lambda () - (open-process - (list path: *lsp-server-command* - arguments: '("--stdio") - directory: workspace-root - stdin-redirection: #t - stdout-redirection: #t - stderr-redirection: #f)))))) + (let* ((cmd (lsp-server-for-language language)) + (proc (with-catch + (lambda (e) #f) + (lambda () + (open-process + (list path: cmd + arguments: '("--stdio") + directory: workspace-root + stdin-redirection: #t + stdout-redirection: #t + stderr-redirection: #f)))))) (if (not proc) (begin (set! *lsp-initializing* #f) #f) (begin (set! *lsp-process* proc) + (set! *lsp-server-language* language) ;; Poll for LSP messages on UI thread via schedule-periodic! ;; (avoids spawning a Chez thread which causes GC deadlocks in SMP) (schedule-periodic! 'lsp-reader 50 @@ -443,11 +485,23 @@ (with-catch (lambda (e) (lsp-report-write-failure! "reader" #f)) (lambda () - (lsp-drain-messages! *lsp-process*)))))) + (if (port-closed? *lsp-process*) + (begin + (jemacs-log! "LSP: server process died — restarting") + (lsp-restart!)) + (lsp-drain-messages! *lsp-process*))))))) ;; Send initialize request (lsp-send-initialize! workspace-root) #t)))) +(def (lsp-restart!) + "Restart the LSP server with the same language and workspace root." + (let ((language *lsp-server-language*) + (root *lsp-workspace-root*)) + (lsp-stop!) + (when root + (lsp-start! root language)))) + (def (lsp-stop!) "Stop the LSP server — send shutdown, then exit, then kill process." (when *lsp-process* --- a/src/jerboa-emacs/qt/sci-shim.ss +++ b/src/jerboa-emacs/qt/sci-shim.ss @@ -15,8 +15,7 @@ qt-plain-text-edit-create qt-plain-text-edit-set-text! qt-plain-text-edit-text qt-plain-text-edit-append! qt-plain-text-edit-clear! qt-plain-text-edit-set-read-only! qt-plain-text-edit-read-only? - qt-plain-text-edit-set-placeholder! qt-plain-text-edit-line-count - qt-plain-text-edit-set-max-block-count! + qt-plain-text-edit-line-count qt-plain-text-edit-cursor-line qt-plain-text-edit-cursor-column qt-plain-text-edit-set-line-wrap! qt-on-plain-text-edit-text-changed! qt-plain-text-edit-cursor-position qt-plain-text-edit-set-cursor-position! @@ -32,15 +31,11 @@ qt-plain-text-edit-find-text qt-plain-text-edit-ensure-cursor-visible! qt-plain-text-edit-center-cursor! qt-plain-text-edit-set-document! qt-plain-text-edit-document - qt-plain-text-document-create qt-text-document-create qt-text-document-destroy! qt-text-document-modified? qt-text-document-set-modified! - qt-line-number-area-create qt-line-number-area-destroy! + qt-line-number-area-create qt-line-number-area-set-visible! qt-line-number-area-set-bg-color! qt-line-number-area-set-fg-color! - qt-syntax-highlighter-create qt-syntax-highlighter-destroy! - qt-syntax-highlighter-add-rule! qt-syntax-highlighter-add-keywords! - qt-syntax-highlighter-add-multiline-rule! qt-syntax-highlighter-rehighlight! - qt-syntax-highlighter-clear-rules! + qt-extra-selections-clear! qt-extra-selection-add-line! qt-extra-selection-add-range! qt-extra-selections-apply! ;; jerboa-qt re-exports — all jerboa-qt identifiers used by Qt modules @@ -157,8 +152,8 @@ qt-plain-text-edit-create qt-plain-text-edit-set-text! qt-plain-text-edit-text qt-plain-text-edit-append! qt-plain-text-edit-clear! qt-plain-text-edit-set-read-only! - qt-plain-text-edit-read-only? qt-plain-text-edit-set-placeholder! - qt-plain-text-edit-line-count qt-plain-text-edit-set-max-block-count! + qt-plain-text-edit-read-only? + qt-plain-text-edit-line-count qt-plain-text-edit-cursor-line qt-plain-text-edit-cursor-column qt-plain-text-edit-set-line-wrap! qt-plain-text-edit-cursor-position qt-plain-text-edit-set-cursor-position! @@ -174,15 +169,9 @@ qt-plain-text-edit-line-from-position qt-plain-text-edit-line-end-position qt-plain-text-edit-find-text qt-plain-text-edit-ensure-cursor-visible! qt-plain-text-edit-center-cursor! - qt-text-document-create qt-plain-text-document-create - qt-text-document-destroy! qt-plain-text-edit-document qt-plain-text-edit-set-document! qt-text-document-modified? qt-text-document-set-modified! - qt-syntax-highlighter-create qt-syntax-highlighter-destroy! - qt-syntax-highlighter-add-rule! qt-syntax-highlighter-add-keywords! - qt-syntax-highlighter-add-multiline-rule! - qt-syntax-highlighter-clear-rules! qt-syntax-highlighter-rehighlight! - qt-line-number-area-create qt-line-number-area-destroy! + qt-line-number-area-create qt-line-number-area-set-visible! qt-line-number-area-set-bg-color! qt-line-number-area-set-fg-color! ;; Constants we redefine as literals below @@ -523,8 +512,7 @@ (def (qt-plain-text-edit-set-line-wrap! sci wrap?) (sci-send sci SCI_SETWRAPMODE (if wrap? SC_WRAP_WORD SC_WRAP_NONE))) -(def (qt-plain-text-edit-set-placeholder! sci text) (void)) -(def (qt-plain-text-edit-set-max-block-count! sci count) (void)) + ;; Signals (def (qt-on-plain-text-edit-text-changed! sci handler) @@ -547,9 +535,7 @@ (def (qt-plain-text-edit-document sci) (sci-send sci SCI_GETDOCPOINTER)) -(def (qt-plain-text-document-create) #f) -(def (qt-text-document-create) #f) -(def (qt-text-document-destroy! doc) (void)) + (def (qt-text-document-modified? doc) (let ((buf (hash-get *doc-buffer-map* doc))) @@ -565,7 +551,7 @@ ;; Line number margin compatibility API. The "area" is Scintilla margin 0. (def (qt-line-number-area-create editor) editor) -(def (qt-line-number-area-destroy! lna) (void)) + (def (qt-line-number-area-set-visible! lna visible?) (when lna (sci-send lna SCI_SETMARGINTYPEN 0 SC_MARGIN_NUMBER) @@ -577,14 +563,7 @@ (when lna (sci-send lna SCI_STYLESETFORE STYLE_LINENUMBER (rgb->sci r g b)))) -;; Syntax highlighter stubs -(def (qt-syntax-highlighter-create doc) #f) -(def (qt-syntax-highlighter-destroy! h) (void)) -(def (qt-syntax-highlighter-add-rule! h pattern r g b bold? italic?) (void)) -(def (qt-syntax-highlighter-add-keywords! h keywords r g b bold? italic?) (void)) -(def (qt-syntax-highlighter-add-multiline-rule! h start end r g b bold? italic?) (void)) -(def (qt-syntax-highlighter-rehighlight! h) (void)) -(def (qt-syntax-highlighter-clear-rules! h) (void)) + ;; Extra selections - indicators (def *indic-current-line* 8) --- a/src/jerboa-emacs/qt/snippets.ss +++ b/src/jerboa-emacs/qt/snippets.ss @@ -21,10 +21,12 @@ ;;; ============================================================================ (def (qt-snippet-replace-range! ed start end text) - "Replace [START, END) with TEXT without resetting Scintilla undo history." + "Replace [START, END) with TEXT as a single undo action group." + (sci-send ed SCI_BEGINUNDOACTION) (sci-send ed SCI_SETTARGETSTART start) (sci-send ed SCI_SETTARGETEND end) - (sci-send/string ed SCI_REPLACETARGET text -1)) + (sci-send/string ed SCI_REPLACETARGET text -1) + (sci-send ed SCI_ENDUNDOACTION)) (def (cmd-snippet-expand app) "Try to expand snippet at point. Returns #t if expanded, #f otherwise."