Round 24: Add 20 new Emacs features
ober
d42d719c84ab185a300cf2fe61329dfc581ddf97
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1586,6 +1586,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | 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 | +| Delete horizontal space | :orange_circle: | Delete spaces/tabs around point | +| Cycle spacing | :orange_circle: | Cycle between one/no/original spacing | +| Zap to char | :orange_circle: | Delete to next char occurrence (inclusive) | +| Zap up to char | :orange_circle: | Delete up to next char occurrence | +| Delete pair | :orange_circle: | Delete matching pair characters | +| Mark word | :orange_circle: | Select word at point | +| Mark sexp | :orange_circle: | Select S-expression at point | +| Mark paragraph | :orange_circle: | Select current paragraph | +| Mark page | :orange_circle: | Select current page | +| Mark whole buffer | :orange_circle: | Select entire buffer | +| Narrow to page | :orange_circle: | Narrow buffer to current page | +| Widen | :orange_circle: | Restore buffer from narrowing | +| Goto char | :orange_circle: | Go to character position | +| Goto line relative | :orange_circle: | Go to line relative to current | +| Set goal column | :orange_circle: | Set/clear goal column for movement | +| What line | :orange_circle: | Show current line number | +| What page | :orange_circle: | Show current page number | +| What cursor position | :orange_circle: | Show detailed cursor position info | +| Count words region | :orange_circle: | Count words in region or buffer | +| Count lines region | :orange_circle: | Count lines in region or buffer | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -8275,3 +8275,189 @@ (begin (editor-replace-range ed ws-start ws-end " ") (echo-message! echo "Reduced to one space")))))) + +;; Round 24 batch 2: narrow-to-page, widen, goto-char, goto-line-relative, +;; set-goal-column, what-line, what-page, what-cursor-position, count-words-region, +;; count-lines-region + +;; cmd-narrow-to-page: Narrow buffer to current page (between form feeds) +(def (cmd-narrow-to-page app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (editor-get-text ed)) + (pos (editor-cursor-position ed)) + (len (string-length text)) + (page-start (let loop ((i (- pos 1))) + (if (<= i 0) 0 + (if (char=? (string-ref text i) #\x0C) (+ i 1) + (loop (- i 1)))))) + (page-end (let loop ((i pos)) + (if (>= i len) len + (if (char=? (string-ref text i) #\x0C) i + (loop (+ i 1)))))) + (page-text (substring text page-start page-end))) + ;; Store original text for widen + (hash-put! (app-state-modes app) 'narrow-original text) + (hash-put! (app-state-modes app) 'narrow-start page-start) + (editor-set-text ed page-text) + (echo-message! echo "Narrowed to page"))) + +;; cmd-widen: Restore buffer from narrowing +(def (cmd-widen app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (original (hash-get (app-state-modes app) 'narrow-original))) + (if (not original) + (echo-message! echo "Buffer is not narrowed") + (begin + (editor-set-text ed original) + (hash-remove! (app-state-modes app) 'narrow-original) + (hash-remove! (app-state-modes app) 'narrow-start) + (echo-message! echo "Buffer widened"))))) + +;; cmd-goto-char: Go to a specific character position +(def (cmd-goto-char app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos-str (echo-read-string echo "Goto char position: "))) + (if (or (not pos-str) (string=? pos-str "")) + (echo-message! echo "No position specified") + (let ((pos (string->number pos-str))) + (if (not pos) + (echo-message! echo "Invalid position") + (let ((len (editor-get-length ed))) + (if (or (< pos 0) (> pos len)) + (echo-message! echo (str "Position out of range (0-" len ")")) + (begin + (editor-set-cursor ed pos) + (echo-message! echo (str "Moved to position " pos)))))))))) + +;; cmd-goto-line-relative: Go to a line relative to current +(def (cmd-goto-line-relative app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (offset-str (echo-read-string echo "Goto line relative (+N or -N): "))) + (if (or (not offset-str) (string=? offset-str "")) + (echo-message! echo "No offset specified") + (let ((offset (string->number offset-str))) + (if (not offset) + (echo-message! echo "Invalid number") + (let* ((cur-line (editor-current-line ed)) + (target (+ cur-line offset)) + (total (editor-line-count ed)) + (clamped (max 0 (min target (- total 1))))) + (editor-set-cursor ed (editor-line-start ed clamped)) + (echo-message! echo (str "Line " (+ clamped 1))))))))) + +;; cmd-set-goal-column: Set or clear the goal column for vertical movement +(def (cmd-set-goal-column app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + (cur-line (editor-current-line ed)) + (line-start (editor-line-start ed cur-line)) + (col (- pos line-start))) + (if (hash-get (app-state-modes app) 'goal-column) + (begin + (hash-remove! (app-state-modes app) 'goal-column) + (echo-message! echo "Goal column cleared")) + (begin + (hash-put! (app-state-modes app) 'goal-column col) + (echo-message! echo (str "Goal column set to " col)))))) + +;; cmd-what-line: Show current line number +(def (cmd-what-line app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (cur-line (editor-current-line ed)) + (total (editor-line-count ed))) + (echo-message! echo (str "Line " (+ cur-line 1) " of " total)))) + +;; cmd-what-page: Show current page number (pages separated by form feeds) +(def (cmd-what-page 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)) + (page (let loop ((i 0) (p 1)) + (if (>= i pos) p + (if (char=? (string-ref text i) #\x0C) + (loop (+ i 1) (+ p 1)) + (loop (+ i 1) p)))))) + (echo-message! echo (str "Page " page)))) + +;; cmd-what-cursor-position: Show detailed info about cursor position (C-x =) +(def (cmd-what-cursor-position 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)) + (cur-line (editor-current-line ed)) + (line-start (editor-line-start ed cur-line)) + (col (- pos line-start))) + (if (>= pos len) + (echo-message! echo (str "point=" pos " of " len " (EOB) line=" (+ cur-line 1) " col=" col)) + (let* ((c (string-ref text pos)) + (code (char->integer c))) + (echo-message! echo (str "Char: " (if (char=? c #\space) "SPC" (string c)) + " (#x" (number->string code 16) + ", " code ")" + " point=" pos " of " len + " (" (if (= len 0) 0 (quotient (* pos 100) len)) "%)" + " line=" (+ cur-line 1) + " col=" col)))))) + +;; cmd-count-words-region: Count words in the selected region +(def (cmd-count-words-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) + ;; No selection — count whole buffer + (let* ((text (editor-get-text ed)) + (len (string-length text)) + (words (let loop ((i 0) (in-word #f) (count 0)) + (if (>= i len) (if in-word (+ count 1) count) + (if (char-whitespace? (string-ref text i)) + (loop (+ i 1) #f (if in-word (+ count 1) count)) + (loop (+ i 1) #t count))))) + (lines (+ 1 (let loop ((i 0) (n 0)) + (if (>= i len) n + (loop (+ i 1) (if (char=? (string-ref text i) #\newline) (+ n 1) n))))))) + (echo-message! echo (str "Buffer has " lines " lines, " words " words, " len " characters"))) + (let* ((text (editor-get-text-range ed sel-start sel-end)) + (len (string-length text)) + (words (let loop ((i 0) (in-word #f) (count 0)) + (if (>= i len) (if in-word (+ count 1) count) + (if (char-whitespace? (string-ref text i)) + (loop (+ i 1) #f (if in-word (+ count 1) count)) + (loop (+ i 1) #t count)))))) + (echo-message! echo (str "Region: " words " words, " len " characters")))))) + +;; cmd-count-lines-region: Count lines in the selected region +(def (cmd-count-lines-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) + (let* ((total (editor-line-count ed))) + (echo-message! echo (str "Buffer has " total " lines"))) + (let* ((text (editor-get-text-range ed sel-start sel-end)) + (len (string-length text)) + (lines (+ 1 (let loop ((i 0) (n 0)) + (if (>= i len) n + (loop (+ i 1) (if (char=? (string-ref text i) #\newline) (+ n 1) n))))))) + (echo-message! echo (str "Region has " lines " lines, " len " characters")))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -8704,3 +8704,218 @@ (editor-replace-range ed word-start word-end word) (echo-message! echo (str "Upcased: " word))))))) +;; Round 24 batch 1: delete-horizontal-space, cycle-spacing, zap-to-char, zap-up-to-char, +;; delete-pair, mark-word, mark-sexp, mark-paragraph, mark-page, mark-whole-buffer + +;; cmd-delete-horizontal-space: Delete all spaces and tabs around point +(def (cmd-delete-horizontal-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) + (let ((c (string-ref text i))) + (not (or (char=? c #\space) (char=? c #\tab))))) + (+ i 1) (loop (- i 1))))) + (ws-end (let loop ((i pos)) + (if (or (>= i len) + (let ((c (string-ref text i))) + (not (or (char=? c #\space) (char=? c #\tab))))) + i (loop (+ i 1)))))) + (if (= ws-start ws-end) + (echo-message! echo "No horizontal space to delete") + (begin + (editor-replace-range ed ws-start ws-end "") + (echo-message! echo "Horizontal space deleted")))))) + +;; cmd-cycle-spacing: Cycle between one space, no space, and original spacing +(def (cmd-cycle-spacing 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))))) + (ws-len (- ws-end ws-start))) + (cond + ((= ws-len 0) (editor-insert-text ed pos " ") (echo-message! echo "Inserted space")) + ((= ws-len 1) (editor-replace-range ed ws-start ws-end "") (echo-message! echo "Deleted space")) + (else (editor-replace-range ed ws-start ws-end " ") (echo-message! echo "Reduced to one space")))))) + +;; cmd-zap-to-char: Delete from point to next occurrence of a character (inclusive) +(def (cmd-zap-to-char app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (char-str (echo-read-string echo "Zap to char: "))) + (if (or (not char-str) (string=? char-str "")) + (echo-message! echo "No character specified") + (let* ((c (string-ref char-str 0)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text)) + (target (let loop ((i (+ pos 1))) + (if (>= i len) #f + (if (char=? (string-ref text i) c) i + (loop (+ i 1))))))) + (if (not target) + (echo-message! echo (str "Character '" char-str "' not found")) + (begin + (editor-replace-range ed pos (+ target 1) "") + (echo-message! echo (str "Zapped to '" char-str "'")))))))) + +;; cmd-zap-up-to-char: Delete from point to just before next occurrence of char +(def (cmd-zap-up-to-char app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (char-str (echo-read-string echo "Zap up to char: "))) + (if (or (not char-str) (string=? char-str "")) + (echo-message! echo "No character specified") + (let* ((c (string-ref char-str 0)) + (pos (editor-cursor-position ed)) + (text (editor-get-text ed)) + (len (string-length text)) + (target (let loop ((i (+ pos 1))) + (if (>= i len) #f + (if (char=? (string-ref text i) c) i + (loop (+ i 1))))))) + (if (not target) + (echo-message! echo (str "Character '" char-str "' not found")) + (begin + (editor-replace-range ed pos target "") + (echo-message! echo (str "Zapped up to '" char-str "'")))))))) + +;; cmd-delete-pair: Delete matching pair of characters (parens, brackets, etc.) +(def (cmd-delete-pair 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))) + (if (>= pos len) + (echo-message! echo "End of buffer") + (let* ((c (string-ref text pos)) + (pairs '((#\( . #\)) (#\[ . #\]) (#\{ . #\}) (#\" . #\") (#\' . #\'))) + (match (assv c pairs))) + (if (not match) + (echo-message! echo "Not on a pair character") + (let* ((close (cdr match)) + (close-pos (let loop ((i (+ pos 1)) (depth 1)) + (if (>= i len) #f + (let ((ch (string-ref text i))) + (cond + ((and (char=? ch close) (= depth 1)) i) + ((char=? ch c) (loop (+ i 1) (+ depth 1))) + ((char=? ch close) (loop (+ i 1) (- depth 1))) + (else (loop (+ i 1) depth)))))))) + (if (not close-pos) + (echo-message! echo "No matching close character found") + (begin + ;; Delete closing first (higher position), then opening + (editor-replace-range ed close-pos (+ close-pos 1) "") + (editor-replace-range ed pos (+ pos 1) "") + (echo-message! echo "Pair deleted"))))))))) + +;; cmd-mark-word: Select the word at or after point +(def (cmd-mark-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 (max pos word-start))) + (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") + (begin + (editor-set-selection ed word-start word-end) + (echo-message! echo (str "Marked word: \"" (substring text word-start word-end) "\""))))))) + +;; cmd-mark-sexp: Select the S-expression at point +(def (cmd-mark-sexp 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))) + (if (or (>= pos len) (not (char=? (string-ref text pos) #\())) + (echo-message! echo "Not at start of sexp") + (let ((end (let loop ((i (+ pos 1)) (depth 1)) + (if (>= i len) #f + (let ((c (string-ref text i))) + (cond + ((char=? c #\() (loop (+ i 1) (+ depth 1))) + ((char=? c #\)) (if (= depth 1) (+ i 1) (loop (+ i 1) (- depth 1)))) + (else (loop (+ i 1) depth)))))))) + (if (not end) + (echo-message! echo "Unmatched paren") + (begin + (editor-set-selection ed pos end) + (echo-message! echo (str "Marked sexp (" (- end pos) " chars)")))))))) + +;; cmd-mark-paragraph: Select the current paragraph +(def (cmd-mark-paragraph 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)) + (para-start (let loop ((ln cur-line)) + (if (<= ln 0) 0 + (if (string=? (string-trim (editor-get-line ed ln)) "") + (+ ln 1) (loop (- ln 1)))))) + (para-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)))))) + (start-pos (editor-line-start ed para-start)) + (end-pos (editor-line-end ed para-end))) + (editor-set-selection ed start-pos end-pos) + (echo-message! echo "Paragraph marked"))) + +;; cmd-mark-page: Select from previous page break to next +(def (cmd-mark-page app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (editor-get-text ed)) + (pos (editor-cursor-position ed)) + (len (string-length text)) + ;; Find page breaks (form feed character \x0C) + (page-start (let loop ((i (- pos 1))) + (if (<= i 0) 0 + (if (char=? (string-ref text i) #\x0C) (+ i 1) + (loop (- i 1)))))) + (page-end (let loop ((i pos)) + (if (>= i len) len + (if (char=? (string-ref text i) #\x0C) i + (loop (+ i 1))))))) + (editor-set-selection ed page-start page-end) + (echo-message! echo "Page marked"))) + +;; cmd-mark-whole-buffer: Select entire buffer (C-x h) +(def (cmd-mark-whole-buffer app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (len (editor-get-length ed))) + (editor-set-selection ed 0 len) + (echo-message! echo "Whole buffer marked"))) + --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1945,4 +1945,26 @@ (register-command! 'delete-indentation cmd-delete-indentation) (register-command! 'fixup-whitespace cmd-fixup-whitespace) (register-command! 'just-one-space cmd-just-one-space) + ;; Round 24 batch 1 + (register-command! 'delete-horizontal-space cmd-delete-horizontal-space) + (register-command! 'cycle-spacing cmd-cycle-spacing) + (register-command! 'zap-to-char cmd-zap-to-char) + (register-command! 'zap-up-to-char cmd-zap-up-to-char) + (register-command! 'delete-pair cmd-delete-pair) + (register-command! 'mark-word cmd-mark-word) + (register-command! 'mark-sexp cmd-mark-sexp) + (register-command! 'mark-paragraph cmd-mark-paragraph) + (register-command! 'mark-page cmd-mark-page) + (register-command! 'mark-whole-buffer cmd-mark-whole-buffer) + ;; Round 24 batch 2 + (register-command! 'narrow-to-page cmd-narrow-to-page) + (register-command! 'widen cmd-widen) + (register-command! 'goto-char cmd-goto-char) + (register-command! 'goto-line-relative cmd-goto-line-relative) + (register-command! 'set-goal-column cmd-set-goal-column) + (register-command! 'what-line cmd-what-line) + (register-command! 'what-page cmd-what-page) + (register-command! 'what-cursor-position cmd-what-cursor-position) + (register-command! 'count-words-region cmd-count-words-region) + (register-command! 'count-lines-region cmd-count-lines-region) )