Round 25: Add 20 new Emacs features
ober
2dc8ec3bb4a1907102ec7c3059712bccf98570dd
--- a/docs/jemacs-vs-emacs.md +++ b/docs/jemacs-vs-emacs.md @@ -1606,6 +1606,26 @@ No remaining Tier 1 gaps. All core editing, completion, and navigation features | 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 | +| Count lines page | :orange_circle: | Count lines on current page | +| Find file literally | :orange_circle: | Open file without conversions | +| Find file read-only | :orange_circle: | Open file in read-only mode | +| Find alternate file | :orange_circle: | Replace buffer with another file | +| Insert file contents | :orange_circle: | Insert file contents at point | +| Recover this file | :orange_circle: | Recover from auto-save file | +| Auto-save mode | :orange_circle: | Toggle auto-save mode | +| Not modified | :orange_circle: | Clear buffer modified flag | +| Set visited file name | :orange_circle: | Change file associated with buffer | +| Toggle read-only | :orange_circle: | Toggle read-only mode | +| Rename buffer | :orange_circle: | Rename current buffer | +| Clone buffer | :orange_circle: | Create copy of current buffer | +| Clone indirect buffer | :orange_circle: | Create indirect buffer copy | +| Bury buffer | :orange_circle: | Move buffer to end of list | +| Unbury buffer | :orange_circle: | Switch to least recently used buffer | +| Previous buffer | :orange_circle: | Switch to previous buffer | +| Next buffer | :orange_circle: | Switch to next buffer | +| List buffers | :orange_circle: | Show all buffers (C-x C-b) | +| IBuffer | :orange_circle: | Interactive buffer list | +| Display buffer | :orange_circle: | Display buffer in other window | --- --- a/src/jerboa-emacs/editor-extra-final.ss +++ b/src/jerboa-emacs/editor-extra-final.ss @@ -8461,3 +8461,138 @@ (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")))))) + +;; Round 25 batch 2: rename-buffer, clone-buffer, clone-indirect-buffer, bury-buffer, +;; unbury-buffer, previous-buffer, next-buffer, list-buffers, ibuffer, display-buffer + +;; cmd-rename-buffer: Rename current buffer +(def (cmd-rename-buffer app) + (let* ((buf (app-state-current-buffer app)) + (echo (app-state-echo app)) + (new-name (echo-read-string echo (str "Rename buffer (was " (buffer-name buf) "): ")))) + (if (or (not new-name) (string=? new-name "")) + (echo-message! echo "No name specified") + (begin + (buffer-name-set! buf new-name) + (echo-message! echo (str "Buffer renamed to: " new-name)))))) + +;; cmd-clone-buffer: Create a copy of current buffer +(def (cmd-clone-buffer app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (frame (app-state-frame app)) + (text (editor-get-text ed)) + (new-name (str (buffer-name buf) "<clone>")) + (new-buf (create-buffer new-name))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed text)) + (echo-message! echo (str "Cloned to: " new-name)))) + +;; cmd-clone-indirect-buffer: Create an indirect buffer (clone with shared content concept) +(def (cmd-clone-indirect-buffer app) + ;; In our implementation, indirect buffers work the same as clones + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (frame (app-state-frame app)) + (text (editor-get-text ed)) + (new-name (str (buffer-name buf) "<indirect>")) + (new-buf (create-buffer new-name))) + (switch-to-buffer frame new-buf) + (let ((new-ed (edit-window-editor (current-window frame)))) + (editor-set-text new-ed text)) + (echo-message! echo (str "Indirect buffer: " new-name)))) + +;; cmd-bury-buffer: Move current buffer to end of buffer list +(def (cmd-bury-buffer app) + (let* ((buf (app-state-current-buffer app)) + (echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (frame (app-state-frame app))) + (if (<= (length buffers) 1) + (echo-message! echo "Only one buffer") + (let* ((rest (filter (lambda (b) (not (eq? b buf))) buffers)) + (new-list (append rest (list buf)))) + (app-state-buffers-set! app new-list) + (switch-to-buffer frame (car rest)) + (echo-message! echo (str "Buried: " (buffer-name buf))))))) + +;; cmd-unbury-buffer: Switch to the least recently used buffer +(def (cmd-unbury-buffer app) + (let* ((echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (frame (app-state-frame app))) + (if (<= (length buffers) 1) + (echo-message! echo "Only one buffer") + (let ((last-buf (list-ref buffers (- (length buffers) 1)))) + (switch-to-buffer frame last-buf) + (echo-message! echo (str "Unburied: " (buffer-name last-buf))))))) + +;; cmd-previous-buffer: Switch to previous buffer in list +(def (cmd-previous-buffer app) + (let* ((buf (app-state-current-buffer app)) + (echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (frame (app-state-frame app)) + (idx (let loop ((bs buffers) (i 0)) + (if (null? bs) 0 + (if (eq? (car bs) buf) i + (loop (cdr bs) (+ i 1)))))) + (prev-idx (if (= idx 0) (- (length buffers) 1) (- idx 1))) + (prev-buf (list-ref buffers prev-idx))) + (switch-to-buffer frame prev-buf) + (echo-message! echo (str "Buffer: " (buffer-name prev-buf))))) + +;; cmd-next-buffer: Switch to next buffer in list +(def (cmd-next-buffer app) + (let* ((buf (app-state-current-buffer app)) + (echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (frame (app-state-frame app)) + (idx (let loop ((bs buffers) (i 0)) + (if (null? bs) 0 + (if (eq? (car bs) buf) i + (loop (cdr bs) (+ i 1)))))) + (next-idx (if (>= (+ idx 1) (length buffers)) 0 (+ idx 1))) + (next-buf (list-ref buffers next-idx))) + (switch-to-buffer frame next-buf) + (echo-message! echo (str "Buffer: " (buffer-name next-buf))))) + +;; cmd-list-buffers: Show list of all buffers (C-x C-b) +(def (cmd-list-buffers app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (lines (map (lambda (b) + (let* ((name (buffer-name b)) + (file (or (buffer-file b) "(no file)")) + (current (if (eq? b buf) " * " " "))) + (str current name " " file))) + buffers)) + (text (str "=== Buffer List ===\n\n" + " Name File\n" + " ---- ----\n" + (string-join lines "\n") + "\n\n" (length buffers) " buffers\n"))) + (editor-set-text ed text) + (echo-message! echo (str (length buffers) " buffers")))) + +;; cmd-ibuffer: Interactive buffer list (same as list-buffers for now) +(def (cmd-ibuffer app) + (cmd-list-buffers app)) + +;; cmd-display-buffer: Display a buffer in another window without switching +(def (cmd-display-buffer app) + (let* ((echo (app-state-echo app)) + (buffers (app-state-buffers app)) + (buf-names (map buffer-name buffers)) + (target-name (echo-read-string-with-completion echo "Display buffer: " buf-names))) + (if (or (not target-name) (string=? target-name "")) + (echo-message! echo "No buffer specified") + (let ((target (find (lambda (b) (string=? (buffer-name b) target-name)) buffers))) + (if (not target) + (echo-message! echo (str "Buffer not found: " target-name)) + (echo-message! echo (str "Display buffer: " target-name " (use C-x 2 then switch)"))))))) --- a/src/jerboa-emacs/editor-extra-modes.ss +++ b/src/jerboa-emacs/editor-extra-modes.ss @@ -8919,3 +8919,154 @@ (editor-set-selection ed 0 len) (echo-message! echo "Whole buffer marked"))) +;; Round 25 batch 1: count-lines-page, find-file-literally, find-file-read-only, +;; find-alternate-file, insert-file-contents, recover-this-file, auto-save-mode, +;; not-modified, set-visited-file-name, toggle-read-only + +;; cmd-count-lines-page: Count lines on current page +(def (cmd-count-lines-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)) + (lines (+ 1 (let loop ((i 0) (n 0)) + (if (>= i (string-length page-text)) n + (loop (+ i 1) + (if (char=? (string-ref page-text i) #\newline) (+ n 1) n))))))) + (echo-message! echo (str "Page has " lines " lines")))) + +;; cmd-find-file-literally: Open file without any conversions +(def (cmd-find-file-literally app) + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (file (echo-read-string echo "Find file literally: "))) + (if (or (not file) (string=? file "")) + (echo-message! echo "No file specified") + (if (not (file-exists? file)) + (echo-message! echo (str "File not found: " file)) + (let* ((content (read-file-string file)) + (new-buf (create-buffer (path-strip-directory file)))) + (buffer-file-set! new-buf file) + (switch-to-buffer frame new-buf) + (let ((ed (edit-window-editor (current-window frame)))) + (editor-set-text ed content)) + (echo-message! echo (str "Literally: " file))))))) + +;; cmd-find-file-read-only: Open file in read-only mode +(def (cmd-find-file-read-only app) + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (file (echo-read-string echo "Find file read-only: "))) + (if (or (not file) (string=? file "")) + (echo-message! echo "No file specified") + (if (not (file-exists? file)) + (echo-message! echo (str "File not found: " file)) + (let* ((content (read-file-string file)) + (new-buf (create-buffer (str (path-strip-directory file) " [RO]")))) + (buffer-file-set! new-buf file) + (switch-to-buffer frame new-buf) + (let ((ed (edit-window-editor (current-window frame)))) + (editor-set-text ed content) + (send-message ed SCI_SETREADONLY 1 0)) + (echo-message! echo (str "Read-only: " file))))))) + +;; cmd-find-alternate-file: Replace current buffer with another file +(def (cmd-find-alternate-file app) + (let* ((echo (app-state-echo app)) + (frame (app-state-frame app)) + (buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (file (echo-read-string echo "Find alternate file: "))) + (if (or (not file) (string=? file "")) + (echo-message! echo "No file specified") + (if (not (file-exists? file)) + (echo-message! echo (str "File not found: " file)) + (let ((content (read-file-string file))) + (buffer-file-set! buf file) + (buffer-name-set! buf (path-strip-directory file)) + (editor-set-text ed content) + (echo-message! echo (str "Alternate: " file))))))) + +;; cmd-insert-file-contents: Insert file contents at point +(def (cmd-insert-file-contents app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (file (echo-read-string echo "Insert file: "))) + (if (or (not file) (string=? file "")) + (echo-message! echo "No file specified") + (if (not (file-exists? file)) + (echo-message! echo (str "File not found: " file)) + (let* ((content (read-file-string file)) + (pos (editor-cursor-position ed))) + (editor-insert-text ed pos content) + (echo-message! echo (str "Inserted " (string-length content) " chars from " file))))))) + +;; cmd-recover-this-file: Recover current file from auto-save +(def (cmd-recover-this-file 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") + (let ((auto-save (str (path-directory file) "/#" (path-strip-directory file) "#"))) + (if (not (file-exists? auto-save)) + (echo-message! echo (str "No auto-save file: " auto-save)) + (let ((content (read-file-string auto-save))) + (editor-set-text ed content) + (echo-message! echo (str "Recovered from " auto-save)))))))) + +;; cmd-auto-save-mode: Toggle auto-save mode +(def (cmd-auto-save-mode app) + (let* ((echo (app-state-echo app))) + (toggle-mode! app 'auto-save-mode) + (if (mode-enabled? app 'auto-save-mode) + (echo-message! echo "Auto-save mode enabled") + (echo-message! echo "Auto-save mode disabled")))) + +;; cmd-not-modified: Clear the modified flag on current buffer +(def (cmd-not-modified app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app))) + (send-message ed SCI_SETSAVEPOINT 0 0) + (echo-message! echo "Buffer marked as not modified"))) + +;; cmd-set-visited-file-name: Change the file associated with buffer +(def (cmd-set-visited-file-name app) + (let* ((buf (app-state-current-buffer app)) + (echo (app-state-echo app)) + (new-file (echo-read-string echo "Set visited file name: "))) + (if (or (not new-file) (string=? new-file "")) + (echo-message! echo "No file specified") + (begin + (buffer-file-set! buf new-file) + (buffer-name-set! buf (path-strip-directory new-file)) + (echo-message! echo (str "Visited file: " new-file)))))) + +;; cmd-toggle-read-only: Toggle read-only mode on buffer +(def (cmd-toggle-read-only app) + (let* ((buf (app-state-current-buffer app)) + (ed (buffer-editor buf)) + (echo (app-state-echo app)) + (readonly (= (send-message ed SCI_GETREADONLY 0 0) 1))) + (if readonly + (begin + (send-message ed SCI_SETREADONLY 0 0) + (echo-message! echo "Read-only mode disabled")) + (begin + (send-message ed SCI_SETREADONLY 1 0) + (echo-message! echo "Read-only mode enabled"))))) + --- a/src/jerboa-emacs/editor-extra-regs2.ss +++ b/src/jerboa-emacs/editor-extra-regs2.ss @@ -1967,4 +1967,26 @@ (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) + ;; Round 25 batch 1 + (register-command! 'count-lines-page cmd-count-lines-page) + (register-command! 'find-file-literally cmd-find-file-literally) + (register-command! 'find-file-read-only cmd-find-file-read-only) + (register-command! 'find-alternate-file cmd-find-alternate-file) + (register-command! 'insert-file-contents cmd-insert-file-contents) + (register-command! 'recover-this-file cmd-recover-this-file) + (register-command! 'auto-save-mode cmd-auto-save-mode) + (register-command! 'not-modified cmd-not-modified) + (register-command! 'set-visited-file-name cmd-set-visited-file-name) + (register-command! 'toggle-read-only cmd-toggle-read-only) + ;; Round 25 batch 2 + (register-command! 'rename-buffer cmd-rename-buffer) + (register-command! 'clone-buffer cmd-clone-buffer) + (register-command! 'clone-indirect-buffer cmd-clone-indirect-buffer) + (register-command! 'bury-buffer cmd-bury-buffer) + (register-command! 'unbury-buffer cmd-unbury-buffer) + (register-command! 'previous-buffer cmd-previous-buffer) + (register-command! 'next-buffer cmd-next-buffer) + (register-command! 'list-buffers cmd-list-buffers) + (register-command! 'ibuffer cmd-ibuffer) + (register-command! 'display-buffer cmd-display-buffer) )