Round 22: Add 20 new Emacs features
ober
5862ba852c05eda73ce261cddb5b7608d6cb5537
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1546,6 +1546,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | Make directory | :orange_circle: | Create a new directory | | Delete directory | :orange_circle: | Delete a directory recursively | | Copy directory | :orange_circle: | Copy a directory recursively | +| Abbrev mode | :orange_circle: | Toggle abbreviation expansion | +| Expand abbrev | :orange_circle: | Expand abbreviation at point | +| Define abbrev | :orange_circle: | Define a new abbreviation | +| List abbrevs | :orange_circle: | List all defined abbreviations | +| Insert register | :orange_circle: | Insert text from named register | +| Copy to register | :orange_circle: | Store region in named register | +| Point to register | :orange_circle: | Save cursor position to register | +| Jump to register | :orange_circle: | Jump to saved position in register | +| View register | :orange_circle: | Show contents of a register | +| List registers | :orange_circle: | List all registers and contents | +| Append to buffer | :orange_circle: | Append region to another buffer | +| Prepend to buffer | :orange_circle: | Prepend region to another buffer | +| Copy to buffer | :orange_circle: | Replace buffer contents with region | +| Insert buffer | :orange_circle: | Insert another buffer at point | +| Append to file | :orange_circle: | Append region to a file | +| Write region | :orange_circle: | Write region to a file | +| Print buffer | :orange_circle: | Send buffer to printer via lpr | +| 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 | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -7885,3 +7885,191 @@ (let ((out (get-string-all so))) (close-port so) (close-port se) (echo-message! echo (str "Copied " src " to " dst)))))))))))) + +;; Round 22 batch 2: append-to-buffer, prepend-to-buffer, copy-to-buffer, insert-buffer, +;; append-to-file, write-region, print-buffer, lpr-buffer, flush-lines, keep-lines + +;; cmd-append-to-buffer: Append region to another buffer +(def (cmd-append-to-buffer 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)) + (buffers (app-state-buffers app)) + (buf-names (map buffer-name buffers)) + (target-name (echo-read-string-with-completion echo "Append to buffer: " buf-names))) + (if (or (not target-name) (string=? target-name "")) + (echo-message! echo "No target buffer") + (let ((target (find (lambda (b) (string=? (buffer-name b) target-name)) buffers))) + (if (not target) + (echo-message! echo (str "Buffer not found: " target-name)) + (let* ((target-ed (buffer-editor target)) + (end-pos (editor-get-length target-ed))) + (editor-insert-text target-ed end-pos text) + (echo-message! echo (str "Appended to " target-name)))))))))) + +;; cmd-prepend-to-buffer: Prepend region to another buffer +(def (cmd-prepend-to-buffer 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)) + (buffers (app-state-buffers app)) + (buf-names (map buffer-name buffers)) + (target-name (echo-read-string-with-completion echo "Prepend to buffer: " buf-names))) + (if (or (not target-name) (string=? target-name "")) + (echo-message! echo "No target buffer") + (let ((target (find (lambda (b) (string=? (buffer-name b) target-name)) buffers))) + (if (not target) + (echo-message! echo (str "Buffer not found: " target-name)) + (let ((target-ed (buffer-editor target))) + (editor-insert-text target-ed 0 text) + (echo-message! echo (str "Prepended to " target-name)))))))))) + +;; cmd-copy-to-buffer: Replace target buffer contents with region +(def (cmd-copy-to-buffer 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)) + (buffers (app-state-buffers app)) + (buf-names (map buffer-name buffers)) + (target-name (echo-read-string-with-completion echo "Copy to buffer: " buf-names))) + (if (or (not target-name) (string=? target-name "")) + (echo-message! echo "No target buffer") + (let ((target (find (lambda (b) (string=? (buffer-name b) target-name)) buffers))) + (if (not target) + (echo-message! echo (str "Buffer not found: " target-name)) + (let ((target-ed (buffer-editor target))) + (editor-set-text target-ed text) + (echo-message! echo (str "Copied to " target-name)))))))))) + +;; cmd-insert-buffer: Insert contents of another buffer at point +(def (cmd-insert-buffer app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (buf-names (map buffer-name buffers)) + (source-name (echo-read-string-with-completion echo "Insert buffer: " buf-names))) + (if (or (not source-name) (string=? source-name "")) + (echo-message! echo "No buffer specified") + (let ((source (find (lambda (b) (string=? (buffer-name b) source-name)) buffers))) + (if (not source) + (echo-message! echo (str "Buffer not found: " source-name)) + (let* ((source-ed (buffer-editor source)) + (text (editor-get-text source-ed)) + (pos (editor-cursor-position ed))) + (editor-insert-text ed pos text) + (echo-message! echo (str "Inserted buffer " source-name)))))))) + +;; cmd-append-to-file: Append region to a file +(def (cmd-append-to-file 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)) + (file (echo-read-string echo "Append to file: "))) + (if (or (not file) (string=? file "")) + (echo-message! echo "No file specified") + (with-catch + (lambda (e) (echo-message! echo (str "Error: " e))) + (lambda () + (let ((port (open-file-output-port file + (file-options no-fail no-truncate) + (buffer-mode block) + (native-transcoder)))) + (set-port-position! port (port-length port)) + (put-string port text) + (close-port port) + (echo-message! echo (str "Appended to " file)))))))))) + +;; cmd-write-region: Write region to a file +(def (cmd-write-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)) + (file (echo-read-string echo "Write region to file: "))) + (if (or (not file) (string=? file "")) + (echo-message! echo "No file specified") + (with-catch + (lambda (e) (echo-message! echo (str "Error: " e))) + (lambda () + (write-file-string file text) + (echo-message! echo (str "Region written to " file))))))))) + +;; cmd-print-buffer: Print buffer contents via lpr +(def (cmd-print-buffer app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text (editor-get-text ed)) + (tmp-file (str "/tmp/jemacs-print-" (time-second (current-time)) ".txt"))) + (write-file-string tmp-file text) + (with-catch + (lambda (e) (echo-message! echo (str "Print error: " e))) + (lambda () + (let-values (((si so se pid) + (open-process-ports (str "lpr " (shell-quote tmp-file)) + 'block (native-transcoder)))) + (close-port si) + (let ((out (get-string-all so))) + (close-port so) (close-port se) + (echo-message! echo "Buffer sent to printer"))))))) + +;; cmd-lpr-buffer: Same as print-buffer (lpr alias) +(def (cmd-lpr-buffer app) + (cmd-print-buffer app)) + +;; cmd-flush-lines: Delete lines matching a regexp +(def (cmd-flush-lines app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pattern (echo-read-string echo "Flush 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 "Flushed " removed " lines matching \"" pattern "\"")))))) + +;; cmd-keep-lines: Keep only lines matching a regexp +(def (cmd-keep-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) " lines matching \"" pattern "\" (removed " removed ")")))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -8328,3 +8328,184 @@ (fill ws "" (cons line lines))) (fill (cdr ws) new-line lines))))))))) +;; Round 22 batch 1: abbrev-mode, expand-abbrev, define-abbrev, list-abbrevs, +;; insert-register, copy-to-register, point-to-register, jump-to-register, +;; view-register, list-registers + +;; cmd-abbrev-mode: Toggle abbreviation expansion mode +(def (cmd-abbrev-mode app) + (let* ((echo (app-state-echo app))) + (toggle-mode! app 'abbrev-mode) + (if (mode-enabled? app 'abbrev-mode) + (echo-message! echo "Abbrev mode enabled") + (echo-message! echo "Abbrev mode disabled")))) + +;; cmd-expand-abbrev: Expand abbreviation at point +(def (cmd-expand-abbrev app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (pos (editor-cursor-position ed)) + ;; Get word before cursor + (line-start (editor-line-start ed (editor-current-line ed))) + (before-text (editor-get-text-range ed line-start pos))) + ;; Find last word + (let loop ((i (- (string-length before-text) 1)) (end (string-length before-text))) + (if (or (< i 0) (char-whitespace? (string-ref before-text i))) + (let* ((word (substring before-text (+ i 1) end)) + (abbrevs (or (hash-get (app-state-modes app) 'abbrev-table) (make-hash-table))) + (expansion (hash-get abbrevs word))) + (if expansion + (begin + (editor-replace-range ed (+ line-start i 1) pos expansion) + (echo-message! echo (str "Expanded \"" word "\" to \"" expansion "\""))) + (echo-message! echo (str "No abbrev for \"" word "\"")))) + (loop (- i 1) end))))) + +;; cmd-define-abbrev: Define a new abbreviation +(def (cmd-define-abbrev app) + (let* ((echo (app-state-echo app)) + (abbrev (echo-read-string echo "Abbrev: "))) + (if (or (not abbrev) (string=? abbrev "")) + (echo-message! echo "No abbreviation specified") + (let ((expansion (echo-read-string echo (str "Expansion for \"" abbrev "\": ")))) + (if (or (not expansion) (string=? expansion "")) + (echo-message! echo "No expansion specified") + (let ((table (or (hash-get (app-state-modes app) 'abbrev-table) (make-hash-table)))) + (hash-put! table abbrev expansion) + (hash-put! (app-state-modes app) 'abbrev-table table) + (echo-message! echo (str "Defined abbrev: \"" abbrev "\" → \"" expansion "\"")))))))) + +;; cmd-list-abbrevs: List all defined abbreviations +(def (cmd-list-abbrevs app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (table (or (hash-get (app-state-modes app) 'abbrev-table) (make-hash-table))) + (entries (hash->list table)) + (text (if (null? entries) + "=== Abbreviations ===\n\nNo abbreviations defined.\nUse M-x define-abbrev to add one.\n" + (str "=== Abbreviations ===\n\n" + (string-join + (map (lambda (pair) + (str " " (car pair) " → " (cdr pair))) + entries) + "\n") + "\n\nTotal: " (length entries) " abbreviations\n")))) + (editor-set-text ed text) + (echo-message! echo (str (length entries) " abbreviations")))) + +;; cmd-copy-to-register: Store region text in a named register +(def (cmd-copy-to-register 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 ((reg-name (echo-read-string echo "Register name (single char): "))) + (if (or (not reg-name) (string=? reg-name "")) + (echo-message! echo "No register specified") + (let* ((text (editor-get-text-range ed sel-start sel-end)) + (registers (or (hash-get (app-state-modes app) 'text-registers) (make-hash-table)))) + (hash-put! registers reg-name text) + (hash-put! (app-state-modes app) 'text-registers registers) + (echo-message! echo (str "Copied to register " reg-name)))))))) + +;; cmd-insert-register: Insert text from a named register +(def (cmd-insert-register app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (reg-name (echo-read-string echo "Insert register: "))) + (if (or (not reg-name) (string=? reg-name "")) + (echo-message! echo "No register specified") + (let* ((registers (or (hash-get (app-state-modes app) 'text-registers) (make-hash-table))) + (text (hash-get registers reg-name))) + (if text + (begin + (editor-insert-text ed (editor-cursor-position ed) text) + (echo-message! echo (str "Inserted register " reg-name))) + (echo-message! echo (str "Register " reg-name " is empty"))))))) + +;; cmd-point-to-register: Save current position to a register +(def (cmd-point-to-register app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (reg-name (echo-read-string echo "Point to register: "))) + (if (or (not reg-name) (string=? reg-name "")) + (echo-message! echo "No register specified") + (let ((registers (or (hash-get (app-state-modes app) 'point-registers) (make-hash-table))) + (pos (editor-cursor-position ed)) + (file (buffer-file buf))) + (hash-put! registers reg-name (cons (or file (buffer-name buf)) pos)) + (hash-put! (app-state-modes app) 'point-registers registers) + (echo-message! echo (str "Point saved to register " reg-name)))))) + +;; cmd-jump-to-register: Jump to position saved in a register +(def (cmd-jump-to-register app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (reg-name (echo-read-string echo "Jump to register: "))) + (if (or (not reg-name) (string=? reg-name "")) + (echo-message! echo "No register specified") + (let* ((registers (or (hash-get (app-state-modes app) 'point-registers) (make-hash-table))) + (entry (hash-get registers reg-name))) + (if entry + (begin + (editor-set-cursor ed (cdr entry)) + (echo-message! echo (str "Jumped to register " reg-name " (pos " (cdr entry) ")"))) + (echo-message! echo (str "Register " reg-name " has no position"))))))) + +;; cmd-view-register: Show contents of a register +(def (cmd-view-register app) + (let* ((echo (app-state-echo app)) + (reg-name (echo-read-string echo "View register: "))) + (if (or (not reg-name) (string=? reg-name "")) + (echo-message! echo "No register specified") + (let* ((text-regs (or (hash-get (app-state-modes app) 'text-registers) (make-hash-table))) + (point-regs (or (hash-get (app-state-modes app) 'point-registers) (make-hash-table))) + (text (hash-get text-regs reg-name)) + (point (hash-get point-regs reg-name))) + (cond + ((and text point) + (echo-message! echo (str "Register " reg-name ": text=\"" (if (> (string-length text) 40) (str (substring text 0 40) "...") text) "\" + point=" (cdr point)))) + (text + (echo-message! echo (str "Register " reg-name ": \"" (if (> (string-length text) 60) (str (substring text 0 60) "...") text) "\""))) + (point + (echo-message! echo (str "Register " reg-name ": position " (cdr point) " in " (car point)))) + (else + (echo-message! echo (str "Register " reg-name " is empty")))))))) + +;; cmd-list-registers: List all registers and their contents +(def (cmd-list-registers app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (text-regs (or (hash-get (app-state-modes app) 'text-registers) (make-hash-table))) + (point-regs (or (hash-get (app-state-modes app) 'point-registers) (make-hash-table))) + (text-entries (hash->list text-regs)) + (point-entries (hash->list point-regs)) + (output (str "=== Registers ===\n\n" + "--- Text Registers ---\n" + (if (null? text-entries) " (none)\n" + (string-join + (map (lambda (pair) + (let ((val (cdr pair))) + (str " " (car pair) ": \"" (if (> (string-length val) 60) (str (substring val 0 60) "...") val) "\""))) + text-entries) + "\n")) + "\n\n--- Point Registers ---\n" + (if (null? point-entries) " (none)\n" + (string-join + (map (lambda (pair) + (str " " (car pair) ": position " (cddr pair) " in " (cadr pair))) + point-entries) + "\n")) + "\n"))) + (editor-set-text ed output) + (echo-message! echo (str (+ (length text-entries) (length point-entries)) " registers")))) + --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1901,4 +1901,26 @@ (register-command! 'make-directory cmd-make-directory) (register-command! 'delete-directory cmd-delete-directory) (register-command! 'copy-directory cmd-copy-directory) + ;; Round 22 batch 1: abbrev-mode, expand-abbrev, define-abbrev, list-abbrevs, insert-register, copy-to-register, point-to-register, jump-to-register, view-register, list-registers + (register-command! 'abbrev-mode cmd-abbrev-mode) + (register-command! 'expand-abbrev cmd-expand-abbrev) + (register-command! 'define-abbrev cmd-define-abbrev) + (register-command! 'list-abbrevs cmd-list-abbrevs) + (register-command! 'insert-register cmd-insert-register) + (register-command! 'copy-to-register cmd-copy-to-register) + (register-command! 'point-to-register cmd-point-to-register) + (register-command! 'jump-to-register cmd-jump-to-register) + (register-command! 'view-register cmd-view-register) + (register-command! 'list-registers cmd-list-registers) + ;; Round 22 batch 2: append-to-buffer, prepend-to-buffer, copy-to-buffer, insert-buffer, append-to-file, write-region, print-buffer, lpr-buffer, flush-lines, keep-lines + (register-command! 'append-to-buffer cmd-append-to-buffer) + (register-command! 'prepend-to-buffer cmd-prepend-to-buffer) + (register-command! 'copy-to-buffer cmd-copy-to-buffer) + (register-command! 'insert-buffer cmd-insert-buffer) + (register-command! 'append-to-file cmd-append-to-file) + (register-command! 'write-region cmd-write-region) + (register-command! 'print-buffer cmd-print-buffer) + (register-command! 'lpr-buffer cmd-lpr-buffer) + (register-command! 'flush-lines cmd-flush-lines) + (register-command! 'keep-lines cmd-keep-lines) )