Round 23: Add 20 new Emacs features
ober
f3b28ea9a8e8ea4392db1ac15aa9c3107e075e30
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1566,6 +1566,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | LPR buffer | :orange_circle: | Print buffer (lpr alias) | | Flush lines | :orange_circle: | Delete lines matching pattern | | Keep lines | :orange_circle: | Keep only lines matching pattern | +| How many | :orange_circle: | Count occurrences of a pattern | +| Count matches | :orange_circle: | Count pattern matches (alias) | +| Occur mode | :orange_circle: | Show all lines matching pattern | +| Delete matching lines | :orange_circle: | Delete lines matching pattern | +| Delete non-matching lines | :orange_circle: | Keep only matching lines | +| Transpose lines | :orange_circle: | Swap current and previous line | +| Transpose words | :orange_circle: | Swap words around cursor | +| Transpose sexps | :orange_circle: | Swap S-expressions (placeholder) | +| Transpose paragraphs | :orange_circle: | Swap current and previous paragraph | +| Upcase word | :orange_circle: | Convert word to uppercase | +| Downcase word | :orange_circle: | Convert word to lowercase | +| Capitalize word | :orange_circle: | Capitalize word at cursor | +| Upcase initials | :orange_circle: | Upcase first letter of each word | +| Tabify | :orange_circle: | Convert spaces to tabs in region | +| Untabify | :orange_circle: | Convert tabs to spaces in region | +| Indent region | :orange_circle: | Indent all lines in region | +| Back to indentation | :orange_circle: | Move to first non-whitespace on line | +| Delete indentation | :orange_circle: | Join line with previous | +| Fixup whitespace | :orange_circle: | Collapse whitespace around point | +| Just one space | :orange_circle: | Replace whitespace with single space | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -8073,3 +8073,205 @@ (result (string-join kept "\n"))) (editor-set-text ed result) (echo-message! echo (str "Kept " (length kept) " lines matching \"" pattern "\" (removed " removed ")")))))) + +;; Round 23 batch 2: downcase-word, capitalize-word, upcase-initials, tabify, untabify, +;; indent-region, back-to-indentation, delete-indentation, fixup-whitespace, just-one-space + +;; cmd-downcase-word: Convert word at cursor to lowercase +(def (cmd-downcase-word app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text))) + (let* ((word-start (let loop ((i pos)) + (if (or (<= i 0) (not (char-alphabetic? (string-ref text (- i 1))))) + i (loop (- i 1))))) + (word-end (let loop ((i pos)) + (if (or (>= i len) (not (char-alphabetic? (string-ref text i)))) + i (loop (+ i 1)))))) + (if (= word-start word-end) + (echo-message! echo "No word at point") + (let ((word (string-downcase (substring text word-start word-end)))) + (editor-replace-range ed word-start word-end word) + (echo-message! echo (str "Downcased: " word))))))) + +;; cmd-capitalize-word: Capitalize word at cursor +(def (cmd-capitalize-word app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text))) + (let* ((word-start (let loop ((i pos)) + (if (or (<= i 0) (not (char-alphabetic? (string-ref text (- i 1))))) + i (loop (- i 1))))) + (word-end (let loop ((i pos)) + (if (or (>= i len) (not (char-alphabetic? (string-ref text i)))) + i (loop (+ i 1)))))) + (if (= word-start word-end) + (echo-message! echo "No word at point") + (let* ((word (substring text word-start word-end)) + (capitalized (str (string-upcase (substring word 0 1)) + (string-downcase (substring word 1 (string-length word)))))) + (editor-replace-range ed word-start word-end capitalized) + (echo-message! echo (str "Capitalized: " capitalized))))))) + +;; cmd-upcase-initials: Upcase first letter of each word in region +(def (cmd-upcase-initials 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* ((text (editor-get-text-range ed sel-start sel-end)) + (result (let loop ((i 0) (prev-space #t) (acc '())) + (if (>= i (string-length text)) + (list->string (reverse acc)) + (let ((c (string-ref text i))) + (if (char-whitespace? c) + (loop (+ i 1) #t (cons c acc)) + (loop (+ i 1) #f + (cons (if prev-space (char-upcase c) c) acc)))))))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo "Initials upcased"))))) + +;; cmd-tabify: Convert spaces to tabs in region +(def (cmd-tabify 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* ((text (editor-get-text-range ed sel-start sel-end)) + (tab-width 8) + (spaces (make-string tab-width #\space)) + (result (let loop ((s text)) + (let ((idx (string-contains s spaces))) + (if (not idx) s + (loop (str (substring s 0 idx) "\t" + (substring s (+ idx tab-width) (string-length s))))))))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo "Tabified region"))))) + +;; cmd-untabify: Convert tabs to spaces in region +(def (cmd-untabify 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* ((text (editor-get-text-range ed sel-start sel-end)) + (tab-width 8) + (spaces (make-string tab-width #\space)) + (result (let loop ((s text)) + (let ((idx (string-contains s "\t"))) + (if (not idx) s + (loop (str (substring s 0 idx) spaces + (substring s (+ idx 1) (string-length s))))))))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo "Untabified region"))))) + +;; cmd-indent-region: Indent all lines in region +(def (cmd-indent-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* ((text (editor-get-text-range ed sel-start sel-end)) + (lines (string-split text #\newline)) + (indented (map (lambda (line) + (if (string=? (string-trim line) "") + line + (str " " line))) + lines)) + (result (string-join indented "\n"))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo "Region indented"))))) + +;; cmd-back-to-indentation: Move cursor to first non-whitespace char on line +(def (cmd-back-to-indentation app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (cur-line (editor-current-line ed)) + (line-start (editor-line-start ed cur-line)) + (line-text (editor-get-line ed cur-line)) + (indent-pos (let loop ((i 0)) + (if (>= i (string-length line-text)) i + (if (char-whitespace? (string-ref line-text i)) + (loop (+ i 1)) i))))) + (editor-set-cursor ed (+ line-start indent-pos)) + (echo-message! echo "Back to indentation"))) + +;; cmd-delete-indentation: Join this line with previous, removing indent +(def (cmd-delete-indentation app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (cur-line (editor-current-line ed))) + (if (<= cur-line 0) + (echo-message! echo "Already at first line") + (let* ((prev-end (editor-line-end ed (- cur-line 1))) + (cur-start (editor-line-start ed cur-line)) + (cur-text (editor-get-line ed cur-line)) + (trimmed (string-trim cur-text))) + (editor-replace-range ed prev-end cur-start (str " ")) + (echo-message! echo "Lines joined"))))) + +;; cmd-fixup-whitespace: Fix whitespace around point (collapse to single space or none) +(def (cmd-fixup-whitespace app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text))) + (let* ((ws-start (let loop ((i (- pos 1))) + (if (or (< i 0) (not (char-whitespace? (string-ref text i)))) + (+ i 1) (loop (- i 1))))) + (ws-end (let loop ((i pos)) + (if (or (>= i len) (not (char-whitespace? (string-ref text i)))) + i (loop (+ i 1)))))) + (if (= ws-start ws-end) + (echo-message! echo "No whitespace to fix") + ;; Replace with single space if between non-whitespace, or nothing at line boundaries + (let ((replacement (if (or (= ws-start 0) (= ws-end len) + (char=? (string-ref text (- ws-start 1)) #\newline) + (char=? (string-ref text ws-end) #\newline)) + "" " "))) + (editor-replace-range ed ws-start ws-end replacement) + (echo-message! echo "Whitespace fixed")))))) + +;; cmd-just-one-space: Replace whitespace around point with single space +(def (cmd-just-one-space app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text))) + (let* ((ws-start (let loop ((i (- pos 1))) + (if (or (< i 0) (not (char-whitespace? (string-ref text i)))) + (+ i 1) (loop (- i 1))))) + (ws-end (let loop ((i pos)) + (if (or (>= i len) (not (char-whitespace? (string-ref text i)))) + i (loop (+ i 1)))))) + (if (= ws-start ws-end) + (begin + (editor-insert-text ed pos " ") + (echo-message! echo "Inserted space")) + (begin + (editor-replace-range ed ws-start ws-end " ") + (echo-message! echo "Reduced to one space")))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -8509,3 +8509,198 @@ (editor-set-text ed output) (echo-message! echo (str (+ (length text-entries) (length point-entries)) " registers")))) +;; Round 23 batch 1: how-many, count-matches, occur-mode, delete-matching-lines, +;; delete-non-matching-lines, transpose-lines, transpose-words, transpose-sexps, +;; transpose-paragraphs, upcase-word + +;; cmd-how-many: Count occurrences of a pattern +(def (cmd-how-many app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pattern (echo-read-string echo "How many matches for: "))) + (if (or (not pattern) (string=? pattern "")) + (echo-message! echo "No pattern specified") + (let* ((text (editor-get-text ed)) + (pat-len (string-length pattern)) + (count (let loop ((pos 0) (n 0)) + (let ((idx (string-contains text pattern pos))) + (if (not idx) n + (loop (+ idx pat-len) (+ n 1))))))) + (echo-message! echo (str count " occurrences of \"" pattern "\"")))))) + +;; cmd-count-matches: Alias for how-many +(def (cmd-count-matches app) + (cmd-how-many app)) + +;; cmd-occur-mode: Show all lines matching a pattern +(def (cmd-occur-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pattern (echo-read-string echo "Occur pattern: "))) + (if (or (not pattern) (string=? pattern "")) + (echo-message! echo "No pattern specified") + (let* ((text (editor-get-text ed)) + (lines (string-split text #\newline)) + (matches (let loop ((ls lines) (n 1) (acc '())) + (if (null? ls) (reverse acc) + (let ((line (car ls))) + (if (string-contains line pattern) + (loop (cdr ls) (+ n 1) (cons (str (number->string n) ": " line) acc)) + (loop (cdr ls) (+ n 1) acc)))))) + (result (str "=== Occur: \"" pattern "\" ===\n\n" + (if (null? matches) "No matches found.\n" + (str (string-join matches "\n") "\n\n" + (number->string (length matches)) " matches\n"))))) + (editor-set-text ed result) + (echo-message! echo (str (length matches) " matches for \"" pattern "\"")))))) + +;; cmd-delete-matching-lines: Delete lines matching pattern (alias for flush-lines) +(def (cmd-delete-matching-lines app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pattern (echo-read-string echo "Delete lines matching: "))) + (if (or (not pattern) (string=? pattern "")) + (echo-message! echo "No pattern specified") + (let* ((text (editor-get-text ed)) + (lines (string-split text #\newline)) + (kept (filter (lambda (line) (not (string-contains line pattern))) lines)) + (removed (- (length lines) (length kept))) + (result (string-join kept "\n"))) + (editor-set-text ed result) + (echo-message! echo (str "Deleted " removed " matching lines")))))) + +;; cmd-delete-non-matching-lines: Delete lines NOT matching pattern (alias for keep-lines) +(def (cmd-delete-non-matching-lines app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pattern (echo-read-string echo "Keep lines matching: "))) + (if (or (not pattern) (string=? pattern "")) + (echo-message! echo "No pattern specified") + (let* ((text (editor-get-text ed)) + (lines (string-split text #\newline)) + (kept (filter (lambda (line) (string-contains line pattern)) lines)) + (removed (- (length lines) (length kept))) + (result (string-join kept "\n"))) + (editor-set-text ed result) + (echo-message! echo (str "Kept " (length kept) " matching lines, deleted " removed)))))) + +;; cmd-transpose-lines: Swap current line with the one above +(def (cmd-transpose-lines app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (cur-line (editor-current-line ed))) + (if (<= cur-line 0) + (echo-message! echo "No line above to transpose with") + (let* ((line1-start (editor-line-start ed (- cur-line 1))) + (line1-end (editor-line-end ed (- cur-line 1))) + (line2-start (editor-line-start ed cur-line)) + (line2-end (editor-line-end ed cur-line)) + (line1-text (editor-get-text-range ed line1-start line1-end)) + (line2-text (editor-get-text-range ed line2-start line2-end))) + (editor-replace-range ed line2-start line2-end line1-text) + (editor-replace-range ed line1-start line1-end line2-text) + (echo-message! echo "Lines transposed"))))) + +;; cmd-transpose-words: Swap word before and after cursor +(def (cmd-transpose-words app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text))) + ;; Find word boundaries around cursor + (let* ((word-end2 (let loop ((i pos)) + (if (or (>= i len) (not (char-alphabetic? (string-ref text i)))) + i (loop (+ i 1))))) + (word-start2 (let loop ((i (max 0 (- pos 1)))) + (if (or (<= i 0) (not (char-alphabetic? (string-ref text i)))) + (+ i 1) (loop (- i 1))))) + ;; Find previous word + (gap-start (let loop ((i (- word-start2 1))) + (if (or (<= i 0) (char-alphabetic? (string-ref text i))) + (+ i 1) (loop (- i 1))))) + (word-end1 gap-start) + (word-start1 (let loop ((i (- word-end1 1))) + (if (or (<= i 0) (not (char-alphabetic? (string-ref text i)))) + (+ i 1) (loop (- i 1)))))) + (if (>= word-start1 word-start2) + (echo-message! echo "Cannot transpose words here") + (let* ((word1 (substring text word-start1 word-end1)) + (between (substring text word-end1 word-start2)) + (word2 (substring text word-start2 word-end2)) + (replacement (str word2 between word1))) + (editor-replace-range ed word-start1 word-end2 replacement) + (echo-message! echo "Words transposed")))))) + +;; cmd-transpose-sexps: Swap S-expressions around cursor +(def (cmd-transpose-sexps app) + (let* ((echo (app-state-echo app))) + (echo-message! echo "transpose-sexps: requires full sexp parser (not yet implemented)"))) + +;; cmd-transpose-paragraphs: Swap current paragraph with previous +(def (cmd-transpose-paragraphs app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (cur-line (editor-current-line ed)) + (total-lines (editor-line-count ed))) + ;; Find current paragraph boundaries + (let* ((para2-start (let loop ((ln cur-line)) + (if (<= ln 0) 0 + (if (string=? (string-trim (editor-get-line ed ln)) "") + (+ ln 1) (loop (- ln 1)))))) + (para2-end (let loop ((ln cur-line)) + (if (>= ln total-lines) (- total-lines 1) + (if (string=? (string-trim (editor-get-line ed ln)) "") + (- ln 1) (loop (+ ln 1)))))) + ;; Find previous paragraph + (gap-line (let loop ((ln (- para2-start 1))) + (if (<= ln 0) -1 + (if (not (string=? (string-trim (editor-get-line ed ln)) "")) + ln (loop (- ln 1)))))) + ) + (if (< gap-line 0) + (echo-message! echo "No previous paragraph to transpose with") + (let* ((para1-end gap-line) + (para1-start (let loop ((ln para1-end)) + (if (<= ln 0) 0 + (if (string=? (string-trim (editor-get-line ed ln)) "") + (+ ln 1) (loop (- ln 1)))))) + (p1-start-pos (editor-line-start ed para1-start)) + (p1-end-pos (editor-line-end ed para1-end)) + (p2-start-pos (editor-line-start ed para2-start)) + (p2-end-pos (editor-line-end ed para2-end)) + (para1-text (editor-get-text-range ed p1-start-pos p1-end-pos)) + (between-text (editor-get-text-range ed p1-end-pos p2-start-pos)) + (para2-text (editor-get-text-range ed p2-start-pos p2-end-pos)) + (replacement (str para2-text between-text para1-text))) + (editor-replace-range ed p1-start-pos p2-end-pos replacement) + (echo-message! echo "Paragraphs transposed")))))) + +;; cmd-upcase-word: Convert word at cursor to uppercase +(def (cmd-upcase-word app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text))) + ;; Find word boundaries + (let* ((word-start (let loop ((i pos)) + (if (or (<= i 0) (not (char-alphabetic? (string-ref text (- i 1))))) + i (loop (- i 1))))) + (word-end (let loop ((i pos)) + (if (or (>= i len) (not (char-alphabetic? (string-ref text i)))) + i (loop (+ i 1)))))) + (if (= word-start word-end) + (echo-message! echo "No word at point") + (let ((word (string-upcase (substring text word-start word-end)))) + (editor-replace-range ed word-start word-end word) + (echo-message! echo (str "Upcased: " word))))))) + --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1923,4 +1923,26 @@ (register-command! 'lpr-buffer cmd-lpr-buffer) (register-command! 'flush-lines cmd-flush-lines) (register-command! 'keep-lines cmd-keep-lines) + ;; Round 23 batch 1: how-many, count-matches, occur-mode, delete-matching-lines, delete-non-matching-lines, transpose-lines, transpose-words, transpose-sexps, transpose-paragraphs, upcase-word + (register-command! 'how-many cmd-how-many) + (register-command! 'count-matches cmd-count-matches) + (register-command! 'occur-mode cmd-occur-mode) + (register-command! 'delete-matching-lines cmd-delete-matching-lines) + (register-command! 'delete-non-matching-lines cmd-delete-non-matching-lines) + (register-command! 'transpose-lines cmd-transpose-lines) + (register-command! 'transpose-words cmd-transpose-words) + (register-command! 'transpose-sexps cmd-transpose-sexps) + (register-command! 'transpose-paragraphs cmd-transpose-paragraphs) + (register-command! 'upcase-word cmd-upcase-word) + ;; Round 23 batch 2: downcase-word, capitalize-word, upcase-initials, tabify, untabify, indent-region, back-to-indentation, delete-indentation, fixup-whitespace, just-one-space + (register-command! 'downcase-word cmd-downcase-word) + (register-command! 'capitalize-word cmd-capitalize-word) + (register-command! 'upcase-initials cmd-upcase-initials) + (register-command! 'tabify cmd-tabify) + (register-command! 'untabify cmd-untabify) + (register-command! 'indent-region cmd-indent-region) + (register-command! 'back-to-indentation cmd-back-to-indentation) + (register-command! 'delete-indentation cmd-delete-indentation) + (register-command! 'fixup-whitespace cmd-fixup-whitespace) + (register-command! 'just-one-space cmd-just-one-space) )