Round 17: Add 20 new features (emoji, formatters, symbol inspection)
ober
b129e54c0e535f0834b0c588504d3b23f4e03883
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1446,6 +1446,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | Text scale adjust | :orange_circle: | Interactive text zoom +/-/0 | | Memory use counts | :orange_circle: | Display Chez Scheme memory statistics | | Execute named kbd macro | :orange_circle: | Execute/list named keyboard macros | +| Emoji search | :orange_circle: | Search and insert emoji by name | +| Emoji list | :orange_circle: | Display emoji in a buffer | +| UCS insert | :orange_circle: | Insert Unicode character by codepoint or name | +| Char info | :orange_circle: | Show character details (decimal, hex, octal) | +| List colors display | :orange_circle: | Display named color palette | +| List faces display | :orange_circle: | Display Scintilla style information | +| Display battery mode | :orange_circle: | Show battery status from sysfs | +| View hello file | :orange_circle: | Multilingual HELLO greetings | +| Auto highlight symbol | :orange_circle: | Highlight all instances of symbol at point | +| Pulse momentary highlight | :orange_circle: | Flash/pulse current line (indicator overlay) | +| Prettier mode | :orange_circle: | Format code via prettier | +| Clang format | :orange_circle: | Format C/C++ via clang-format | +| Eglot format | :orange_circle: | Format buffer via detected formatter | +| Reformatter | :orange_circle: | Format with custom formatter command | +| Nav flash show | :orange_circle: | Flash line after navigation jump | +| Describe symbol | :orange_circle: | Look up Scheme symbol documentation | +| Apropos variable | :orange_circle: | Search variables by name pattern | +| Locate library | :orange_circle: | Find library file path | +| Load library | :orange_circle: | Load a Scheme library file | +| Finder by keyword | :orange_circle: | Find commands by keyword search | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -6472,3 +6472,333 @@ " M-x name-last-kbd-macro Name the last macro\n\n" "Recorded macros will appear here.\n")) (echo-message! echo "Kbd macro list")))) + +;; ===== Round 17 Batch 2 ===== + +;; --- Feature 11: Prettier Mode --- + +(def (cmd-prettier-mode app) + "Format the current buffer using prettier." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (buf (edit-window-buffer win)) + (file (buffer-file buf)) + (text (editor-get-text ed))) + (if (not file) + (echo-message! echo "No file — prettier needs a filename for language detection") + (with-catch + (lambda (e) (echo-message! echo (str "Prettier error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "prettier --stdin-filepath " (shell-quote file) " 2>/dev/null") + 'block (native-transcoder)))) + (put-string si text) + (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 "Prettier produced no output — is it installed?") + (begin + (editor-set-text ed result) + (editor-goto-pos ed 0) + (echo-message! echo "Formatted with prettier"))))) + (loop (cons line lines))))))))))) + +;; --- Feature 12: Clang Format --- + +(def (cmd-clang-format app) + "Format C/C++ code using clang-format." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (text (editor-get-text ed))) + (with-catch + (lambda (e) (echo-message! echo (str "clang-format error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports "clang-format 2>/dev/null" + 'block (native-transcoder)))) + (put-string si text) + (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 "clang-format produced no output — is it installed?") + (begin + (editor-set-text ed result) + (editor-goto-pos ed 0) + (echo-message! echo "Formatted with clang-format"))))) + (loop (cons line lines)))))))))) + +;; --- Feature 13: Eglot Format --- + +(def (cmd-eglot-format app) + "Format the buffer via LSP textDocument/formatting." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + ;; Use formatter based on file extension + (let* ((ext (path-extension file)) + (cmd (cond + ((member ext '("js" "ts" "jsx" "tsx" "json" "css" "html" "md" "yaml" "yml")) + (str "prettier --stdin-filepath " (shell-quote file))) + ((member ext '("c" "cpp" "h" "hpp" "cc")) + "clang-format") + ((member ext '("py")) + "black -q -") + ((member ext '("go")) + "gofmt") + ((member ext '("rs")) + "rustfmt") + ((member ext '("rb")) + "rubocop -A --stdin dummy.rb 2>/dev/null") + (else #f)))) + (if (not cmd) + (echo-message! echo (str "No formatter configured for ." ext)) + (with-catch + (lambda (e) (echo-message! echo (str "Format error: " e))) + (lambda () + (let ((text (editor-get-text ed))) + (let-values (((si so se pid) + (open-process-ports (str cmd " 2>/dev/null") + 'block (native-transcoder)))) + (put-string si text) + (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"))) + (when (> (string-length result) 0) + (editor-set-text ed result) + (editor-goto-pos ed 0) + (echo-message! echo (str "Formatted with " cmd))))) + (loop (cons line lines)))))))))))))) + +;; --- Feature 14: Reformatter --- + +(def (cmd-reformatter app) + "Format buffer with a custom formatter command." + (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)) + (cmd (echo-read-string echo "Formatter command (reads stdin, writes stdout): " row width))) + (when (and cmd (not (string-empty? cmd))) + (let ((text (editor-get-text ed))) + (with-catch + (lambda (e) (echo-message! echo (str "Format error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports (str (string-trim cmd) " 2>/dev/null") + 'block (native-transcoder)))) + (put-string si text) + (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 "Formatter produced no output") + (begin + (editor-set-text ed result) + (editor-goto-pos ed 0) + (echo-message! echo "Formatted"))))) + (loop (cons line lines)))))))))))) + +;; --- Feature 15: Nav Flash Show --- + +(def (cmd-nav-flash-show app) + "Flash the current line after a navigation jump (visual feedback)." + (let* ((frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (line (send-message ed SCI_LINEFROMPOSITION pos 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (line-end (send-message ed SCI_GETLINEENDPOSITION line 0)) + (line-len (- line-end line-start))) + (when (> line-len 0) + ;; Use indicator 20 for nav flash + (send-message ed SCI_SETINDICATORCURRENT 20 0) + (send-message ed SCI_INDICSETSTYLE 20 7) ;; INDIC_ROUNDBOX + (send-message ed SCI_INDICSETFORE 20 #x00FF00) ;; Green + (send-message ed SCI_INDICSETALPHA 20 80) + (send-message ed SCI_INDICATORFILLRANGE line-start line-len) + (echo-message! (app-state-echo app) "Nav flash")))) + +;; --- Feature 16: Describe Symbol --- + +(def (cmd-describe-symbol app) + "Look up documentation for a Scheme symbol." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (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)) + (symbol (editor-get-text-range ed word-start word-end)) + (row (tui-rows)) (width (tui-cols))) + (let ((sym (if (or (not symbol) (string-empty? symbol)) + (echo-read-string echo "Describe symbol: " row width) + symbol))) + (when (and sym (not (string-empty? sym))) + (with-catch + (lambda (e) (echo-message! echo (str "Not found: " sym))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "echo '(import (chezscheme)) (inspect (eval (string->symbol \"" + (string-trim sym) "\")))' | scheme -q 2>&1 | head -20") + '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 info for: " sym)) + (let* ((new-buf (create-buffer (str "*describe: " sym "*")))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed (str "=== " sym " ===\n\n" result "\n"))) + (echo-message! echo (str "Described: " sym)))))) + (loop (cons line lines)))))))))))) + +;; --- Feature 17: Apropos Variable --- + +(def (cmd-apropos-variable app) + "Search for variables matching a pattern." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (row (tui-rows)) (width (tui-cols)) + (pattern (echo-read-string echo "Apropos variable pattern: " row width))) + (when (and pattern (not (string-empty? pattern))) + (with-catch + (lambda (e) (echo-message! echo (str "Apropos error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "echo '(import (chezscheme)) (for-each (lambda (s) (when (string-contains (symbol->string s) \"" + (string-trim pattern) + "\") (printf \"~a~n\" s))) (environment-symbols (interaction-environment)))' | scheme -q 2>/dev/null | sort | head -50") + '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 "No variables found") + (let* ((new-buf (create-buffer "*apropos-variable*"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed (str "=== Apropos: " pattern " ===\n\n" result "\n"))) + (echo-message! echo (str (length (reverse lines)) " variables found")))))) + (loop (cons line lines))))))))))) + +;; --- Feature 18: Locate Library --- + +(def (cmd-locate-library app) + "Find the file path of a Scheme library." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (lib-name (echo-read-string echo "Library name: " row width))) + (when (and lib-name (not (string-empty? lib-name))) + (with-catch + (lambda (e) (echo-message! echo (str "Error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "find lib/ src/ -name '" + (string-trim lib-name) ".ss' -o -name '" + (string-trim lib-name) ".sls' 2>/dev/null | head -10") + '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) + (if (null? (reverse lines)) + (echo-message! echo (str "Library not found: " lib-name)) + (echo-message! echo (str "Found: " (string-join (reverse lines) ", "))))) + (loop (cons (string-trim line) lines))))))))))) + +;; --- Feature 19: Load Library --- + +(def (cmd-load-library app) + "Load a Scheme library file into the editor environment." + (let* ((echo (app-state-echo app)) + (row (tui-rows)) (width (tui-cols)) + (file (echo-read-string echo "Library file to load: " row width))) + (when (and file (not (string-empty? file))) + (let ((path (string-trim file))) + (if (not (file-exists? path)) + (echo-message! echo (str "File not found: " path)) + (with-catch + (lambda (e) (echo-message! echo (str "Load error: " e))) + (lambda () + (load path) + (echo-message! echo (str "Loaded: " path))))))))) + +;; --- Feature 20: Finder by Keyword --- + +(def (cmd-finder-by-keyword app) + "Find available commands by keyword search." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (row (tui-rows)) (width (tui-cols)) + (keyword (echo-read-string echo "Find commands by keyword: " row width))) + (when (and keyword (not (string-empty? keyword))) + (with-catch + (lambda (e) (echo-message! echo (str "Search error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "grep -rh 'register-command!' src/jerboa-emacs/*.ss 2>/dev/null" + " | grep -i " (shell-quote (string-trim keyword)) + " | sed \"s/.*'\\([^ ]*\\).*/\\1/\" | sort -u | head -30") + '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 ((results (reverse lines))) + (if (null? results) + (echo-message! echo (str "No commands matching: " keyword)) + (let* ((new-buf (create-buffer "*finder*")) + (result (string-join results "\n"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed (str "=== Commands matching '" keyword "' ===\n\n" result "\n"))) + (echo-message! echo (str (length results) " commands found")))))) + (loop (cons (string-trim line) lines))))))))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -6881,3 +6881,287 @@ (editor-set-text new-ed (str "=== Hacker News Top Stories ===\n\n" result "\n"))) (echo-message! echo "News headlines loaded"))))) (loop (cons (str (number->string n) ". " line) lines) (+ n 1)))))))))) + +;; ===== Round 17 Batch 1 ===== + +;; --- Feature 1: Emoji Search --- + +(def (cmd-emoji-search app) + "Search for and insert an emoji by name." + (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)) + (query (echo-read-string echo "Emoji search: " row width))) + (when (and query (not (string-empty? query))) + (with-catch + (lambda (e) (echo-message! echo (str "Emoji error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "python3 -c '" + "import unicodedata,sys;" + "q=sys.argv[1].lower();" + "[print(chr(i),unicodedata.name(chr(i),\"\")) for i in range(0x1F300,0x1FAF9) if q in unicodedata.name(chr(i),\"\").lower()]" + "' " (shell-quote (string-trim query)) " 2>/dev/null | head -20") + '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 ((results (reverse lines))) + (if (null? results) + (echo-message! echo "No emoji found") + ;; Insert the first result's emoji character + (let* ((first-line (car results)) + (emoji (if (> (string-length first-line) 0) + (string (string-ref first-line 0)) + ""))) + (when (> (string-length emoji) 0) + (send-message ed SCI_INSERTTEXT -1 emoji) + (echo-message! echo (str "Inserted: " first-line))))))) + (loop (cons line lines))))))))))) + +;; --- Feature 2: Emoji List --- + +(def (cmd-emoji-list app) + "Display a list of common emoji in a buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*emoji-list*"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (with-catch + (lambda (e) + (editor-set-text new-ed "Error loading emoji list") + (echo-message! echo (str "Error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + "python3 -c 'import unicodedata;[print(chr(i),unicodedata.name(chr(i),\"?\")) for i in range(0x1F600,0x1F650)]' 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"))) + (editor-set-text new-ed (str "=== Emoji List ===\n\n" result "\n")) + (echo-message! echo "Emoji list loaded"))) + (loop (cons line lines))))))))))) + +;; --- Feature 3: UCS Insert --- + +(def (cmd-ucs-insert app) + "Insert a Unicode character by codepoint or name." + (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)) + (input (echo-read-string echo "Unicode codepoint (hex) or name: " row width))) + (when (and input (not (string-empty? input))) + (let ((trimmed (string-trim input))) + (with-catch + (lambda (e) (echo-message! echo (str "UCS error: " e))) + (lambda () + ;; Try as hex codepoint first + (let ((num (string->number trimmed 16))) + (if num + (let ((ch (string (integer->char num)))) + (send-message ed SCI_INSERTTEXT -1 ch) + (echo-message! echo (str "Inserted U+" trimmed " = " ch))) + ;; Try as name via Python + (let-values (((si so se pid) + (open-process-ports + (str "python3 -c 'import unicodedata;print(unicodedata.lookup(\"" + trimmed "\"))' 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 "Character not found") + (let ((ch (string-trim result))) + (send-message ed SCI_INSERTTEXT -1 ch) + (echo-message! echo (str "Inserted: " ch)))))))))))))) + +;; --- Feature 4: Char Info --- + +(def (cmd-char-info app) + "Show detailed information about the character at point." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (ch (send-message ed SCI_GETCHARAT pos 0))) + (if (= ch 0) + (echo-message! echo "No character at point") + (let* ((char-val (integer->char ch)) + (info (str "Char: " (string char-val) + " | Decimal: " ch + " | Hex: 0x" (number->string ch 16) + " | Octal: 0" (number->string ch 8)))) + (echo-message! echo info))))) + +;; --- Feature 5: List Colors Display --- + +(def (cmd-list-colors-display app) + "Display a color palette in a buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*colors*")) + (colors '(("Black" "#000000") ("White" "#FFFFFF") ("Red" "#FF0000") + ("Green" "#00FF00") ("Blue" "#0000FF") ("Yellow" "#FFFF00") + ("Cyan" "#00FFFF") ("Magenta" "#FF00FF") ("Orange" "#FFA500") + ("Purple" "#800080") ("Pink" "#FFC0CB") ("Brown" "#A52A2A") + ("Gray" "#808080") ("Silver" "#C0C0C0") ("Gold" "#FFD700") + ("Navy" "#000080") ("Teal" "#008080") ("Maroon" "#800000") + ("Olive" "#808000") ("Coral" "#FF7F50") ("Salmon" "#FA8072") + ("Turquoise" "#40E0D0") ("Violet" "#EE82EE") ("Indigo" "#4B0082") + ("Crimson" "#DC143C") ("Lime" "#00FF00") ("Ivory" "#FFFFF0") + ("Azure" "#F0FFFF") ("Lavender" "#E6E6FA") ("Wheat" "#F5DEB3") + ("Khaki" "#F0E68C") ("Orchid" "#DA70D6") ("Plum" "#DDA0DD"))) + (lines (map (lambda (c) + (str " " (car c) (make-string (max 1 (- 15 (string-length (car c)))) #\space) (cadr c))) + colors)) + (text (str "=== Color Palette ===\n\n" (string-join lines "\n") "\n"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed text)) + (echo-message! echo "Color palette displayed"))) + +;; --- Feature 6: List Faces Display --- + +(def (cmd-list-faces-display app) + "Display available Scintilla style information." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (new-buf (create-buffer "*faces*")) + (styles (let collect ((i 0) (acc '())) + (if (>= i 32) (reverse acc) + (let ((fg (send-message ed SCI_STYLEGETFORE i 0)) + (bg (send-message ed SCI_STYLEGETBACK i 0)) + (bold (send-message ed SCI_STYLEGETBOLD i 0)) + (italic (send-message ed SCI_STYLEGETITALIC i 0))) + (collect (+ i 1) + (cons (str " Style " i + ": fg=#" (number->string fg 16) + " bg=#" (number->string bg 16) + (if (> bold 0) " BOLD" "") + (if (> italic 0) " ITALIC" "")) + acc)))))) + (text (str "=== Scintilla Styles ===\n\n" (string-join styles "\n") "\n"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed text)) + (echo-message! echo "Faces/styles displayed"))) + +;; --- Feature 7: Display Battery Mode --- + +(def (cmd-display-battery-mode app) + "Show battery status in the echo area." + (let* ((echo (app-state-echo app))) + (with-catch + (lambda (e) (echo-message! echo "Battery info not available")) + (lambda () + (let-values (((si so se pid) + (open-process-ports + "cat /sys/class/power_supply/BAT0/capacity 2>/dev/null && cat /sys/class/power_supply/BAT0/status 2>/dev/null || echo 'N/A'" + 'block (native-transcoder)))) + (close-port si) + (let* ((cap (get-line so)) + (status (get-line so))) + (close-port so) (close-port se) + (if (or (eof-object? cap) (string=? (string-trim cap) "N/A")) + (echo-message! echo "Battery: not available (desktop or no BAT0)") + (echo-message! echo (str "Battery: " (string-trim cap) "% (" + (if (eof-object? status) "unknown" (string-trim status)) ")"))))))))) + +;; --- Feature 8: View Hello File --- + +(def (cmd-view-hello-file app) + "Display a multilingual HELLO greeting in various scripts." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*hello*")) + (greetings '("Hello!" "Bonjour!" "Hallo!" "Ciao!" "Hola!" + "Ola!" "Ahoj!" "Hej!" "Merhaba!" "Szia!" + "Saluton!" "Salut!" "Hei!" "Witaj!" + "Ahoj!" "Sveiki!" "Tere!" "Labas!" + "Czesc!" "Zdravo!" "Privet!" + "Konnichiwa!" "Nihao!" "Annyeong!" + "Namaste!" "Sawadee!" "Xin chao!" + "Shalom!" "Marhaba!" "Salaam!")) + (text (str "=== HELLO ===\n\n" + "This file demonstrates greetings from around the world.\n\n" + (string-join greetings "\n") "\n\n" + "Emacs displays this in native scripts with proper Unicode rendering.\n" + "jemacs shows the transliterated forms.\n"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed text)) + (echo-message! echo "Hello world!"))) + +;; --- Feature 9: Auto Highlight Symbol --- + +(def (cmd-auto-highlight-symbol app) + "Highlight all instances of the symbol at point using indicator 18." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (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 (editor-get-text-range ed word-start word-end))) + (if (or (not word) (string-empty? word)) + (echo-message! echo "No symbol at point") + (begin + ;; Clear previous highlights + (send-message ed SCI_SETINDICATORCURRENT 18 0) + (send-message ed SCI_INDICATORCLEARRANGE 0 (send-message ed SCI_GETLENGTH 0 0)) + ;; Setup indicator 18 for symbol highlight + (send-message ed SCI_INDICSETSTYLE 18 7) ;; INDIC_ROUNDBOX + (send-message ed SCI_INDICSETFORE 18 #x00FFFF) ;; Cyan + (send-message ed SCI_INDICSETALPHA 18 60) + ;; Find and highlight all occurrences + (let ((len (send-message ed SCI_GETLENGTH 0 0)) + (word-len (string-length word))) + (send-message ed SCI_SETSEARCHFLAGS 4 0) ;; SCFIND_WHOLEWORD + (let highlight-loop ((search-start 0) (count 0)) + (send-message ed SCI_SETTARGETSTART search-start 0) + (send-message ed SCI_SETTARGETEND len 0) + (let ((found (send-message ed SCI_SEARCHINTARGET word-len word))) + (if (>= found 0) + (begin + (send-message ed SCI_INDICATORFILLRANGE found word-len) + (highlight-loop (+ found word-len) (+ count 1))) + (echo-message! echo (str "Highlighted " count " occurrences of '" word "'")))))))))) + +;; --- Feature 10: Pulse Momentary Highlight --- + +(def (cmd-pulse-momentary-highlight-one-line app) + "Flash/pulse the current line briefly using indicator 19." + (let* ((frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (pos (send-message ed SCI_GETCURRENTPOS 0 0)) + (line (send-message ed SCI_LINEFROMPOSITION pos 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (line-end (send-message ed SCI_GETLINEENDPOSITION line 0))) + ;; Setup indicator 19 for pulse + (send-message ed SCI_SETINDICATORCURRENT 19 0) + (send-message ed SCI_INDICSETSTYLE 19 6) ;; INDIC_BOX + (send-message ed SCI_INDICSETFORE 19 #xFFFF00) ;; Yellow + (send-message ed SCI_INDICSETALPHA 19 100) + ;; Highlight the line + (send-message ed SCI_INDICATORFILLRANGE line-start (- line-end line-start)) + (echo-message! (app-state-echo app) "Line pulsed"))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1791,4 +1791,26 @@ (register-command! 'text-scale-adjust cmd-text-scale-adjust) (register-command! 'memory-use-counts cmd-memory-use-counts) (register-command! 'execute-named-kbd-macro cmd-execute-named-kbd-macro) + ;; Round 17 batch 1: emoji-search, emoji-list, ucs-insert, char-info, list-colors-display, list-faces-display, display-battery-mode, view-hello-file, auto-highlight-symbol, pulse-momentary-highlight-one-line + (register-command! 'emoji-search cmd-emoji-search) + (register-command! 'emoji-list cmd-emoji-list) + (register-command! 'ucs-insert cmd-ucs-insert) + (register-command! 'char-info cmd-char-info) + (register-command! 'list-colors-display cmd-list-colors-display) + (register-command! 'list-faces-display cmd-list-faces-display) + (register-command! 'display-battery-mode cmd-display-battery-mode) + (register-command! 'view-hello-file cmd-view-hello-file) + (register-command! 'auto-highlight-symbol cmd-auto-highlight-symbol) + (register-command! 'pulse-momentary-highlight-one-line cmd-pulse-momentary-highlight-one-line) + ;; Round 17 batch 2: prettier-mode, clang-format, eglot-format, reformatter, nav-flash-show, describe-symbol, apropos-variable, locate-library, load-library, finder-by-keyword + (register-command! 'prettier-mode cmd-prettier-mode) + (register-command! 'clang-format cmd-clang-format) + (register-command! 'eglot-format cmd-eglot-format) + (register-command! 'reformatter cmd-reformatter) + (register-command! 'nav-flash-show cmd-nav-flash-show) + (register-command! 'describe-symbol cmd-describe-symbol) + (register-command! 'apropos-variable cmd-apropos-variable) + (register-command! 'locate-library cmd-locate-library) + (register-command! 'load-library cmd-load-library) + (register-command! 'finder-by-keyword cmd-finder-by-keyword) )