diff --git a/rmacs/buffer.rkt b/rmacs/buffer.rkt index 2ad8a1a..4e24bfe 100644 --- a/rmacs/buffer.rkt +++ b/rmacs/buffer.rkt @@ -8,14 +8,19 @@ register-buffer! lookup-buffer unused-buffer-title - file->buffer + load-buffer + revert-buffer! + save-buffer! buffer-rename! buffer-reorder! buffer-next buffer-prev buffer-title + buffer-dirty? + buffer-source buffer-rope buffer-group + mark-buffer-clean! buffer-editor buffer-modeset buffer-string-column-count @@ -71,6 +76,7 @@ (require "circular-list.rkt") (require "mode.rkt") (require "keys.rkt") +(require "file.rkt") (struct buffer-mark-type (kind ;; Symbol window-id ;; Symbol @@ -85,6 +91,8 @@ [title #:mutable] [group #:mutable] ;; (Option BufferGroup) [modeset #:mutable] ;; ModeSet + [dirty? #:mutable] ;; Boolean + [source #:mutable] ;; (Option BufferSource) ) #:prefab) (struct command (selector ;; Symbol @@ -117,7 +125,9 @@ (register-buffer! group (buffer (initial-contents-rope initial-contents) title #f - kernel-modeset))) + kernel-modeset + #f + #f))) (define (register-buffer! group buf) (define old-group (buffer-group buf)) @@ -166,18 +176,21 @@ candidate))) candidate))) -;; (Option Group) Path -> String -(define (filename->unique-buffer-title group filename) - (define pieces (reverse (map path->string (explode-path filename)))) - (if (not group) - (car pieces) - (unused-buffer-title group pieces))) +(define (load-buffer group src) + (define pieces (buffer-source-title-pieces src)) + (define title (if (not group) (car pieces) (unused-buffer-title group pieces))) + (define b (make-buffer group title)) + (set-buffer-source! b src) + (revert-buffer! b) + b) -(define (file->buffer group filename) - (let* ((filename (normalize-path (simplify-path filename))) - (title (filename->unique-buffer-title group filename)) - (b (make-buffer group title))) - (buffer-replace-contents! b (string->rope (file->string filename))))) +(define (revert-buffer! buf) + (buffer-replace-contents! buf (string->rope (buffer-source-read (buffer-source buf)))) + (mark-buffer-clean! buf)) + +(define (save-buffer! buf) + (buffer-source-write (buffer-source buf) (rope->string (buffer-rope buf))) + (mark-buffer-clean! buf)) (define (buffer-rename! b new-title) (if (title-exists-in-group? (buffer-group b) new-title) @@ -199,6 +212,9 @@ (define (buffer-size buf) (rope-size (buffer-rope buf))) +(define (mark-buffer-clean! buf) + (set-buffer-dirty?! buf #f)) + (define (buffer-editor b) (define g (buffer-group b)) (and g (buffergroup-editor g))) @@ -324,12 +340,14 @@ (define new-m (transfer-marks old-m (updater old-m))) (define delta (- (rope-size new-m) (rope-size old-m))) (set-buffer-rope! buf (rope-append (rope-append l new-m) r)) + (set-buffer-dirty?! buf #t) buf) (define (buffer-insert! buf pos-or-mtype content-rope) (define pos (->pos buf pos-or-mtype 'buffer-insert!)) (define-values (l r) (rope-split (buffer-rope buf) pos)) (set-buffer-rope! buf (rope-append (rope-append l content-rope) r)) + (set-buffer-dirty?! buf #t) buf) (define (buffer-replace-contents! buf content-rope) diff --git a/rmacs/editor.rkt b/rmacs/editor.rkt index 01f6c56..9c77871 100644 --- a/rmacs/editor.rkt +++ b/rmacs/editor.rkt @@ -31,6 +31,7 @@ (require "keys.rkt") (require "rope.rkt") (require "circular-list.rkt") +(require "file.rkt") (struct editor (buffers ;; BufferGroup [tty #:mutable] ;; Tty @@ -149,7 +150,8 @@ (define (visit-file! editor filename) (set-window-buffer! (editor-active-window editor) (configure-fresh-buffer! editor - (file->buffer (editor-buffers editor) filename)))) + (load-buffer (editor-buffers editor) + (local-file-buffer-source filename))))) (define (render-editor! editor) (render-windows! (editor-tty editor) diff --git a/rmacs/file.rkt b/rmacs/file.rkt new file mode 100644 index 0000000..adcf2b1 --- /dev/null +++ b/rmacs/file.rkt @@ -0,0 +1,37 @@ +#lang racket/base + +(provide gen:buffer-source + buffer-source-title-pieces + buffer-source-mtime + buffer-source-read + buffer-source-write + + (struct-out local-file-buffer-source) + local-file-buffer-source-path) + +(require racket/generic) +(require (only-in racket/file file->string)) +(require (only-in racket/path normalize-path)) + +(define-generics buffer-source + (buffer-source-title-pieces buffer-source) + (buffer-source-mtime buffer-source) + (buffer-source-read buffer-source) + (buffer-source-write buffer-source content)) + +(struct local-file-buffer-source (filename) + #:transparent + #:methods gen:buffer-source + [(define (buffer-source-title-pieces src) + (reverse (map path->string (explode-path (local-file-buffer-source-path src))))) + (define (buffer-source-mtime src) + (file-or-directory-modify-seconds (local-file-buffer-source-path src))) + (define (buffer-source-read src) + (file->string (local-file-buffer-source-path src))) + (define (buffer-source-write src content) + (call-with-output-file (local-file-buffer-source-path src) + (lambda (p) (write-string content p)) + #:exists 'replace))]) + +(define (local-file-buffer-source-path src) + (normalize-path (simplify-path (local-file-buffer-source-filename src)))) diff --git a/rmacs/mode/fundamental.rkt b/rmacs/mode/fundamental.rkt index 965eda5..62fefc5 100644 --- a/rmacs/mode/fundamental.rkt +++ b/rmacs/mode/fundamental.rkt @@ -137,3 +137,7 @@ #:bind-key "C-tab" #:bind-key "C-x o" (select-window ed (editor-next-window ed win))) + +(define-command fundamental-mode (save-buffer buf) + #:bind-key "C-x C-s" + (save-buffer! buf)) diff --git a/rmacs/render.rkt b/rmacs/render.rkt index c30dcfb..2b24066 100644 --- a/rmacs/render.rkt +++ b/rmacs/render.rkt @@ -121,10 +121,10 @@ (define cursor-coordinates (render-top-spans spans 0 #f)) (tty-statusline-style t is-active?) - (tty-display t "-- " (buffer-title buf) " ") - (let ((remaining-length (- (tty-columns t) 4 (string-length (buffer-title buf))))) - (when (positive? remaining-length) - (tty-display t (make-string remaining-length #\-)))) + (let* ((prefix (format "-:~a- ~a " (if (buffer-dirty? buf) "**" "--") (buffer-title buf))) + (remaining-length (- (tty-columns t) (string-length prefix)))) + (tty-display t prefix) + (when (positive? remaining-length) (tty-display t (make-string remaining-length #\-)))) cursor-coordinates)