Round 20: Add 20 new Emacs features
ober
0f04e0c86a8bd46f9dc388f9225ba38c55d4a976
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1506,6 +1506,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | Apt search | :orange_circle: | Search apt packages | | Connect Four | :orange_circle: | Connect Four board game | | Fifteen puzzle | :orange_circle: | 15-puzzle sliding tile game | +| Currency convert | :orange_circle: | Currency conversion via Python | +| Wikipedia summary | :orange_circle: | Fetch Wikipedia article summaries | +| Man page | :orange_circle: | View man pages in buffer | +| Info page | :orange_circle: | View info pages in buffer | +| TLDR page | :orange_circle: | View tldr simplified man pages | +| Tutorial mode | :orange_circle: | Built-in jemacs tutorial | +| Version info | :orange_circle: | Display jemacs version info | +| Changelog view | :orange_circle: | View git changelog in buffer | +| Bug report mode | :orange_circle: | Generate bug report template | +| Color theme select | :orange_circle: | Theme selector with preview | +| Paredit mode | :orange_circle: | Paredit structural editing reference | +| Hi-lock mode | :orange_circle: | Highlight pattern occurrences | +| Syntax highlight region | :orange_circle: | Region syntax statistics | +| Stack Overflow search | :orange_circle: | Stack Overflow search helper | +| Cheat sheet | :orange_circle: | Editor keybinding cheat sheet | +| Apropos documentation | :orange_circle: | Search commands by keyword | +| Scratch message | :orange_circle: | Insert default *scratch* message | +| Geiser mode | :orange_circle: | Geiser Scheme interaction reference | +| SLY mode | :orange_circle: | SLY Common Lisp IDE reference | +| SLIME mode | :orange_circle: | SLIME Common Lisp IDE reference | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -7396,3 +7396,290 @@ "Goal: arrange 1-15 in order with blank in bottom-right.\n"))) (editor-set-text ed text) (echo-message! echo "Fifteen puzzle! Use M-x puzzle-move")))) + +;; Round 20 batch 2: paredit-mode, hi-lock-mode, syntax-highlight-region, stack-overflow-search, +;; cheat-sheet, apropos-documentation, scratch-message, geiser-mode, sly-mode, slime-mode + +;; cmd-paredit-mode: Show paredit-style structural editing cheat sheet +(def (cmd-paredit-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (str "=== Paredit Mode Reference ===\n\n" + "Paredit provides structural editing for S-expressions.\n\n" + "Key Bindings (conceptual):\n" + " C-( paredit-open-round Insert () and place cursor inside\n" + " C-) paredit-close-round Move past next closing paren\n" + " M-( paredit-wrap-round Wrap next sexp in ()\n" + " M-s paredit-splice-sexp Remove surrounding parens\n" + " C-right paredit-forward-slurp Pull next sexp into current list\n" + " C-left paredit-forward-barf Push last sexp out of current list\n" + " M-r paredit-raise-sexp Replace parent with current sexp\n" + " M-S paredit-split-sexp Split current sexp at cursor\n" + " M-J paredit-join-sexp Join adjacent sexps\n\n" + "Navigation:\n" + " C-M-f forward-sexp\n" + " C-M-b backward-sexp\n" + " C-M-u backward-up-list\n" + " C-M-d down-list\n\n" + "Note: These are reference commands. Full structural\n" + "enforcement is not yet implemented.\n"))) + (editor-set-text ed text) + (echo-message! echo "Paredit reference loaded"))) + +;; cmd-hi-lock-mode: Highlight all occurrences of a pattern in current buffer +(def (cmd-hi-lock-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pattern (echo-read-string echo "Hi-lock pattern: "))) + (if (or (not pattern) (string=? pattern "")) + (echo-message! echo "No pattern specified") + (let* ((text (editor-get-text ed)) + (pat-len (string-length pattern)) + (text-len (string-length text))) + (let loop ((pos 0) (count 0)) + (if (> (+ pos pat-len) text-len) + (echo-message! echo (str "Hi-lock: highlighted " count " occurrences of \"" pattern "\"")) + (let ((idx (string-contains text pattern pos))) + (if (not idx) + (echo-message! echo (str "Hi-lock: highlighted " count " occurrences of \"" pattern "\"")) + (begin + (editor-indicator-fill ed 18 idx (+ idx pat-len)) + (loop (+ idx pat-len) (+ count 1))))))))))) + +;; cmd-syntax-highlight-region: Show syntax info for the selected region +(def (cmd-syntax-highlight-region app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (sel-start (editor-selection-start ed)) + (sel-end (editor-selection-end ed))) + (if (= sel-start sel-end) + (echo-message! echo "No region selected") + (let* ((region-text (editor-get-text-range ed sel-start sel-end)) + (char-count (string-length region-text)) + (line-count (+ 1 (let loop ((i 0) (n 0)) + (if (>= i char-count) n + (loop (+ i 1) (if (char=? (string-ref region-text i) #\newline) (+ n 1) n)))))) + (word-count (length (let split ((s region-text) (words '())) + (let ((trimmed (string-trim s))) + (if (string=? trimmed "") words + (let find-space ((i 0)) + (if (>= i (string-length trimmed)) + (cons trimmed words) + (if (char-whitespace? (string-ref trimmed i)) + (split (substring trimmed i (string-length trimmed)) + (cons (substring trimmed 0 i) words)) + (find-space (+ i 1)))))))))) + (text (str "=== Region Syntax Info ===\n\n" + "Selection: " sel-start " to " sel-end "\n" + "Characters: " char-count "\n" + "Lines: " line-count "\n" + "Words: " word-count "\n\n" + "--- Region Content ---\n" + region-text "\n"))) + (echo-message! echo (str "Region: " char-count " chars, " line-count " lines, " word-count " words")))))) + +;; cmd-stack-overflow-search: Search Stack Overflow via DuckDuckGo +(def (cmd-stack-overflow-search app) + (let* ((echo (app-state-echo app)) + (buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (query (echo-read-string echo "Stack Overflow search: "))) + (if (or (not query) (string=? query "")) + (echo-message! echo "No query specified") + (let* ((encoded-q query) + (url (str "https://stackoverflow.com/search?q=" encoded-q)) + (text (str "=== Stack Overflow Search ===\n\n" + "Query: " query "\n\n" + "URL: " url "\n\n" + "To search Stack Overflow, visit the URL above.\n\n" + "Tips:\n" + " - Use [tag] syntax to filter by technology\n" + " - Example: [python] how to read CSV\n" + " - Use 'is:answer' to only search answers\n" + " - Use 'score:3' for highly rated content\n" + " - Use 'user:me' for your own posts\n\n" + "Common Tags:\n" + " [scheme] [lisp] [emacs] [linux]\n" + " [python] [javascript] [c] [rust]\n"))) + (editor-set-text ed text) + (echo-message! echo (str "Stack Overflow: " url)))))) + +;; cmd-cheat-sheet: Display a cheat sheet for common editor commands +(def (cmd-cheat-sheet app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (str "=== jemacs Cheat Sheet ===\n\n" + "--- Movement ---\n" + " C-f / C-b Forward/backward char\n" + " M-f / M-b Forward/backward word\n" + " C-a / C-e Beginning/end of line\n" + " C-n / C-p Next/previous line\n" + " M-< / M-> Beginning/end of buffer\n" + " C-v / M-v Page down/up\n" + " C-l Recenter\n\n" + "--- Editing ---\n" + " C-d Delete char forward\n" + " Backspace Delete char backward\n" + " M-d Kill word forward\n" + " C-k Kill to end of line\n" + " C-y Yank (paste)\n" + " M-y Yank-pop (cycle kill ring)\n" + " C-/ Undo\n" + " C-x u Undo\n\n" + "--- Search ---\n" + " C-s Isearch forward\n" + " C-r Isearch backward\n" + " M-% Query replace\n\n" + "--- Files ---\n" + " C-x C-f Find file\n" + " C-x C-s Save file\n" + " C-x C-w Write file (save as)\n" + " C-x b Switch buffer\n" + " C-x k Kill buffer\n\n" + "--- Windows ---\n" + " C-x 2 Split horizontal\n" + " C-x 3 Split vertical\n" + " C-x 1 Delete other windows\n" + " C-x 0 Delete this window\n" + " C-x o Other window\n\n" + "--- Help ---\n" + " C-h k Describe key\n" + " C-h f Describe function\n" + " M-x Execute command\n"))) + (editor-set-text ed text) + (echo-message! echo "Cheat sheet displayed"))) + +;; cmd-apropos-documentation: Search commands by keyword +(def (cmd-apropos-documentation app) + (let* ((echo (app-state-echo app)) + (buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (query (echo-read-string echo "Apropos: "))) + (if (or (not query) (string=? query "")) + (echo-message! echo "No query specified") + (let* ((all-cmds (hash-keys (app-state-commands app))) + (matches (filter (lambda (sym) + (string-contains (symbol->string sym) query)) + all-cmds)) + (sorted (sort string<? + (map symbol->string matches))) + (text (str "=== Apropos: \"" query "\" ===\n\n" + "Found " (length sorted) " matching commands:\n\n" + (string-join + (map (lambda (name) + (str " M-x " name)) + sorted) + "\n") + "\n"))) + (editor-set-text ed text) + (echo-message! echo (str "Apropos: " (length sorted) " matches for \"" query "\"")))))) + +;; cmd-scratch-message: Insert the default *scratch* buffer message +(def (cmd-scratch-message app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (str ";; This buffer is for text that is not saved, and for Scheme evaluation.\n" + ";; To create a file, visit it with C-x C-f and enter text in its buffer.\n" + ";;\n" + ";; Welcome to jemacs - a Chez Scheme Emacs-like editor.\n" + ";;\n" + ";; Quick start:\n" + ";; C-x C-f Open a file\n" + ";; C-x C-s Save current buffer\n" + ";; C-x b Switch buffer\n" + ";; C-x k Kill buffer\n" + ";; C-h ? Help\n" + ";; M-x Execute command by name\n" + ";;\n" + ";; Type Scheme expressions and use M-x eval-buffer to evaluate.\n\n"))) + (editor-set-text ed text) + (echo-message! echo "*scratch* message inserted"))) + +;; cmd-geiser-mode: Show Geiser REPL reference for Scheme interaction +(def (cmd-geiser-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (str "=== Geiser Mode Reference ===\n\n" + "Geiser provides Scheme interaction in Emacs.\n\n" + "Key Bindings (GNU Emacs reference):\n" + " C-c C-z Switch to REPL\n" + " C-c C-a Switch to REPL and enter module\n" + " C-x C-e Eval last sexp\n" + " C-c C-r Eval region\n" + " C-c C-b Eval buffer\n" + " C-c C-e Eval last sexp and show result in echo\n" + " C-c C-d d Autodoc (show docs)\n" + " C-c C-d m Module documentation\n\n" + "Supported Schemes:\n" + " - Chez Scheme\n" + " - Guile\n" + " - Racket\n" + " - Chicken\n" + " - MIT/GNU Scheme\n" + " - Gambit\n\n" + "jemacs equivalent: M-x eval-expression, M-x eval-buffer\n"))) + (editor-set-text ed text) + (echo-message! echo "Geiser mode reference loaded"))) + +;; cmd-sly-mode: Show SLY (Sylvester the Cat's Common Lisp IDE) reference +(def (cmd-sly-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (str "=== SLY Mode Reference ===\n\n" + "SLY is a Common Lisp IDE for Emacs (fork of SLIME).\n\n" + "Key Bindings (GNU Emacs reference):\n" + " M-x sly Start SLY\n" + " C-c C-c Compile defun at point\n" + " C-c C-k Compile and load file\n" + " C-c C-z Switch to REPL\n" + " C-x C-e Eval last expression\n" + " M-. Go to definition\n" + " M-, Return from definition\n" + " C-c C-d d Describe symbol\n" + " C-c C-d h HyperSpec lookup\n" + " C-c I Inspect expression\n" + " C-c C-t Toggle trace\n\n" + "SLY Features over SLIME:\n" + " - Stickers (inline value tracking)\n" + " - Multiple REPLs\n" + " - Flex completion\n" + " - Improved backtraces\n\n" + "jemacs equivalent: M-x eval-expression, M-x eval-buffer\n"))) + (editor-set-text ed text) + (echo-message! echo "SLY mode reference loaded"))) + +;; cmd-slime-mode: Show SLIME (Superior Lisp Interaction Mode) reference +(def (cmd-slime-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (str "=== SLIME Mode Reference ===\n\n" + "SLIME is the Superior Lisp Interaction Mode for Emacs.\n\n" + "Key Bindings (GNU Emacs reference):\n" + " M-x slime Start SLIME\n" + " C-c C-c Compile defun at point\n" + " C-c C-k Compile and load file\n" + " C-c C-z Switch to REPL\n" + " C-x C-e Eval last expression\n" + " M-. Go to definition\n" + " M-, Return from definition\n" + " C-c C-d d Describe symbol\n" + " C-c C-d h HyperSpec lookup\n" + " C-c C-w c List callers\n" + " C-c C-w w List callees\n" + " C-c I Inspect expression\n" + " C-c C-t Toggle trace\n" + " C-c M-d Disassemble\n\n" + "Connection:\n" + " SLIME connects to a Swank server running in the\n" + " Lisp process. Supports SBCL, CCL, CLISP, etc.\n\n" + "jemacs equivalent: M-x eval-expression, M-x eval-buffer\n"))) + (editor-set-text ed text) + (echo-message! echo "SLIME mode reference loaded"))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -7746,4 +7746,333 @@ (editor-set-text new-ed (str "=== Environment Variables ===\n\n" (string-join (reverse lines) "\n") "\n"))) (echo-message! echo (str (length (reverse lines)) " environment variables"))) + (loop (cons line lines))))))))) + +;; ===== Round 20 Batch 1 ===== + +;; --- Feature 1: Currency Convert --- + +(def (cmd-currency-convert app) + "Convert between currencies using exchangerate.host API." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (input (echo-read-string echo "Convert (e.g. 100 USD EUR): " row width))) + (when (and input (not (string-empty? input))) + (let ((parts (string-split (string-trim input) #\space))) + (if (not (= (length parts) 3)) + (echo-message! echo "Format: AMOUNT FROM TO (e.g. 100 USD EUR)") + (let ((amount (car parts)) (from (cadr parts)) (to (caddr parts))) + (with-catch + (lambda (e) (echo-message! echo (str "Conversion error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "python3 -c 'import urllib.request,json;" + "r=urllib.request.urlopen(\"https://open.er-api.com/v6/latest/" + (string-upcase from) "\");" + "d=json.loads(r.read());" + "rate=d[\"rates\"][\"" (string-upcase to) "\"];" + "print(f\"{" amount " * rate:.2f}\")" + "' 2>/dev/null") + 'block (native-transcoder)))) + (close-port si) + (let ((result (get-line so))) + (close-port so) (close-port se) + (if (eof-object? result) + (echo-message! echo "Could not fetch exchange rate") + (echo-message! echo (str amount " " (string-upcase from) " = " + (string-trim result) " " (string-upcase to)))))))))))))) + +;; --- Feature 2: Wikipedia Summary --- + +(def (cmd-wikipedia-summary app) + "Fetch a Wikipedia article summary." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (row (tui-rows)) (width (tui-cols)) + (topic (echo-read-string echo "Wikipedia topic: " row width))) + (when (and topic (not (string-empty? topic))) + (with-catch + (lambda (e) (echo-message! echo (str "Wikipedia error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "curl -sL 'https://en.wikipedia.org/api/rest_v1/page/summary/" + (string-trim topic) + "' 2>/dev/null | python3 -c 'import sys,json;d=json.load(sys.stdin);print(d.get(\"title\",\"?\"));print();print(d.get(\"extract\",\"Not found\"))' 2>/dev/null") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((result (string-join (reverse lines) "\n")) + (new-buf (create-buffer (str "*wiki: " topic "*")))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed result)) + (echo-message! echo "Wikipedia summary loaded"))) + (loop (cons line lines)))))))))))) + +;; --- Feature 3: Man Page --- + +(def (cmd-man-page app) + "View a man page." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (row (tui-rows)) (width (tui-cols)) + (topic (echo-read-string echo "Man page: " row width))) + (when (and topic (not (string-empty? topic))) + (with-catch + (lambda (e) (echo-message! echo (str "man error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "man " (shell-quote (string-trim topic)) " 2>/dev/null | col -b | head -200") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((result (string-join (reverse lines) "\n")) + (new-buf (create-buffer (str "*man: " topic "*")))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed result)) + (echo-message! echo (str "Man page: " topic)))) + (loop (cons line lines))))))))))) + +;; --- Feature 4: Info Page --- + +(def (cmd-info-page app) + "View an info page." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (row (tui-rows)) (width (tui-cols)) + (topic (echo-read-string echo "Info page: " row width))) + (when (and topic (not (string-empty? topic))) + (with-catch + (lambda (e) (echo-message! echo (str "info error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "info " (shell-quote (string-trim topic)) " 2>/dev/null | head -200") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let* ((result (string-join (reverse lines) "\n")) + (new-buf (create-buffer (str "*info: " topic "*")))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed result)) + (echo-message! echo (str "Info page: " topic)))) + (loop (cons line lines))))))))))) + +;; --- Feature 5: TLDR Page --- + +(def (cmd-tldr-page app) + "View a tldr page (simplified man page)." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (row (tui-rows)) (width (tui-cols)) + (cmd (echo-read-string echo "TLDR for command: " row width))) + (when (and cmd (not (string-empty? cmd))) + (with-catch + (lambda (e) (echo-message! echo (str "tldr error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "tldr " (shell-quote (string-trim cmd)) " 2>/dev/null") + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let ((result (string-join (reverse lines) "\n"))) + (if (string-empty? result) + (echo-message! echo (str "No tldr page for: " cmd)) + (let* ((new-buf (create-buffer (str "*tldr: " cmd "*")))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed result)) + (echo-message! echo (str "TLDR: " cmd)))))) + (loop (cons line lines))))))))))) + +;; --- Feature 6: Tutorial Mode --- + +(def (cmd-tutorial-mode app) + "Show the jemacs tutorial." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*tutorial*"))) + (switch-to-buffer frame new-buf) + (let ((ed (edit-window-editor (current-window frame)))) + (editor-set-text ed + (str "=== Welcome to jemacs! ===\n\n" + "jemacs is a Chez Scheme Emacs-like editor.\n\n" + "== Basic Navigation ==\n" + " C-f / Right Move forward one character\n" + " C-b / Left Move backward one character\n" + " C-n / Down Move to next line\n" + " C-p / Up Move to previous line\n" + " C-a / Home Move to beginning of line\n" + " C-e / End Move to end of line\n" + " M-f Move forward one word\n" + " M-b Move backward one word\n" + " C-v Page down\n" + " M-v Page up\n" + " M-< Go to beginning of buffer\n" + " M-> Go to end of buffer\n\n" + "== Editing ==\n" + " C-d / Delete Delete character forward\n" + " Backspace Delete character backward\n" + " C-k Kill to end of line\n" + " C-w Kill region\n" + " M-w Copy region\n" + " C-y Yank (paste)\n" + " C-/ Undo\n" + " C-space Set mark\n\n" + "== Files and Buffers ==\n" + " C-x C-f Find (open) file\n" + " C-x C-s Save buffer\n" + " C-x b Switch buffer\n" + " C-x k Kill buffer\n\n" + "== Windows ==\n" + " C-x 2 Split window below\n" + " C-x 3 Split window right\n" + " C-x 0 Delete window\n" + " C-x 1 Delete other windows\n" + " C-x o Other window\n\n" + "== Commands ==\n" + " M-x Execute extended command\n" + " C-g Cancel/quit\n" + " C-x C-c Exit jemacs\n\n" + "Over 2400 commands available via M-x!\n")) + (echo-message! echo "Tutorial loaded")))) + +;; --- Feature 7: Version Info --- + +(def (cmd-version-info app) + "Show detailed jemacs version information." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*version*"))) + (switch-to-buffer frame new-buf) + (let ((ed (edit-window-editor (current-window frame)))) + (editor-set-text ed + (str "=== jemacs Version Info ===\n\n" + "jemacs - Chez Scheme Emacs-like Editor\n\n" + "Built on:\n" + " Chez Scheme " (scheme-version-number) "\n" + " Jerboa Scheme dialect\n" + " Scintilla editor component\n\n" + "Features: 2400+ commands\n" + "Modes: TUI (terminal) and Qt (graphical)\n\n" + "Project: jerboa-emacs\n" + "License: Open Source\n")) + (echo-message! echo "Version info displayed")))) + +;; --- Feature 8: Changelog View --- + +(def (cmd-changelog-view app) + "View the project changelog via git log." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*changelog*"))) + (switch-to-buffer frame new-buf) + (with-catch + (lambda (e) (echo-message! echo (str "Error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports "git log --oneline -50 2>/dev/null" + 'block (native-transcoder)))) + (close-port si) + (let loop ((lines '())) + (let ((line (get-line so))) + (if (eof-object? line) + (begin + (close-port so) (close-port se) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed (str "=== Changelog ===\n\n" + (string-join (reverse lines) "\n") "\n"))) + (echo-message! echo "Changelog loaded")) (loop (cons line lines)))))))))) + +;; --- Feature 9: Bug Report Mode --- + +(def (cmd-bug-report-mode app) + "Create a bug report template." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*bug-report*"))) + (switch-to-buffer frame new-buf) + (let ((ed (edit-window-editor (current-window frame)))) + (editor-set-text ed + (str "=== Bug Report ===\n\n" + "Summary: \n\n" + "Steps to Reproduce:\n" + "1. \n" + "2. \n" + "3. \n\n" + "Expected Behavior:\n\n\n" + "Actual Behavior:\n\n\n" + "System Info:\n" + " OS: " (with-output-to-string (lambda () + (with-catch (lambda (e) (display "unknown")) + (lambda () + (let-values (((si so se pid) (open-process-ports "uname -sr" 'block (native-transcoder)))) + (close-port si) + (let ((info (get-line so))) + (close-port so) (close-port se) + (when (not (eof-object? info)) (display (string-trim info))))))))) + "\n Chez: " (scheme-version-number) + "\n\nAdditional Notes:\n\n")) + (echo-message! echo "Bug report template ready")))) + +;; --- Feature 10: Color Theme Select --- + +(def (cmd-color-theme-select app) + "Select a color theme for the editor." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (row (tui-rows)) (width (tui-cols)) + (themes '("dark" "light" "solarized" "monokai" "dracula" "gruvbox" "nord")) + (choice (echo-read-string echo (str "Theme [" (string-join themes "/") "]: ") row width))) + (when (and choice (not (string-empty? choice))) + (let ((theme (string-downcase (string-trim choice)))) + (cond + ((string=? theme "dark") + (send-message ed SCI_STYLESETBACK 32 #x1E1E1E) + (send-message ed SCI_STYLESETFORE 32 #xD4D4D4)) + ((string=? theme "light") + (send-message ed SCI_STYLESETBACK 32 #xFFFFFF) + (send-message ed SCI_STYLESETFORE 32 #x000000)) + ((string=? theme "solarized") + (send-message ed SCI_STYLESETBACK 32 #x002B36) + (send-message ed SCI_STYLESETFORE 32 #x839496)) + ((string=? theme "monokai") + (send-message ed SCI_STYLESETBACK 32 #x272822) + (send-message ed SCI_STYLESETFORE 32 #xF8F8F2)) + ((string=? theme "dracula") + (send-message ed SCI_STYLESETBACK 32 #x282A36) + (send-message ed SCI_STYLESETFORE 32 #xF8F8F2)) + ((string=? theme "gruvbox") + (send-message ed SCI_STYLESETBACK 32 #x282828) + (send-message ed SCI_STYLESETFORE 32 #xEBDBB2)) + ((string=? theme "nord") + (send-message ed SCI_STYLESETBACK 32 #x2E3440) + (send-message ed SCI_STYLESETFORE 32 #xD8DEE9)) + (else (echo-message! echo (str "Unknown theme: " theme)))) + (send-message ed SCI_STYLECLEARALL 0 0) + (echo-message! echo (str "Theme: " theme)))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1857,4 +1857,26 @@ (register-command! 'apt-search cmd-apt-search) (register-command! 'connect-four cmd-connect-four) (register-command! 'fifteen-puzzle cmd-fifteen-puzzle) + ;; Round 20 batch 1: currency-convert, wikipedia-summary, man-page, info-page, tldr-page, tutorial-mode, version-info, changelog-view, bug-report-mode, color-theme-select + (register-command! 'currency-convert cmd-currency-convert) + (register-command! 'wikipedia-summary cmd-wikipedia-summary) + (register-command! 'man-page cmd-man-page) + (register-command! 'info-page cmd-info-page) + (register-command! 'tldr-page cmd-tldr-page) + (register-command! 'tutorial-mode cmd-tutorial-mode) + (register-command! 'version-info cmd-version-info) + (register-command! 'changelog-view cmd-changelog-view) + (register-command! 'bug-report-mode cmd-bug-report-mode) + (register-command! 'color-theme-select cmd-color-theme-select) + ;; Round 20 batch 2: paredit-mode, hi-lock-mode, syntax-highlight-region, stack-overflow-search, cheat-sheet, apropos-documentation, scratch-message, geiser-mode, sly-mode, slime-mode + (register-command! 'paredit-mode cmd-paredit-mode) + (register-command! 'hi-lock-mode cmd-hi-lock-mode) + (register-command! 'syntax-highlight-region cmd-syntax-highlight-region) + (register-command! 'stack-overflow-search cmd-stack-overflow-search) + (register-command! 'cheat-sheet cmd-cheat-sheet) + (register-command! 'apropos-documentation cmd-apropos-documentation) + (register-command! 'scratch-message cmd-scratch-message) + (register-command! 'geiser-mode cmd-geiser-mode) + (register-command! 'sly-mode cmd-sly-mode) + (register-command! 'slime-mode cmd-slime-mode) )