Round 21: Add 20 new Emacs features
ober
5c022c5057e1f922d346f969b76f0d3e87554c1b
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1526,6 +1526,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | Geiser mode | :orange_circle: | Geiser Scheme interaction reference | | SLY mode | :orange_circle: | SLY Common Lisp IDE reference | | SLIME mode | :orange_circle: | SLIME Common Lisp IDE reference | +| Auto-fill mode | :orange_circle: | Toggle auto line wrapping at fill column | +| Display line numbers mode | :orange_circle: | Toggle line number margin | +| Visual line mode | :orange_circle: | Toggle word wrap display | +| Whitespace cleanup | :orange_circle: | Remove trailing whitespace | +| Indent rigidly | :orange_circle: | Indent/dedent region by N spaces | +| Align regexp | :orange_circle: | Align region on a pattern | +| Comment DWIM | :orange_circle: | Smart comment/uncomment line or region | +| Uncomment region | :orange_circle: | Remove comment markers from region | +| Toggle comment | :orange_circle: | Toggle comment on line/region | +| Fill paragraph | :orange_circle: | Wrap paragraph to fill column | +| Fill region | :orange_circle: | Wrap all paragraphs in region | +| Justify paragraph | :orange_circle: | Right-justify paragraph text | +| Center line | :orange_circle: | Center current line in fill column | +| Set fill column | :orange_circle: | Set the fill column width | +| Auto-revert mode | :orange_circle: | Toggle auto-refresh from disk | +| Revert buffer quick | :orange_circle: | Reload buffer from disk without confirm | +| Rename visited file | :orange_circle: | Rename file and update buffer | +| Make directory | :orange_circle: | Create a new directory | +| Delete directory | :orange_circle: | Delete a directory recursively | +| Copy directory | :orange_circle: | Copy a directory recursively | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -7683,3 +7683,205 @@ "jemacs equivalent: M-x eval-expression, M-x eval-buffer\n"))) (editor-set-text ed text) (echo-message! echo "SLIME mode reference loaded"))) + +;; Round 21 batch 2: fill-region, justify-paragraph, center-line, set-fill-column, +;; auto-revert-mode, revert-buffer-quick, rename-visited-file, make-directory, +;; delete-directory, copy-directory + +;; cmd-fill-region: Wrap all paragraphs in region to fill column +(def (cmd-fill-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* ((fill-col 80) + (text (editor-get-text-range ed sel-start sel-end)) + (paras (let split-paras ((lines (string-split text #\newline)) (current '()) (result '())) + (if (null? lines) + (reverse (if (null? current) result (cons (reverse current) result))) + (if (string=? (string-trim (car lines)) "") + (split-paras (cdr lines) '() + (if (null? current) result (cons (reverse current) result))) + (split-paras (cdr lines) (cons (car lines) current) result))))) + (filled-paras (map (lambda (para-lines) + (let* ((joined (string-join para-lines " ")) + (words (let split-w ((s (string-trim joined)) (r '())) + (let ((t (string-trim s))) + (if (string=? t "") (reverse r) + (let f ((i 0)) + (if (>= i (string-length t)) + (reverse (cons t r)) + (if (char-whitespace? (string-ref t i)) + (split-w (substring t i (string-length t)) + (cons (substring t 0 i) r)) + (f (+ i 1)))))))))) + (if (null? words) "" + (let fill ((ws words) (line "") (lines '())) + (if (null? ws) + (string-join (reverse (if (string=? line "") lines (cons line lines))) "\n") + (let* ((w (car ws)) + (new-line (if (string=? line "") w (str line " " w)))) + (if (> (string-length new-line) fill-col) + (if (string=? line "") + (fill (cdr ws) "" (cons w lines)) + (fill ws "" (cons line lines))) + (fill (cdr ws) new-line lines)))))))) + paras)) + (result (string-join filled-paras "\n\n"))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo "Region filled"))))) + +;; cmd-justify-paragraph: Right-justify current paragraph +(def (cmd-justify-paragraph app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (fill-col 80) + (cur-line (editor-current-line ed)) + (total-lines (editor-line-count ed)) + (para-start (let loop ((ln cur-line)) + (if (<= ln 0) 0 + (let ((text (editor-get-line ed ln))) + (if (string=? (string-trim text) "") + (+ ln 1) (loop (- ln 1))))))) + (para-end (let loop ((ln cur-line)) + (if (>= ln total-lines) (- total-lines 1) + (let ((text (editor-get-line ed ln))) + (if (string=? (string-trim text) "") + (- ln 1) (loop (+ ln 1))))))) + (start-pos (editor-line-start ed para-start)) + (end-pos (editor-line-end ed para-end)) + (para-text (editor-get-text-range ed start-pos end-pos)) + (lines (string-split para-text #\newline)) + (justified (map (lambda (line) + (let* ((trimmed (string-trim line)) + (pad (max 0 (- fill-col (string-length trimmed))))) + (str (make-string pad #\space) trimmed))) + lines)) + (result (string-join justified "\n"))) + (editor-replace-range ed start-pos end-pos result) + (echo-message! echo "Paragraph right-justified"))) + +;; cmd-center-line: Center the current line within fill column +(def (cmd-center-line app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (fill-col 80) + (cur-line (editor-current-line ed)) + (start-pos (editor-line-start ed cur-line)) + (end-pos (editor-line-end ed cur-line)) + (text (string-trim (editor-get-text-range ed start-pos end-pos))) + (text-len (string-length text)) + (pad (max 0 (quotient (- fill-col text-len) 2))) + (centered (str (make-string pad #\space) text))) + (editor-replace-range ed start-pos end-pos centered) + (echo-message! echo "Line centered"))) + +;; cmd-set-fill-column: Set the fill column width +(def (cmd-set-fill-column app) + (let* ((echo (app-state-echo app)) + (col-str (echo-read-string echo "Set fill column to: "))) + (if (or (not col-str) (string=? col-str "")) + (echo-message! echo "Fill column unchanged") + (let ((col (string->number col-str))) + (if (and col (> col 0)) + (echo-message! echo (str "Fill column set to " col " (note: stored per-session)")) + (echo-message! echo "Invalid column number")))))) + +;; cmd-auto-revert-mode: Toggle auto-revert mode +(def (cmd-auto-revert-mode app) + (let* ((echo (app-state-echo app))) + (toggle-mode! app 'auto-revert-mode) + (if (mode-enabled? app 'auto-revert-mode) + (echo-message! echo "Auto-Revert mode enabled (buffer will auto-refresh from disk)") + (echo-message! echo "Auto-Revert mode disabled")))) + +;; cmd-revert-buffer-quick: Reload buffer from disk without confirmation +(def (cmd-revert-buffer-quick app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (file (buffer-file buf))) + (if (not file) + (echo-message! echo "Buffer has no file") + (if (not (file-exists? file)) + (echo-message! echo (str "File not found: " file)) + (let ((content (read-file-string file))) + (editor-set-text ed content) + (echo-message! echo (str "Reverted: " file))))))) + +;; cmd-rename-visited-file: Rename the file visited by current buffer +(def (cmd-rename-visited-file app) + (let* ((buf (app-state-current-buffer app)) + (echo (app-state-echo app)) + (ed (buffer-editor buf)) + (old-file (buffer-file buf))) + (if (not old-file) + (echo-message! echo "Buffer has no file") + (let ((new-name (echo-read-string echo (str "Rename " old-file " to: ")))) + (if (or (not new-name) (string=? new-name "")) + (echo-message! echo "Rename cancelled") + (with-catch + (lambda (e) (echo-message! echo (str "Rename error: " e))) + (lambda () + (rename-file old-file new-name) + (buffer-file-set! buf new-name) + (buffer-name-set! buf (path-strip-directory new-name)) + (echo-message! echo (str "Renamed to " new-name))))))))) + +;; cmd-make-directory: Create a new directory +(def (cmd-make-directory app) + (let* ((echo (app-state-echo app)) + (dir (echo-read-string echo "Make directory: "))) + (if (or (not dir) (string=? dir "")) + (echo-message! echo "No directory specified") + (with-catch + (lambda (e) (echo-message! echo (str "mkdir error: " e))) + (lambda () + (mkdir dir) + (echo-message! echo (str "Created directory: " dir))))))) + +;; cmd-delete-directory: Delete a directory +(def (cmd-delete-directory app) + (let* ((echo (app-state-echo app)) + (dir (echo-read-string echo "Delete directory: "))) + (if (or (not dir) (string=? dir "")) + (echo-message! echo "No directory specified") + (if (not (file-directory? dir)) + (echo-message! echo (str "Not a directory: " dir)) + (with-catch + (lambda (e) (echo-message! echo (str "rmdir error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports (str "rm -rf " (shell-quote dir)) + 'block (native-transcoder)))) + (close-port si) + (let ((out (get-string-all so))) + (close-port so) (close-port se) + (echo-message! echo (str "Deleted directory: " dir)))))))))) + +;; cmd-copy-directory: Copy a directory recursively +(def (cmd-copy-directory app) + (let* ((echo (app-state-echo app)) + (src (echo-read-string echo "Copy directory from: "))) + (if (or (not src) (string=? src "")) + (echo-message! echo "No source specified") + (let ((dst (echo-read-string echo "Copy directory to: "))) + (if (or (not dst) (string=? dst "")) + (echo-message! echo "No destination specified") + (if (not (file-directory? src)) + (echo-message! echo (str "Not a directory: " src)) + (with-catch + (lambda (e) (echo-message! echo (str "Copy error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports (str "cp -r " (shell-quote src) " " (shell-quote dst)) + 'block (native-transcoder)))) + (close-port si) + (let ((out (get-string-all so))) + (close-port so) (close-port se) + (echo-message! echo (str "Copied " src " to " dst)))))))))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -8076,3 +8076,255 @@ (else (echo-message! echo (str "Unknown theme: " theme)))) (send-message ed SCI_STYLECLEARALL 0 0) (echo-message! echo (str "Theme: " theme)))))) + +;; Round 21 batch 1: auto-fill-mode, display-line-numbers-mode, visual-line-mode, +;; whitespace-cleanup, indent-rigidly, align-regexp, comment-dwim, uncomment-region, +;; toggle-comment, fill-paragraph + +;; cmd-auto-fill-mode: Toggle auto-fill mode (wrap lines at fill column) +(def (cmd-auto-fill-mode app) + (let* ((echo (app-state-echo app))) + (toggle-mode! app 'auto-fill-mode) + (if (mode-enabled? app 'auto-fill-mode) + (echo-message! echo "Auto-Fill mode enabled (fill column: 80)") + (echo-message! echo "Auto-Fill mode disabled")))) + +;; cmd-display-line-numbers-mode: Toggle line number display +(def (cmd-display-line-numbers-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app))) + (toggle-mode! app 'display-line-numbers-mode) + (if (mode-enabled? app 'display-line-numbers-mode) + (begin + (send-message ed SCI_SETMARGINWIDTHN 0 48) + (echo-message! echo "Line numbers enabled")) + (begin + (send-message ed SCI_SETMARGINWIDTHN 0 0) + (echo-message! echo "Line numbers disabled"))))) + +;; cmd-visual-line-mode: Toggle visual line mode (word wrap) +(def (cmd-visual-line-mode app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app))) + (toggle-mode! app 'visual-line-mode) + (if (mode-enabled? app 'visual-line-mode) + (begin + (send-message ed SCI_SETWRAPMODE 1 0) + (echo-message! echo "Visual line mode enabled (word wrap on)")) + (begin + (send-message ed SCI_SETWRAPMODE 0 0) + (echo-message! echo "Visual line mode disabled (word wrap off)"))))) + +;; cmd-whitespace-cleanup: Remove trailing whitespace and fix indentation +(def (cmd-whitespace-cleanup app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (editor-get-text ed)) + (lines (string-split text #\newline)) + (cleaned (map (lambda (line) + (let loop ((i (- (string-length line) 1))) + (if (< i 0) "" + (let ((c (string-ref line i))) + (if (or (char=? c #\space) (char=? c #\tab)) + (loop (- i 1)) + (substring line 0 (+ i 1))))))) + lines)) + (result (string-join cleaned "\n")) + (diff (- (string-length text) (string-length result)))) + (editor-set-text ed result) + (echo-message! echo (str "Whitespace cleanup: removed " diff " trailing chars")))) + +;; cmd-indent-rigidly: Indent or dedent region by N spaces +(def (cmd-indent-rigidly 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* ((amount-str (echo-read-string echo "Indent amount (negative to dedent): ")) + (amount (if (and amount-str (not (string=? amount-str ""))) + (string->number amount-str) #f))) + (if (not amount) + (echo-message! echo "Invalid number") + (let* ((text (editor-get-text-range ed sel-start sel-end)) + (lines (string-split text #\newline)) + (indented (map (lambda (line) + (if (> amount 0) + (str (make-string amount #\space) line) + (let ((to-remove (min (abs amount) (string-length line)))) + (let check ((i 0)) + (if (or (>= i to-remove) (>= i (string-length line)) + (not (char=? (string-ref line i) #\space))) + (substring line i (string-length line)) + (check (+ i 1))))))) + lines)) + (result (string-join indented "\n"))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo (str "Indented by " amount " spaces")))))))) + +;; cmd-align-regexp: Align region by a regexp pattern +(def (cmd-align-regexp 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* ((pattern (echo-read-string echo "Align regexp: ")) + (text (editor-get-text-range ed sel-start sel-end)) + (lines (string-split text #\newline))) + (if (or (not pattern) (string=? pattern "")) + (echo-message! echo "No pattern specified") + (let* ((positions (map (lambda (line) + (string-contains line pattern)) + lines)) + (max-pos (apply max (map (lambda (p) (if p p 0)) positions))) + (aligned (map (lambda (line pos) + (if pos + (str (substring line 0 pos) + (make-string (- max-pos pos) #\space) + (substring line pos (string-length line))) + line)) + lines positions)) + (result (string-join aligned "\n"))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo (str "Aligned on \"" pattern "\"")))))))) + +;; cmd-comment-dwim: Comment or uncomment region/line intelligently +(def (cmd-comment-dwim 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)) + (has-sel (not (= sel-start sel-end))) + (start (if has-sel sel-start (editor-line-start ed (editor-current-line ed)))) + (end (if has-sel sel-end (editor-line-end ed (editor-current-line ed)))) + (text (editor-get-text-range ed start end)) + (lines (string-split text #\newline)) + (all-commented (every (lambda (line) + (let ((trimmed (string-trim line))) + (or (string=? trimmed "") + (string-prefix? ";;" trimmed) + (string-prefix? "#" trimmed) + (string-prefix? "//" trimmed)))) + lines))) + (if all-commented + ;; Uncomment + (let* ((uncommented (map (lambda (line) + (let ((trimmed (string-trim line))) + (cond + ((string-prefix? ";; " trimmed) + (substring trimmed 3 (string-length trimmed))) + ((string-prefix? ";;" trimmed) + (substring trimmed 2 (string-length trimmed))) + ((string-prefix? "# " trimmed) + (substring trimmed 2 (string-length trimmed))) + ((string-prefix? "// " trimmed) + (substring trimmed 3 (string-length trimmed))) + ((string-prefix? "//" trimmed) + (substring trimmed 2 (string-length trimmed))) + (else line)))) + lines)) + (result (string-join uncommented "\n"))) + (editor-replace-range ed start end result) + (echo-message! echo "Uncommented")) + ;; Comment + (let* ((commented (map (lambda (line) + (if (string=? (string-trim line) "") + line + (str ";; " line))) + lines)) + (result (string-join commented "\n"))) + (editor-replace-range ed start end result) + (echo-message! echo "Commented"))))) + +;; cmd-uncomment-region: Remove comment markers from region +(def (cmd-uncomment-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)) + (uncommented (map (lambda (line) + (let ((trimmed (string-trim line))) + (cond + ((string-prefix? ";; " trimmed) + (substring trimmed 3 (string-length trimmed))) + ((string-prefix? ";;" trimmed) + (substring trimmed 2 (string-length trimmed))) + ((string-prefix? "# " trimmed) + (substring trimmed 2 (string-length trimmed))) + ((string-prefix? "// " trimmed) + (substring trimmed 3 (string-length trimmed))) + ((string-prefix? "//" trimmed) + (substring trimmed 2 (string-length trimmed))) + (else line)))) + lines)) + (result (string-join uncommented "\n"))) + (editor-replace-range ed sel-start sel-end result) + (echo-message! echo "Region uncommented"))))) + +;; cmd-toggle-comment: Toggle comment on current line or region +(def (cmd-toggle-comment app) + (cmd-comment-dwim app)) + +;; cmd-fill-paragraph: Wrap current paragraph to fill column +(def (cmd-fill-paragraph app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (fill-col 80) + (cur-line (editor-current-line ed)) + (total-lines (editor-line-count ed))) + ;; Find paragraph boundaries (blank lines) + (let* ((para-start (let loop ((ln cur-line)) + (if (<= ln 0) 0 + (let ((text (editor-get-line ed ln))) + (if (string=? (string-trim text) "") + (+ ln 1) (loop (- ln 1))))))) + (para-end (let loop ((ln cur-line)) + (if (>= ln total-lines) (- total-lines 1) + (let ((text (editor-get-line ed ln))) + (if (string=? (string-trim text) "") + (- ln 1) (loop (+ ln 1))))))) + (start-pos (editor-line-start ed para-start)) + (end-pos (editor-line-end ed para-end)) + (para-text (editor-get-text-range ed start-pos end-pos)) + ;; Join all lines and split into words + (words (let split-words ((s (string-trim para-text)) (result '())) + (let ((trimmed (string-trim s))) + (if (string=? trimmed "") (reverse result) + (let find-space ((i 0)) + (if (>= i (string-length trimmed)) + (reverse (cons trimmed result)) + (if (char-whitespace? (string-ref trimmed i)) + (split-words (substring trimmed i (string-length trimmed)) + (cons (substring trimmed 0 i) result)) + (find-space (+ i 1)))))))))) + (if (null? words) + (echo-message! echo "Empty paragraph") + (let fill ((ws words) (line "") (lines '())) + (if (null? ws) + (let* ((all-lines (reverse (if (string=? line "") lines (cons line lines)))) + (result (string-join all-lines "\n"))) + (editor-replace-range ed start-pos end-pos result) + (echo-message! echo (str "Filled paragraph to column " fill-col))) + (let* ((word (car ws)) + (new-line (if (string=? line "") word (str line " " word)))) + (if (> (string-length new-line) fill-col) + (if (string=? line "") + (fill (cdr ws) "" (cons word lines)) + (fill ws "" (cons line lines))) + (fill (cdr ws) new-line lines))))))))) + --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1879,4 +1879,26 @@ (register-command! 'geiser-mode cmd-geiser-mode) (register-command! 'sly-mode cmd-sly-mode) (register-command! 'slime-mode cmd-slime-mode) + ;; Round 21 batch 1: auto-fill-mode, display-line-numbers-mode, visual-line-mode, whitespace-cleanup, indent-rigidly, align-regexp, comment-dwim, uncomment-region, toggle-comment, fill-paragraph + (register-command! 'auto-fill-mode cmd-auto-fill-mode) + (register-command! 'display-line-numbers-mode cmd-display-line-numbers-mode) + (register-command! 'visual-line-mode cmd-visual-line-mode) + (register-command! 'whitespace-cleanup cmd-whitespace-cleanup) + (register-command! 'indent-rigidly cmd-indent-rigidly) + (register-command! 'align-regexp cmd-align-regexp) + (register-command! 'comment-dwim cmd-comment-dwim) + (register-command! 'uncomment-region cmd-uncomment-region) + (register-command! 'toggle-comment cmd-toggle-comment) + (register-command! 'fill-paragraph cmd-fill-paragraph) + ;; Round 21 batch 2: fill-region, justify-paragraph, center-line, set-fill-column, auto-revert-mode, revert-buffer-quick, rename-visited-file, make-directory, delete-directory, copy-directory + (register-command! 'fill-region cmd-fill-region) + (register-command! 'justify-paragraph cmd-justify-paragraph) + (register-command! 'center-line cmd-center-line) + (register-command! 'set-fill-column cmd-set-fill-column) + (register-command! 'auto-revert-mode cmd-auto-revert-mode) + (register-command! 'revert-buffer-quick cmd-revert-buffer-quick) + (register-command! 'rename-visited-file cmd-rename-visited-file) + (register-command! 'make-directory cmd-make-directory) + (register-command! 'delete-directory cmd-delete-directory) + (register-command! 'copy-directory cmd-copy-directory) )