misc-deps
/
racket-ansi
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

save-buffer

This commit is contained in:
Tony Garnock-Jones 2014-12-28 12:21:58 -05:00
parent 0882ddb896
commit a99eed55a4
5 changed files with 79 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
rmacs/buffer.rkt
View File

@ -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)

4
rmacs/editor.rkt
View File

@ -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)

37
rmacs/file.rkt Normal file
View File

@ -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))))

4
rmacs/mode/fundamental.rkt
View File

@ -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))

8
rmacs/render.rkt
View File

@ -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)