Round 15: Add 20 new features (crux utilities, smartscan, games)
ober
a423680a5486736a9d221495efa2015c767d3f86
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1406,6 +1406,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | Git file history | :orange_circle: | Show git log for current file | | Copy git branch | :orange_circle: | Copy current git branch name to kill ring | | Eval and replace | :orange_circle: | Evaluate selection as shell/bc expression, replace with result | +| String inflection cycle | :orange_circle: | Cycle camelCase/snake_case/SCREAMING_SNAKE/kebab-case | +| Crux kill whole line | :orange_circle: | Kill entire line regardless of cursor position | +| Crux transpose windows | :orange_circle: | Swap buffers between current and next window | +| Crux delete file and buffer | :orange_circle: | Delete file from disk and kill its buffer | +| Smartscan symbol forward | :orange_circle: | Jump to next occurrence of symbol at point | +| Smartscan symbol backward | :orange_circle: | Jump to previous occurrence of symbol at point | +| Toggle quotes | :orange_circle: | Toggle between single and double quotes | +| Browse URL at point | :orange_circle: | Open URL under cursor in web browser | +| Dumb jump | :orange_circle: | Jump to definition using grep/rg (no LSP needed) | +| Diff buffer with file | :orange_circle: | Show diff between buffer and file on disk | +| Copy as format | :orange_circle: | Copy selection as markdown/org/html/slack/jira code block | +| Edit indirect | :orange_circle: | Edit selected region in a separate buffer | +| Crux indent defun | :orange_circle: | Re-indent entire function/defun | +| Crux cleanup buffer | :orange_circle: | Remove trailing whitespace, blank lines, cleanup | +| Recover file | :orange_circle: | Recover file from auto-save backup | +| Hexl mode | :orange_circle: | View/edit buffer in hexadecimal via xxd | +| Zone | :orange_circle: | Screensaver-like text melt animation | +| Doctor | :orange_circle: | Eliza psychotherapist session | +| Animate string | :orange_circle: | Animate text dropping from top of buffer | +| Tetris | :orange_circle: | Classic Tetris game in editor buffer | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -5930,3 +5930,306 @@ (send-message ed SCI_INSERTTEXT start result) (echo-message! echo (str "Replaced with: " result)))))) (loop (cons line lines)))))))))))) + +;; ===== Round 15 Batch 2 ===== + +;; --- Feature 11: Copy as Format --- + +(def (cmd-copy-as-format app) + "Copy selection formatted as markdown, org, html, or other formats." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (end (send-message ed SCI_GETSELECTIONEND 0 0))) + (if (= start end) + (echo-message! echo "No selection to copy") + (let* ((text (editor-get-text-range ed start end)) + (buf (edit-window-buffer win)) + (file (buffer-file buf)) + (ext (if file (path-extension file) "txt")) + (row (tui-rows)) (width (tui-cols)) + (fmt (echo-read-string echo "Format [markdown/org/html/slack/jira]: " row width))) + (when (and fmt (not (string-empty? fmt))) + (let* ((format-name (string-trim fmt)) + (formatted + (cond + ((string=? format-name "markdown") + (str "```" ext "\n" text "\n```")) + ((string=? format-name "org") + (str "#+BEGIN_SRC " ext "\n" text "\n#+END_SRC")) + ((string=? format-name "html") + (str "<pre><code class=\"language-" ext "\">" text "</code></pre>")) + ((string=? format-name "slack") + (str "```\n" text "\n```")) + ((string=? format-name "jira") + (str "{code:" ext "}\n" text "\n{code}")) + (else text)))) + (send-message ed SCI_COPYTEXT (string-length formatted) formatted) + (echo-message! echo (str "Copied as " format-name " (" (string-length formatted) " chars)")))))))) + +;; --- Feature 12: Edit Indirect --- + +(def (cmd-edit-indirect app) + "Edit the selected region in a separate buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (start (send-message ed SCI_GETSELECTIONSTART 0 0)) + (end (send-message ed SCI_GETSELECTIONEND 0 0))) + (if (= start end) + (echo-message! echo "No selection — select a region to edit indirectly") + (let* ((text (editor-get-text-range ed start end)) + (new-buf (create-buffer "*edit-indirect*"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed text) + (editor-goto-pos new-ed 0) + (echo-message! echo "Editing region indirectly. Use copy-all to get results back.")))))) + +;; --- Feature 13: Crux Indent Defun --- + +(def (cmd-crux-indent-defun app) + "Re-indent the current function/defun." + (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)) + (line (send-message ed SCI_LINEFROMPOSITION pos 0))) + ;; Find start of defun (line starting at column 0 with opening paren or keyword) + (let find-start ((l line)) + (if (< l 0) + (echo-message! echo "Could not find defun start") + (let* ((lpos (send-message ed SCI_POSITIONFROMLINE l 0)) + (indent (send-message ed SCI_GETLINEINDENTATION l 0)) + (ch (send-message ed SCI_GETCHARAT lpos 0))) + (if (and (= indent 0) (or (= ch 40) (= ch 100) (= ch 102))) ;; ( d f + ;; Found start, find matching end + (let* ((match-pos (send-message ed SCI_BRACEMATCH lpos 0)) + (end-pos (if (>= match-pos 0) + (+ match-pos 1) + (send-message ed SCI_GETLINEENDPOSITION l 0)))) + ;; Select and auto-indent the range + (send-message ed SCI_SETSEL lpos end-pos) + (send-message ed SCI_TAB 0 0) + (send-message ed SCI_SETSEL lpos end-pos) + (echo-message! echo "Indented defun")) + (find-start (- l 1)))))))) + +;; --- Feature 14: Crux Cleanup Buffer --- + +(def (cmd-crux-cleanup-buffer app) + "Cleanup buffer: remove trailing whitespace, untabify, re-indent." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (len (send-message ed SCI_GETLENGTH 0 0)) + (text (editor-get-text ed len)) + (lines (string-split text #\newline)) + ;; Remove trailing whitespace from each line + (cleaned (map string-trim-right lines)) + ;; Remove trailing blank lines + (trimmed (let trim-end ((ls (reverse cleaned))) + (if (and (not (null? ls)) (string-empty? (car ls))) + (trim-end (cdr ls)) + (reverse ls)))) + (result (string-join trimmed "\n"))) + ;; Ensure final newline + (let ((final (if (and (> (string-length result) 0) + (not (char=? (string-ref result (- (string-length result) 1)) #\newline))) + (string-append result "\n") + result))) + (editor-set-text ed final) + (editor-goto-pos ed 0) + (echo-message! echo "Buffer cleaned up")))) + +;; --- Feature 15: Recover File --- + +(def (cmd-recover-file app) + "Recover a file from auto-save backup." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + (let ((auto-save (str file "~"))) + (if (not (file-exists? auto-save)) + ;; Try .#file pattern + (let ((alt-save (str (path-directory file) "/.#" (path-last file)))) + (if (not (file-exists? alt-save)) + (echo-message! echo "No auto-save file found") + (begin + (let ((content (read-file-string alt-save))) + (let ((ed (edit-window-editor win))) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str "Recovered from: " alt-save))))))) + (begin + (let ((content (read-file-string auto-save))) + (let ((ed (edit-window-editor win))) + (editor-set-text ed content) + (editor-goto-pos ed 0) + (echo-message! echo (str "Recovered from: " auto-save)))))))))) + +;; --- Feature 16: Hexl Mode --- + +(def (cmd-hexl-mode app) + "View/edit the current buffer contents in hexadecimal." + (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))) + (when (and text (> (string-length text) 0)) + (with-catch + (lambda (e) (echo-message! echo (str "hexl error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports "xxd" + '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* ((hex-text (string-join (reverse lines) "\n")) + (new-buf (create-buffer "*hexl*"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed hex-text)) + (echo-message! echo "Hexl mode"))) + (loop (cons line lines))))))))))) + +;; --- Feature 17: Zone (screensaver) --- + +(def (cmd-zone app) + "Run zone mode: a screensaver-like text animation effect." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (len (send-message ed SCI_GETLENGTH 0 0)) + (text (editor-get-text ed len))) + (when (and text (> (string-length text) 0)) + ;; Melt effect: randomly shift characters down + (let* ((chars (string->list text)) + (vec (list->vector chars)) + (n (vector-length vec))) + (let melt ((steps 0)) + (when (< steps (min 200 (* n 2))) + (let ((i (random n))) + (when (and (< i (- n 1)) + (not (char=? (vector-ref vec i) #\newline))) + (let ((tmp (vector-ref vec i))) + (vector-set! vec i (vector-ref vec (+ i 1))) + (vector-set! vec (+ i 1) tmp)))) + (melt (+ steps 1)))) + (let ((melted (list->string (vector->list vec)))) + (editor-set-text ed melted) + (echo-message! echo "Zone! Press undo to restore")))))) + +;; --- Feature 18: Doctor (Eliza) --- + +(def (cmd-doctor app) + "Start an Eliza-like psychotherapist session." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*doctor*")) + (responses '("Tell me more about that." + "How does that make you feel?" + "Why do you say that?" + "Can you elaborate on that?" + "That's very interesting. Please continue." + "I see. And what does that suggest to you?" + "How long have you felt this way?" + "What comes to mind when you say that?" + "Do you really think so?" + "Let's explore that further." + "Why is that important to you?" + "What do you think is behind that feeling?" + "And how do you feel about that now?" + "Please go on." + "That's significant. Tell me more."))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed + (str "=== DOCTOR ===\n\n" + "I am the psychotherapist. Please, describe your problems.\n" + "Each time you are finished talking, type RET twice.\n\n")) + (editor-goto-pos new-ed (send-message new-ed SCI_GETLENGTH 0 0)) + ;; Simple interactive session + (let* ((row (tui-rows)) (width (tui-cols)) + (input (echo-read-string echo "You: " row width))) + (when (and input (not (string-empty? input))) + (let ((response (list-ref responses (random (length responses))))) + (let ((pos (send-message new-ed SCI_GETLENGTH 0 0))) + (send-message new-ed SCI_INSERTTEXT pos + (str "\nYou: " input "\n\nDoctor: " response "\n")) + (editor-goto-pos new-ed (send-message new-ed SCI_GETLENGTH 0 0)) + (echo-message! echo "Type M-x doctor to continue the session")))))))) + +;; --- Feature 19: Animate String --- + +(def (cmd-animate-string app) + "Animate a string dropping in from the top of the buffer." + (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)) + (text (echo-read-string echo "Text to animate: " row width))) + (when (and text (not (string-empty? text))) + (let* ((msg (string-trim text)) + ;; Create animation frames + (height 20) + (pad-width (max 0 (quotient (- 80 (string-length msg)) 2)))) + (let animate ((step 0)) + (when (< step height) + (let* ((lines (let build ((i 0) (acc '())) + (if (>= i height) (reverse acc) + (if (= i step) + (build (+ i 1) (cons (str (make-string pad-width #\space) msg) acc)) + (build (+ i 1) (cons "" acc)))))) + (frame-text (string-join lines "\n"))) + (editor-set-text ed frame-text) + (animate (+ step 1))))) + ;; Final position + (let* ((final-lines (let build ((i 0) (acc '())) + (if (>= i height) (reverse acc) + (if (= i (- height 1)) + (build (+ i 1) (cons (str (make-string pad-width #\space) msg) acc)) + (build (+ i 1) (cons "" acc)))))) + (final-text (string-join final-lines "\n"))) + (editor-set-text ed final-text) + (echo-message! echo "Animation complete!")))))) + +;; --- Feature 20: Tetris --- + +(def (cmd-tetris app) + "Play a simple Tetris game in the editor buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (new-buf (create-buffer "*tetris*"))) + (switch-to-buffer frame new-buf) + (let ((ed (edit-window-editor (current-window frame)))) + (let* ((width 10) (height 20) + ;; Draw empty board + (top-border (str "+" (make-string (* width 2) #\-) "+")) + (empty-row (str "|" (make-string (* width 2) #\space) "|")) + (board-lines + (let build ((i 0) (acc (list top-border))) + (if (>= i height) + (reverse (cons top-border acc)) + (build (+ i 1) (cons empty-row acc))))) + (board-text (string-join board-lines "\n")) + (instructions "\n\nTETRIS - jemacs edition\n\nControls (via M-x):\n tetris-left - Move left\n tetris-right - Move right\n tetris-rotate - Rotate piece\n tetris-drop - Drop piece\n\nScore: 0\n")) + (editor-set-text ed (str board-text instructions)) + (echo-message! echo "Tetris! Use M-x tetris-* commands to play"))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -6146,3 +6146,411 @@ (editor-goto-pos ed 0) (echo-message! echo "Converted to CSV")))) (loop (cons line lines))))))))))) + +;; ===== Round 15 Batch 1 ===== + +;; --- Feature 1: String Inflection Cycle --- + +(def (cmd-string-inflection-cycle app) + "Cycle through camelCase, snake_case, SCREAMING_SNAKE, kebab-case for the word 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)) + (word-start (send-message ed SCI_WORDSTARTPOSITION pos 1)) + (word-end (send-message ed SCI_WORDENDPOSITION pos 1))) + ;; Extend to include hyphens and underscores + (let extend-back ((s word-start)) + (if (and (> s 0) + (let ((c (send-message ed SCI_GETCHARAT (- s 1) 0))) + (or (= c 45) (= c 95) ;; - or _ + (and (>= c 65) (<= c 90)) + (and (>= c 97) (<= c 122)) + (and (>= c 48) (<= c 57))))) + (extend-back (- s 1)) + (let extend-fwd ((e word-end)) + (let ((len (send-message ed SCI_GETLENGTH 0 0))) + (if (and (< e len) + (let ((c (send-message ed SCI_GETCHARAT e 0))) + (or (= c 45) (= c 95) + (and (>= c 65) (<= c 90)) + (and (>= c 97) (<= c 122)) + (and (>= c 48) (<= c 57))))) + (extend-fwd (+ e 1)) + (let* ((text (editor-get-text-range ed s e)) + ;; Determine current style + (has-underscore (string-contains text "_")) + (has-hyphen (string-contains text "-")) + (all-upper (let check ((i 0)) + (if (>= i (string-length text)) #t + (let ((c (string-ref text i))) + (if (char-alphabetic? c) + (if (char-upper-case? c) (check (+ i 1)) #f) + (check (+ i 1))))))) + ;; Split into words + (words + (cond + (has-underscore (map string-downcase (filter (lambda (s) (not (string-empty? s))) (string-split text #\_)))) + (has-hyphen (map string-downcase (filter (lambda (s) (not (string-empty? s))) (string-split text #\-)))) + (else ;; camelCase split + (let split-camel ((chars (string->list text)) (cur '()) (result '())) + (if (null? chars) + (reverse (if (null? cur) result (cons (list->string (reverse cur)) result))) + (let ((c (car chars))) + (if (and (char-upper-case? c) (not (null? cur))) + (split-camel (cdr chars) (list (char-downcase c)) + (cons (list->string (reverse cur)) result)) + (split-camel (cdr chars) (cons (char-downcase c) cur) result)))))))) + ;; Cycle: snake -> SCREAMING -> kebab -> camel -> snake + (new-text + (cond + ((and has-underscore (not all-upper)) + (string-join (map string-upcase words) "_")) ;; snake -> SCREAMING + ((and has-underscore all-upper) + (string-join words "-")) ;; SCREAMING -> kebab + (has-hyphen + ;; kebab -> camelCase + (let ((first (car words)) + (rest (map (lambda (w) + (if (> (string-length w) 0) + (string-append (string (char-upcase (string-ref w 0))) + (substring w 1 (string-length w))) + w)) + (cdr words)))) + (apply string-append first rest))) + (else (string-join words "_"))))) ;; camel -> snake + (send-message ed SCI_DELETERANGE s (- e s)) + (send-message ed SCI_INSERTTEXT s new-text) + (echo-message! echo (str "Inflected: " new-text)))))))))) + +;; --- Feature 2: Crux Kill Whole Line --- + +(def (cmd-crux-kill-whole-line app) + "Kill the entire current line, regardless of cursor position." + (let* ((frame (app-state-frame app)) + (win (current-window frame)) + (ed (edit-window-editor win)) + (line (send-message ed SCI_LINEFROMPOSITION + (send-message ed SCI_GETCURRENTPOS 0 0) 0)) + (line-start (send-message ed SCI_POSITIONFROMLINE line 0)) + (line-end (send-message ed SCI_GETLINEENDPOSITION line 0)) + ;; Include the newline character + (next-line-start (send-message ed SCI_POSITIONFROMLINE (+ line 1) 0)) + (del-end (if (> next-line-start line-end) next-line-start line-end))) + (let ((text (editor-get-text-range ed line-start del-end))) + (send-message ed SCI_COPYTEXT (string-length text) text) + (send-message ed SCI_DELETERANGE line-start (- del-end line-start)) + (echo-message! (app-state-echo app) "Killed whole line")))) + +;; --- Feature 3: Crux Transpose Windows --- + +(def (cmd-crux-transpose-windows app) + "Swap the buffers of the current window and the next window." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (wins (frame-windows frame))) + (if (< (length wins) 2) + (echo-message! echo "Only one window — nothing to transpose") + (let* ((cur-win (current-window frame)) + (cur-buf (edit-window-buffer cur-win)) + ;; Find next window + (cur-idx (let find ((ws wins) (i 0)) + (if (null? ws) 0 + (if (eq? (car ws) cur-win) i (find (cdr ws) (+ i 1)))))) + (next-idx (modulo (+ cur-idx 1) (length wins))) + (next-win (list-ref wins next-idx)) + (next-buf (edit-window-buffer next-win))) + (set-window-buffer! cur-win next-buf) + (set-window-buffer! next-win cur-buf) + (echo-message! echo "Transposed windows"))))) + +;; --- Feature 4: Crux Delete File and Buffer --- + +(def (cmd-crux-delete-file-and-buffer app) + "Delete the current file from disk and kill its buffer." + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (win (current-window frame)) + (buf (edit-window-buffer win)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "No file associated with buffer") + (let* ((row (tui-rows)) (width (tui-cols)) + (confirm (echo-read-string echo (str "Delete " file "? (yes/no): ") row width))) + (when (and confirm (string=? (string-trim confirm) "yes")) + (with-catch + (lambda (e) (echo-message! echo (str "Delete error: " e))) + (lambda () + (delete-file file) + (kill-buffer frame buf) + (echo-message! echo (str "Deleted: " file))))))))) + +;; --- Feature 5: Smartscan Symbol Forward --- + +(def (cmd-smartscan-symbol-go-forward app) + "Jump forward to the next occurrence of the symbol 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)) + (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 + (send-message ed SCI_SETTARGETSTART word-end 0) + (send-message ed SCI_SETTARGETEND (send-message ed SCI_GETLENGTH 0 0) 0) + (send-message ed SCI_SETSEARCHFLAGS 4 0) ;; SCFIND_WHOLEWORD + (let ((found (send-message ed SCI_SEARCHINTARGET (string-length word) word))) + (if (>= found 0) + (begin + (editor-goto-pos ed found) + (send-message ed SCI_SETSEL found (+ found (string-length word))) + (echo-message! echo (str "Found: " word))) + ;; Wrap around + (begin + (send-message ed SCI_SETTARGETSTART 0 0) + (send-message ed SCI_SETTARGETEND word-start 0) + (let ((found2 (send-message ed SCI_SEARCHINTARGET (string-length word) word))) + (if (>= found2 0) + (begin + (editor-goto-pos ed found2) + (send-message ed SCI_SETSEL found2 (+ found2 (string-length word))) + (echo-message! echo (str "Wrapped: " word))) + (echo-message! echo (str "Only occurrence: " word))))))))))) + +;; --- Feature 6: Smartscan Symbol Backward --- + +(def (cmd-smartscan-symbol-go-backward app) + "Jump backward to the previous occurrence of the symbol 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)) + (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 + ;; Search backward: set target from 0 to word-start, use SCI_SEARCHINTARGET + ;; Scintilla searches forward in target, so we search 0..word-start and find last + (send-message ed SCI_SETTARGETSTART 0 0) + (send-message ed SCI_SETTARGETEND word-start 0) + (send-message ed SCI_SETSEARCHFLAGS 4 0) ;; SCFIND_WHOLEWORD + (let find-last ((last-pos -1) (search-from 0)) + (send-message ed SCI_SETTARGETSTART search-from 0) + (send-message ed SCI_SETTARGETEND word-start 0) + (let ((found (send-message ed SCI_SEARCHINTARGET (string-length word) word))) + (if (>= found 0) + (find-last found (+ found (string-length word))) + (if (>= last-pos 0) + (begin + (editor-goto-pos ed last-pos) + (send-message ed SCI_SETSEL last-pos (+ last-pos (string-length word))) + (echo-message! echo (str "Found: " word))) + ;; Wrap around + (begin + (send-message ed SCI_SETTARGETSTART word-end 0) + (send-message ed SCI_SETTARGETEND (send-message ed SCI_GETLENGTH 0 0) 0) + (let find-last2 ((lp -1) (sf word-end)) + (send-message ed SCI_SETTARGETSTART sf 0) + (send-message ed SCI_SETTARGETEND (send-message ed SCI_GETLENGTH 0 0) 0) + (let ((f2 (send-message ed SCI_SEARCHINTARGET (string-length word) word))) + (if (>= f2 0) + (find-last2 f2 (+ f2 (string-length word))) + (if (>= lp 0) + (begin + (editor-goto-pos ed lp) + (send-message ed SCI_SETSEL lp (+ lp (string-length word))) + (echo-message! echo (str "Wrapped: " word))) + (echo-message! echo (str "Only occurrence: " word))))))))))))))) + +;; --- Feature 7: Toggle Quotes --- + +(def (cmd-toggle-quotes app) + "Toggle between single and double quotes around the string 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)) + (char-at (send-message ed SCI_GETCHARAT pos 0))) + ;; Find the enclosing quote + (let* ((quote-char + (cond + ((or (= char-at 34) (= char-at 39)) char-at) ;; " or ' + (else + ;; Search backward for a quote + (let search-back ((p (- pos 1))) + (if (< p 0) #f + (let ((c (send-message ed SCI_GETCHARAT p 0))) + (if (or (= c 34) (= c 39)) c + (search-back (- p 1))))))))) + (target-char (if (and quote-char (= quote-char 34)) 39 34))) + (if (not quote-char) + (echo-message! echo "No quotes found near point") + ;; Find opening quote + (let find-open ((p pos)) + (if (< p 0) + (echo-message! echo "Could not find opening quote") + (let ((c (send-message ed SCI_GETCHARAT p 0))) + (if (= c quote-char) + ;; Found opening, find closing + (let find-close ((q (+ p 1))) + (let ((len (send-message ed SCI_GETLENGTH 0 0))) + (if (>= q len) + (echo-message! echo "Could not find closing quote") + (let ((c2 (send-message ed SCI_GETCHARAT q 0))) + (if (= c2 quote-char) + ;; Replace both quotes + (let ((new-char (string (integer->char target-char)))) + (send-message ed SCI_SETTARGETSTART q 0) + (send-message ed SCI_SETTARGETEND (+ q 1) 0) + (send-message ed SCI_REPLACETARGET -1 new-char) + (send-message ed SCI_SETTARGETSTART p 0) + (send-message ed SCI_SETTARGETEND (+ p 1) 0) + (send-message ed SCI_REPLACETARGET -1 new-char) + (echo-message! echo (str "Toggled to " + (if (= target-char 34) "double" "single") " quotes"))) + (find-close (+ q 1))))))) + (find-open (- p 1)))))))))) + +;; --- Feature 8: Browse URL at Point --- + +(def (cmd-browse-url-at-point app) + "Open the URL under the cursor in the default web browser." + (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)) + (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-text (editor-get-text-range ed line-start line-end))) + ;; Find URL in line text + (with-catch + (lambda (e) (echo-message! echo (str "Error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports + (str "echo " (shell-quote line-text) + " | grep -oP 'https?://[^ \\t\\n\\r\"'\\''><]+' | head -1") + 'block (native-transcoder)))) + (close-port si) + (let ((url (get-line so))) + (close-port so) (close-port se) + (if (eof-object? url) + (echo-message! echo "No URL found on current line") + (let ((trimmed (string-trim url))) + (let-values (((si2 so2 se2 pid2) + (open-process-ports + (str "xdg-open " (shell-quote trimmed) " 2>/dev/null &") + 'block (native-transcoder)))) + (close-port si2) (close-port so2) (close-port se2) + (echo-message! echo (str "Opening: " trimmed))))))))))) + +;; --- Feature 9: Dumb Jump --- + +(def (cmd-dumb-jump app) + "Jump to definition of symbol at point using grep/rg." + (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))) + (if (or (not symbol) (string-empty? symbol)) + (echo-message! echo "No symbol at point") + (with-catch + (lambda (e) (echo-message! echo (str "dumb-jump error: " e))) + (lambda () + ;; Try rg first, fall back to grep + (let-values (((si so se pid) + (open-process-ports + (str "rg -n --no-heading '(def|defn|defun|define|class|function|func|fn|let|const|var|type|struct)\\s+" + symbol "\\b' . 2>/dev/null || grep -rn 'def.*" + symbol "' --include='*.ss' --include='*.scm' --include='*.py' --include='*.js' --include='*.go' --include='*.rs' . 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 ((results (reverse lines))) + (if (null? results) + (echo-message! echo (str "No definition found for: " symbol)) + (if (= (length results) 1) + ;; Single result: jump directly + (let* ((result (car results)) + (parts (string-split result #\:))) + (when (>= (length parts) 2) + (let ((file (car parts)) + (line-num (string->number (cadr parts)))) + (when (and file line-num) + (cmd-find-file-at app file line-num))))) + ;; Multiple results: show in buffer + (let* ((new-buf (create-buffer "*dumb-jump*")) + (result-text (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 "=== Definitions of " symbol " ===\n\n" result-text "\n"))) + (echo-message! echo (str (length results) " definitions found"))))))) + (loop (cons line lines))))))))))) + +(def (cmd-find-file-at app file line-num) + "Helper: open file and go to line number." + (let* ((frame (app-state-frame app)) + (buf (find-or-create-file-buffer file))) + (switch-to-buffer frame buf) + (let ((ed (edit-window-editor (current-window frame)))) + (when line-num + (let ((pos (send-message ed SCI_POSITIONFROMLINE (- line-num 1) 0))) + (editor-goto-pos ed pos)))))) + +;; --- Feature 10: Diff Buffer with File --- + +(def (cmd-diff-buffer-with-file app) + "Show the diff between the current buffer contents and the file on disk." + (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") + (with-catch + (lambda (e) (echo-message! echo (str "diff error: " e))) + (lambda () + (let* ((text (editor-get-text ed)) + (tmp-file (str "/tmp/jemacs-diff-" (time-second (current-time)) ".tmp"))) + (write-file-string tmp-file text) + (let-values (((si so se pid) + (open-process-ports + (str "diff -u " (shell-quote file) " " (shell-quote tmp-file) + " 2>/dev/null; rm -f " (shell-quote tmp-file)) + '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 ((diff-text (string-join (reverse lines) "\n"))) + (if (string-empty? diff-text) + (echo-message! echo "Buffer matches file on disk") + (let* ((new-buf (create-buffer "*diff*"))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed diff-text)) + (echo-message! echo "Diff loaded"))))) + (loop (cons line lines)))))))))))) --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1747,4 +1747,26 @@ (register-command! 'git-file-history cmd-git-file-history) (register-command! 'copy-git-branch cmd-copy-git-branch) (register-command! 'eval-and-replace cmd-eval-and-replace) + ;; Round 15 batch 1: string-inflection-cycle, crux-kill-whole-line, crux-transpose-windows, crux-delete-file-and-buffer, smartscan-symbol-go-forward, smartscan-symbol-go-backward, toggle-quotes, browse-url-at-point, dumb-jump, diff-buffer-with-file + (register-command! 'string-inflection-cycle cmd-string-inflection-cycle) + (register-command! 'crux-kill-whole-line cmd-crux-kill-whole-line) + (register-command! 'crux-transpose-windows cmd-crux-transpose-windows) + (register-command! 'crux-delete-file-and-buffer cmd-crux-delete-file-and-buffer) + (register-command! 'smartscan-symbol-go-forward cmd-smartscan-symbol-go-forward) + (register-command! 'smartscan-symbol-go-backward cmd-smartscan-symbol-go-backward) + (register-command! 'toggle-quotes cmd-toggle-quotes) + (register-command! 'browse-url-at-point cmd-browse-url-at-point) + (register-command! 'dumb-jump cmd-dumb-jump) + (register-command! 'diff-buffer-with-file cmd-diff-buffer-with-file) + ;; Round 15 batch 2: copy-as-format, edit-indirect, crux-indent-defun, crux-cleanup-buffer, recover-file, hexl-mode, zone, doctor, animate-string, tetris + (register-command! 'copy-as-format cmd-copy-as-format) + (register-command! 'edit-indirect cmd-edit-indirect) + (register-command! 'crux-indent-defun cmd-crux-indent-defun) + (register-command! 'crux-cleanup-buffer cmd-crux-cleanup-buffer) + (register-command! 'recover-file cmd-recover-file) + (register-command! 'hexl-mode cmd-hexl-mode) + (register-command! 'zone cmd-zone) + (register-command! 'doctor cmd-doctor) + (register-command! 'animate-string cmd-animate-string) + (register-command! 'tetris cmd-tetris) )