Add 20 Emacs features round 5: restclient, markdown-preview, git-messenger, yaml-mode, dockerfile-mode, shell-pop, scratch-buffer, restart-emacs, org-export, spell-correct, indent-bars, vlf, eldoc, project-find-file, makefile-executor, diff-hl-margin, meow, nix-mode, plantuml, auto-compile
ober
69e87afca4e0b069b9ad6f3519af7d2ec13a5b5b
--- a/src/jerboa-emacs/editor-extra-media2.ss +++ b/src/jerboa-emacs/editor-extra-media2.ss @@ -2419,3 +2419,366 @@ (let ((ed (edit-window-editor (current-window (app-state-frame app))))) (send-message ed SCI_SETCARETWIDTH w 0) (echo-message! echo (string-append "Cursor width: " (number->string w))))))))) + +;;;============================================================================ +;;; Round 5 batch 2: Features 11-20 +;;;============================================================================ + +;; --- Feature 11: Indent Bars (visual indent column lines) --- + +(def *indent-bars-enabled* #f) +(def *indent-bars-char* #\|) + +(def (cmd-indent-bars-mode app) + "Toggle indent-bars — show visual indent guides as column lines." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (set! *indent-bars-enabled* (not *indent-bars-enabled*)) + (if *indent-bars-enabled* + (begin + ;; Use Scintilla indent guides + (send-message ed SCI_SETINDENTATIONGUIDES 3 0) ;; SC_IV_LOOKBOTH + (echo-message! echo "Indent bars: on")) + (begin + (send-message ed SCI_SETINDENTATIONGUIDES 0 0) ;; SC_IV_NONE + (echo-message! echo "Indent bars: off"))))) + +;; --- Feature 12: VLF (View Large Files) --- + +(def *vlf-chunk-size* 10000) ;; lines per chunk + +(def (cmd-vlf-mode app) + "Open a large file in chunked viewing mode." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (path (echo-read-string echo "VLF file: " row width))) + (when (and path (not (string-empty? path))) + (if (not (file-exists? path)) + (echo-error! echo (string-append "File not found: " path)) + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + ;; Read only first chunk + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "head -" (number->string *vlf-chunk-size*) " \"" path "\"") + 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (let* ((content (string-join (reverse lines) "\n")) + (buf (make-buffer (string-append "[vlf] " (path-strip-directory path))))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (send-message ed SCI_SETREADONLY 1 0) + (echo-message! echo + (string-append "VLF: showing first " (number->string (length lines)) + " lines of " path)))) + (loop (cons line lines))))))))))) + +;; --- Feature 13: Eldoc (show documentation at point) --- + +(def *eldoc-enabled* #f) +(def *eldoc-docs* (make-hash-table)) + +;; Pre-populate some Scheme/Jerboa documentation +(def (eldoc-init!) + (for-each + (lambda (entry) + (hash-put! *eldoc-docs* (car entry) (cdr entry))) + '((define . "define name expr — bind name to value") + (lambda . "lambda (args ...) body ... — create procedure") + (let . "let ((var val) ...) body — local bindings") + (let* . "let* ((var val) ...) body — sequential bindings") + (if . "if test then else — conditional") + (cond . "cond (test expr ...) ... (else expr ...) — multi-branch conditional") + (match . "match val (pattern body) ... — pattern matching") + (def . "def (name args ...) body — define function") + (defstruct . "defstruct name (fields ...) — define structure type") + (for/collect . "for/collect ((var iter)) body — collect loop results") + (for/fold . "for/fold ((acc init)) ((var iter)) body — fold over iterator") + (hash-put! . "hash-put! ht key val — set hash table entry") + (hash-ref . "hash-ref ht key [default] — get hash table entry") + (string-split . "string-split str delimiter-char — split string") + (string-join . "string-join strs sep — join strings") + (map . "map proc lst ... — apply proc to each element") + (filter . "filter pred lst — keep elements matching predicate") + (sort . "sort predicate lst — sort list by predicate") + (try . "try expr (catch (e) handler) (finally cleanup)") + (with-catch . "with-catch handler thunk — catch exceptions")))) + +(eldoc-init!) + +(def (cmd-eldoc-mode app) + "Toggle eldoc — show function documentation at point." + (set! *eldoc-enabled* (not *eldoc-enabled*)) + (echo-message! (app-state-echo app) + (if *eldoc-enabled* "Eldoc mode: on" "Eldoc mode: off"))) + +(def (cmd-eldoc-show app) + "Show documentation for symbol at point." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (word-start (send-message ed SCI_WORDSTARTPOSITION pos 1)) + (word-end (send-message ed SCI_WORDENDPOSITION pos 1)) + (word-len (- word-end word-start))) + (if (<= word-len 0) + (echo-message! echo "") + (let* ((buf (make-bytevector (+ word-len 1) 0)) + (_ (send-message ed SCI_GETTEXTRANGE 0 + (cons->alien word-start (bytevector->alien buf)))) + (word (alien/nul->string (bytevector->alien buf))) + (sym (string->symbol word)) + (doc (hash-get *eldoc-docs* sym))) + (if doc + (echo-message! echo doc) + (echo-message! echo (string-append word " — no documentation"))))))) + +;; --- Feature 14: Project Find File --- + +(def (cmd-project-find-file app) + "Find file in current project (git repo root)." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols))) + ;; Get git root + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports "git rev-parse --show-toplevel 2>/dev/null" + 'block (native-transcoder)))) + (close-port p-stdin) + (let ((root (let ((l (get-line p-stdout))) + (close-port p-stdout) + (close-port p-stderr) + (if (eof-object? l) #f (string-trim l))))) + (if (not root) + (echo-error! echo "Not in a git project") + ;; List tracked files + (let-values (((p2-stdin p2-stdout p2-stderr p2-pid) + (open-process-ports + (string-append "git -C \"" root "\" ls-files 2>/dev/null | head -500") + 'block (native-transcoder)))) + (close-port p2-stdin) + (let loop ((files '())) + (let ((line (get-line p2-stdout))) + (if (eof-object? line) + (begin + (close-port p2-stdout) + (close-port p2-stderr) + (if (null? files) + (echo-message! echo "No files found in project") + (let ((choice (echo-read-string-with-completion echo + "Find file in project: " (reverse files) row width))) + (when (and choice (not (string-empty? choice))) + (let ((full-path (string-append root "/" choice))) + (execute-command! app 'find-file)))))) + (loop (cons (string-trim line) files))))))))))) + +;; --- Feature 15: Makefile Executor --- + +(def (cmd-makefile-executor app) + "List and execute Makefile targets." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols))) + (if (not (file-exists? "Makefile")) + (echo-error! echo "No Makefile in current directory") + ;; Extract targets from Makefile + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + "grep -E '^[a-zA-Z0-9_-]+:' Makefile | sed 's/:.*//' | head -50" + 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((targets '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (if (null? targets) + (echo-message! echo "No targets found") + (let ((choice (echo-read-string-with-completion echo + "Make target: " (reverse targets) row width))) + (when (and choice (not (string-empty? choice))) + ;; Run the target using compile command infrastructure + (echo-message! echo (string-append "Running: make " choice "...")) + (let* ((fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win))) + (let-values (((p2-stdin p2-stdout p2-stderr p2-pid) + (open-process-ports + (string-append "make " choice " 2>&1") + 'block (native-transcoder)))) + (close-port p2-stdin) + (let lp ((lines '())) + (let ((l (get-line p2-stdout))) + (if (eof-object? l) + (begin + (close-port p2-stdout) + (close-port p2-stderr) + (let* ((content (string-join (reverse lines) "\n")) + (buf (make-buffer "*make*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (string-append "make " choice " — done")))) + (lp (cons l lines))))))))))) + (loop (cons (string-trim line) targets))))))))) + +;; --- Feature 16: Diff-HL Margin (show diff marks in gutter) --- + +(def *diff-hl-margin-enabled* #f) + +(def (cmd-diff-hl-margin-mode app) + "Toggle diff-hl margin markers — show git changes in gutter." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (set! *diff-hl-margin-enabled* (not *diff-hl-margin-enabled*)) + (if *diff-hl-margin-enabled* + (begin + ;; Set up margin 4 for diff marks + (send-message ed SCI_SETMARGINWIDTHN 4 4) + (send-message ed SCI_SETMARGINTYPEN 4 0) ;; SC_MARGIN_SYMBOL + (send-message ed SCI_SETMARGINSENSITIVEN 4 0) + ;; Define markers: 3=added (green), 4=changed (yellow), 5=deleted (red) + (send-message ed SCI_MARKERDEFINE 3 0) ;; SC_MARK_CIRCLE for added + (send-message ed SCI_MARKERSETFORE 3 #x00CC00) + (send-message ed SCI_MARKERSETBACK 3 #x00CC00) + (send-message ed SCI_MARKERDEFINE 4 0) + (send-message ed SCI_MARKERSETFORE 4 #xCCCC00) + (send-message ed SCI_MARKERSETBACK 4 #xCCCC00) + (send-message ed SCI_MARKERDEFINE 5 0) + (send-message ed SCI_MARKERSETFORE 5 #xCC0000) + (send-message ed SCI_MARKERSETBACK 5 #xCC0000) + (echo-message! echo "Diff-HL margin: on")) + (begin + (send-message ed SCI_SETMARGINWIDTHN 4 0) + (echo-message! echo "Diff-HL margin: off"))))) + +;; --- Feature 17: Meow (modal editing — basic vi-like normal mode) --- + +(def *meow-state* 'insert) ;; insert or normal +(def *meow-enabled* #f) + +(def (cmd-meow-mode app) + "Toggle meow modal editing mode." + (set! *meow-enabled* (not *meow-enabled*)) + (when (not *meow-enabled*) + (set! *meow-state* 'insert)) + (echo-message! (app-state-echo app) + (if *meow-enabled* + "Meow mode: on (ESC=normal, i=insert)" + "Meow mode: off"))) + +(def (cmd-meow-normal app) + "Enter meow normal state." + (when *meow-enabled* + (set! *meow-state* 'normal) + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETCARETSTYLE 2 0)) ;; block cursor + (echo-message! (app-state-echo app) "-- NORMAL --"))) + +(def (cmd-meow-insert app) + "Enter meow insert state." + (when *meow-enabled* + (set! *meow-state* 'insert) + (let ((ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETCARETSTYLE 1 0)) ;; bar cursor + (echo-message! (app-state-echo app) "-- INSERT --"))) + +(def (meow-normal-state?) (and *meow-enabled* (eq? *meow-state* 'normal))) + +;; --- Feature 18: Nix Mode --- + +(def (cmd-nix-mode app) + "Enable Nix expression mode hints." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETTABWIDTH 2 0) + (send-message ed SCI_SETUSETABS 0 0) + (echo-message! echo "Nix mode: tab=2, spaces"))) + +;; --- Feature 19: PlantUML Mode --- + +(def (cmd-plantuml-mode app) + "Enable PlantUML mode hints." + (echo-message! (app-state-echo app) "PlantUML mode enabled")) + +(def (cmd-plantuml-preview app) + "Preview PlantUML diagram (requires plantuml installed)." + (let* ((echo (app-state-echo app)) + (buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf)))) + (if (not path) + (echo-error! echo "Buffer has no file — save first") + (if (not (file-exists? "/usr/bin/plantuml")) + (echo-error! echo "plantuml not installed") + (let ((cmd (string-append "plantuml -ttxt \"" path "\" -o /tmp 2>&1"))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports cmd 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + ;; Try to read the text output + (let ((txt-path (string-append "/tmp/" + (path-strip-extension (path-strip-directory path)) ".atxt"))) + (if (file-exists? txt-path) + (let* ((content (read-file-string txt-path)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (pbuf (make-buffer "*plantuml-preview*"))) + (buffer-attach! ed pbuf) + (set! (edit-window-buffer win) pbuf) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo "PlantUML preview rendered")) + (echo-message! echo "PlantUML output not found")))) + (loop (cons line lines))))))))))) + +;; --- Feature 20: Auto-Compile (auto-compile scheme files on save) --- + +(def *auto-compile-enabled* #f) + +(def (cmd-auto-compile-mode app) + "Toggle auto-compile — compile .ss files on save." + (set! *auto-compile-enabled* (not *auto-compile-enabled*)) + (echo-message! (app-state-echo app) + (if *auto-compile-enabled* + "Auto-compile mode: on (will compile .ss on save)" + "Auto-compile mode: off"))) + +(def (auto-compile-check! app) + "After save, compile if auto-compile is on and file is .ss." + (when *auto-compile-enabled* + (let* ((buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf)))) + (when (and path (string-suffix? ".ss" path)) + (let ((echo (app-state-echo app))) + (echo-message! echo (string-append "Compiling " (path-strip-directory path) "...")) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports + (string-append "make build 2>&1 | tail -5") + 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (let ((output (string-join (reverse lines) " "))) + (echo-message! echo + (if (string-contains output "0 errors") + "Compiled successfully" + (string-append "Compile: " output))))) + (loop (cons line lines))))))))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1493,4 +1493,31 @@ (register-command! 'fontaine-set-preset cmd-fontaine-set-preset) (register-command! 'shr-render cmd-shr-render) (register-command! 'auto-theme-switch cmd-auto-theme-switch) + ;; Round 5 batch 1: restclient, markdown-preview, git-messenger, yaml, dockerfile, shell-pop, scratch, restart, org-export, spell-correct + (register-command! 'restclient cmd-restclient) + (register-command! 'restclient-send cmd-restclient-send) + (register-command! 'markdown-preview cmd-markdown-preview) + (register-command! 'git-messenger cmd-git-messenger) + (register-command! 'yaml-mode cmd-yaml-mode) + (register-command! 'dockerfile-mode cmd-dockerfile-mode) + (register-command! 'shell-pop cmd-shell-pop) + (register-command! 'scratch-buffer cmd-scratch-buffer) + (register-command! 'restart-emacs cmd-restart-emacs) + (register-command! 'org-export-as-text cmd-org-export-as-text) + (register-command! 'spell-correct cmd-spell-correct) + ;; Round 5 batch 2: indent-bars, vlf, eldoc, project-find-file, makefile-executor, diff-hl-margin, meow, nix, plantuml, auto-compile + (register-command! 'indent-bars-mode cmd-indent-bars-mode) + (register-command! 'vlf-mode cmd-vlf-mode) + (register-command! 'eldoc-mode cmd-eldoc-mode) + (register-command! 'eldoc-show cmd-eldoc-show) + (register-command! 'project-find-file cmd-project-find-file) + (register-command! 'makefile-executor cmd-makefile-executor) + (register-command! 'diff-hl-margin-mode cmd-diff-hl-margin-mode) + (register-command! 'meow-mode cmd-meow-mode) + (register-command! 'meow-normal cmd-meow-normal) + (register-command! 'meow-insert cmd-meow-insert) + (register-command! 'nix-mode cmd-nix-mode) + (register-command! 'plantuml-mode cmd-plantuml-mode) + (register-command! 'plantuml-preview cmd-plantuml-preview) + (register-command! 'auto-compile-mode cmd-auto-compile-mode) ) --- a/src/jerboa-emacs/editor-extra-vcs.ss +++ b/src/jerboa-emacs/editor-extra-vcs.ss @@ -2023,3 +2023,339 @@ (def (cmd-multi-vterm app) "Open a new terminal buffer (delegates to shell command)." (execute-command! app 'shell)) + +;;;============================================================================ +;;; Round 5 batch 1: Features 1-10 +;;;============================================================================ + +;; --- Feature 1: Restclient (HTTP client for testing APIs) --- + +(def (cmd-restclient app) + "Open an HTTP restclient buffer for testing APIs." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (buf (make-buffer "*restclient*")) + (template (string-append + "# HTTP Restclient\n" + "# Lines starting with # are comments\n" + "# Enter URL and press M-x restclient-send\n" + "#\n" + "# Example:\n" + "GET https://httpbin.org/get\n" + "#\n" + "# POST https://httpbin.org/post\n" + "# Content-Type: application/json\n" + "# {\"key\": \"value\"}\n"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed template) + (editor-goto-pos ed 0) + (echo-message! echo "Restclient buffer ready"))) + +(def (cmd-restclient-send app) + "Send HTTP request from restclient buffer using curl." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (text (editor-get-text ed)) + (lines (string-split text #\newline)) + ;; Find first non-comment, non-empty line as the request + (req-line (let loop ((ls lines)) + (cond ((null? ls) #f) + ((string-empty? (string-trim (car ls))) (loop (cdr ls))) + ((string-prefix? "#" (string-trim (car ls))) (loop (cdr ls))) + (else (string-trim (car ls))))))) + (if (not req-line) + (echo-error! echo "No request found") + (let* ((parts (string-split req-line #\space)) + (method (if (>= (length parts) 1) (car parts) "GET")) + (url (if (>= (length parts) 2) (cadr parts) ""))) + (when (not (string-empty? url)) + (echo-message! echo (string-append "Sending " method " " url "...")) + (let ((cmd (string-append "curl -s -X " method " \"" url "\" 2>&1"))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports cmd 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (let* ((response (string-join (reverse lines) "\n")) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed2 (edit-window-editor win)) + (buf (make-buffer "*restclient-response*"))) + (buffer-attach! ed2 buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed2 response) + (editor-goto-pos ed2 0) + (echo-message! echo (string-append method " " url " — done")))) + (loop (cons line lines)))))))))))) + +;; --- Feature 2: Markdown Preview --- + +(def (cmd-markdown-preview app) + "Render markdown buffer to plain text approximation." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (md (editor-get-text ed)) + (lines (string-split md #\newline)) + ;; Simple markdown to text: headers become UPPERCASE, emphasis stripped + (rendered + (map (lambda (line) + (let ((trimmed (string-trim line))) + (cond + ((string-prefix? "### " trimmed) + (string-append "\n " (string-upcase (substring trimmed 4 (string-length trimmed))) "\n")) + ((string-prefix? "## " trimmed) + (string-append "\n" (string-upcase (substring trimmed 3 (string-length trimmed))) + "\n" (make-string (- (string-length trimmed) 3) #\-))) + ((string-prefix? "# " trimmed) + (string-append "\n" (string-upcase (substring trimmed 2 (string-length trimmed))) + "\n" (make-string (- (string-length trimmed) 2) #\=))) + ((string-prefix? "- " trimmed) + (string-append " * " (substring trimmed 2 (string-length trimmed)))) + ((string-prefix? "```" trimmed) (make-string 40 #\-)) + ((string-prefix? "---" trimmed) (make-string 40 #\-)) + (else line)))) + lines)) + (result (string-join rendered "\n")) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed2 (edit-window-editor win)) + (buf (make-buffer "*markdown-preview*"))) + (buffer-attach! ed2 buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed2 result) + (editor-goto-pos ed2 0) + (echo-message! echo "Markdown preview rendered"))) + +;; --- Feature 3: Git Messenger (show git blame for current line) --- + +(def (cmd-git-messenger app) + "Show git blame information for current line." + (let* ((echo (app-state-echo app)) + (buf (current-buffer-from-app app)) + (path (and buf (buffer-file-path buf))) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (line (+ 1 (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0)))) + (if (not path) + (echo-error! echo "Buffer has no file") + (let ((cmd (string-append "git blame -L " (number->string line) "," (number->string line) + " --porcelain \"" path "\" 2>&1"))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports cmd 'block (native-transcoder)))) + (close-port p-stdin) + (let loop ((lines '())) + (let ((l (get-line p-stdout))) + (if (eof-object? l) + (begin + (close-port p-stdout) + (close-port p-stderr) + (if (null? lines) + (echo-message! echo "No blame data") + ;; Parse porcelain: extract author, date, summary + (let* ((all (reverse lines)) + (author (let find ((ls all)) + (cond ((null? ls) "unknown") + ((string-prefix? "author " (car ls)) + (substring (car ls) 7 (string-length (car ls)))) + (else (find (cdr ls)))))) + (summary (let find ((ls all)) + (cond ((null? ls) "") + ((string-prefix? "summary " (car ls)) + (substring (car ls) 8 (string-length (car ls)))) + (else (find (cdr ls)))))) + (date (let find ((ls all)) + (cond ((null? ls) "") + ((string-prefix? "author-time " (car ls)) + (substring (car ls) 12 (string-length (car ls)))) + (else (find (cdr ls))))))) + (echo-message! echo + (string-append author ": " summary))))) + (loop (cons l lines)))))))))) + +;; --- Feature 4: YAML Mode (basic YAML syntax highlighting hints) --- + +(def (cmd-yaml-mode app) + "Enable YAML mode hints for current buffer." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + ;; Set tab width to 2 (YAML standard) + (send-message ed SCI_SETTABWIDTH 2 0) + (send-message ed SCI_SETUSETABS 0 0) ;; spaces only + (echo-message! echo "YAML mode: tab=2, spaces only"))) + +;; --- Feature 5: Dockerfile Mode --- + +(def (cmd-dockerfile-mode app) + "Enable Dockerfile mode hints." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app))))) + (send-message ed SCI_SETTABWIDTH 4 0) + (echo-message! echo "Dockerfile mode enabled"))) + +;; --- Feature 6: Shell Pop (toggle terminal buffer) --- + +(def *shell-pop-buffer* #f) +(def *shell-pop-prev-buffer* #f) + +(def (cmd-shell-pop app) + "Toggle between current buffer and shell buffer." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (current-buf (edit-window-buffer win))) + (if (and current-buf *shell-pop-buffer* + (eq? current-buf *shell-pop-buffer*)) + ;; Currently in shell — switch back + (when *shell-pop-prev-buffer* + (let ((ed (edit-window-editor win))) + (buffer-attach! ed *shell-pop-prev-buffer*) + (set! (edit-window-buffer win) *shell-pop-prev-buffer*) + (echo-message! echo "Shell popped down"))) + ;; Not in shell — switch to shell + (begin + (set! *shell-pop-prev-buffer* current-buf) + (let* ((shell-buf (or *shell-pop-buffer* + (let ((b (make-buffer "*shell-pop*"))) + (set! *shell-pop-buffer* b) + b))) + (ed (edit-window-editor win))) + (buffer-attach! ed shell-buf) + (set! (edit-window-buffer win) shell-buf) + (echo-message! echo "Shell popped up (use shell-pop to toggle back)")))))) + +;; --- Feature 7: Scratch Buffer --- + +(def *scratch-message* + (string-append ";; *scratch* buffer — for temporary notes and experiments\n" + ";; This buffer is not saved. Use it freely.\n" + ";;\n" + ";; Scheme expressions can be evaluated with M-x eros-eval-last-sexp\n\n")) + +(def (cmd-scratch-buffer app) + "Switch to *scratch* buffer, creating it if needed." + (let* ((echo (app-state-echo app)) + (fr (app-state-frame app)) + (win (current-window fr)) + (ed (edit-window-editor win)) + (existing (buffer-by-name "*scratch*"))) + (if existing + (begin + (buffer-attach! ed existing) + (set! (edit-window-buffer win) existing) + (echo-message! echo "*scratch*")) + (let ((buf (make-buffer "*scratch*"))) + (buffer-attach! ed buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed *scratch-message*) + (editor-goto-pos ed (string-length *scratch-message*)) + (echo-message! echo "*scratch* (new)"))))) + +;; --- Feature 8: Restart Emacs --- + +(def (cmd-restart-emacs app) + "Restart the editor (save session and exec self)." + (let ((echo (app-state-echo app))) + (echo-message! echo "Restart not supported in static binary — please relaunch manually"))) + +;; --- Feature 9: Org Export (basic org to text/HTML) --- + +(def (cmd-org-export-as-text app) + "Export current org buffer as plain text." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (org-text (editor-get-text ed)) + (lines (string-split org-text #\newline)) + (exported + (map (lambda (line) + (let ((t (string-trim line))) + (cond + ((string-prefix? "* " t) + (string-append "\n" (string-upcase (substring t 2 (string-length t))) "\n" + (make-string (- (string-length t) 2) #\=))) + ((string-prefix? "** " t) + (string-append "\n" (substring t 3 (string-length t)) "\n" + (make-string (- (string-length t) 3) #\-))) + ((string-prefix? "*** " t) + (string-append "\n " (substring t 4 (string-length t)))) + ((string-prefix? "- " t) + (string-append " * " (substring t 2 (string-length t)))) + ((string-prefix? "#+BEGIN_SRC" t) (make-string 40 #\-)) + ((string-prefix? "#+END_SRC" t) (make-string 40 #\-)) + ((string-prefix? "#+" t) "") ;; skip org directives + (else line)))) + lines)) + (result (string-join exported "\n")) + (fr (app-state-frame app)) + (win (current-window fr)) + (buf (make-buffer "*org-export*"))) + (let ((ed2 (edit-window-editor win))) + (buffer-attach! ed2 buf) + (set! (edit-window-buffer win) buf) + (editor-set-text ed2 result) + (editor-goto-pos ed2 0) + (echo-message! echo "Org exported as text")))) + +;; --- Feature 10: Spell Correct (word correction suggestions) --- + +(def (cmd-spell-correct app) + "Suggest spelling corrections for word at point." + (let* ((echo (app-state-echo app)) + (ed (edit-window-editor (current-window (app-state-frame app)))) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (word-start (send-message ed SCI_WORDSTARTPOSITION pos 1)) + (word-end (send-message ed SCI_WORDENDPOSITION pos 1)) + (word-len (- word-end word-start))) + (if (<= word-len 0) + (echo-error! echo "No word at point") + (let* ((buf (make-bytevector (+ word-len 1) 0)) + (_ (send-message ed SCI_GETTEXTRANGE 0 + (cons->alien word-start (bytevector->alien buf)))) + (word (alien/nul->string (bytevector->alien buf))) + (row (tui-rows)) (width (tui-cols))) + ;; Use aspell for suggestions if available + (if (not (file-exists? "/usr/bin/aspell")) + (echo-error! echo "aspell not found — install aspell for spell checking") + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports "aspell -a 2>&1" 'block (native-transcoder)))) + ;; aspell interactive mode: send word, read suggestions + (display (string-append word "\n") p-stdin) + (flush-output-port p-stdin) + (close-port p-stdin) + (let loop ((lines '())) + (let ((line (get-line p-stdout))) + (if (eof-object? line) + (begin + (close-port p-stdout) + (close-port p-stderr) + (let* ((suggestions + (filter (lambda (l) (or (string-prefix? "&" l) (string-prefix? "*" l))) + (reverse lines)))) + (if (or (null? suggestions) + (and (not (null? suggestions)) + (string-prefix? "*" (car suggestions)))) + (echo-message! echo (string-append "\"" word "\" is correct")) + ;; Parse aspell & line: & word count offset: sugg1, sugg2, ... + (let* ((sug-line (car suggestions)) + (colon-pos (string-contains sug-line ":")) + (sug-str (if colon-pos + (string-trim (substring sug-line (+ colon-pos 1) (string-length sug-line))) + "")) + (sug-list (map string-trim (string-split sug-str #\,))) + (choice (echo-read-string-with-completion echo + (string-append "Correct \"" word "\": ") + (if (> (length sug-list) 10) (list-head sug-list 10) sug-list) + row width))) + (when (and choice (not (string-empty? choice))) + (send-message ed SCI_SETTARGETSTART word-start 0) + (send-message ed SCI_SETTARGETEND word-end 0) + (send-message ed SCI_REPLACETARGET (string-length choice) + (string->alien/nul choice)) + (echo-message! echo (string-append "Corrected: " word " → " choice))))))) + (loop (cons line lines)))))))))))