edward

  1;;>| Buffer Interface
  2;;>
  3;;> Procedures for creating new buffers and related accessors.
  4
  5(define-record-type Line-Buffer
  6  (%make-buffer lines undo? undo-stack)
  7  line-buffer?
  8  (lines buffer-lines)
  9  (undo? buffer-undo? buffer-undo-set!)
 10  (undo-stack buffer-undo-stack buffer-undo-stack-set!))
 11
 12;;> Create a new, initially empty, line buffer.
 13
 14(define (make-buffer)
 15  (%make-buffer (flexvector) #f (make-stack)))
 16
 17;;> Returns the element at `index` in the `buffer`, starting at zero.
 18
 19(define (buffer-ref buffer index)
 20  (flexvector-ref (buffer-lines buffer) index))
 21
 22;;> Convert the line buffer to a list of lines. Additionally, this
 23;;> procedure accepts an optional `start` and `end` parameter. If
 24;;> these parameters are given the list only contains the elements
 25;;> between `start` and `end`. By default the whole buffer is converted.
 26
 27(define (buffer->list buffer . o)
 28  (apply flexvector->list (buffer-lines buffer) o))
 29
 30;;> Length of the buffer, i.e. amount of lines currently stored in it.
 31
 32(define (buffer-length buffer)
 33  (flexvector-length (buffer-lines buffer)))
 34
 35;;> Predicate which returns true if the buffer is empty.
 36
 37(define (buffer-empty? buffer)
 38  (zero? (buffer-length buffer)))
 39
 40(define (buffer-register-undo buffer proc)
 41  (when (buffer-undo? buffer)
 42    (stack-push (buffer-undo-stack buffer) proc)))
 43
 44;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 45
 46;;>| Undo Stack
 47;;>
 48;;> Procedures for managing the undo stack of the line buffer.
 49;;> The undo stack does not support multilevel undo.
 50;;> That is, the last undo can itself be undone using [buffer-undo!](#buffer-undo!).
 51
 52;;> Execute the given `thunk` and make all `buffer` operations performed
 53;;> in thunk undoable.
 54
 55(define (buffer-with-undo buffer thunk)
 56  (stack-clear! (buffer-undo-stack buffer)) ;; no multi-level undo
 57  (buffer-undo-set! buffer #t)
 58
 59  (guard
 60    (eobj
 61      (else
 62        (buffer-undo-set! buffer #f)
 63        (raise eobj)))
 64    (let ((r (thunk)))
 65      (buffer-undo-set! buffer #f)
 66      r)))
 67
 68;;> Predicate to check if the undo stack is empty, returns false if it is.
 69
 70(define (buffer-has-undo? buffer)
 71  (not (stack-empty? (buffer-undo-stack buffer))))
 72
 73;;> Revert last operation tracked by [buffer-with-undo](#buffer-with-undo).
 74;;> The undo is itself reversible via [buffer-undo!](#buffer-undo!).
 75
 76(define (buffer-undo! buffer)
 77  (define (%buffer-undo! buffer procs)
 78    (buffer-with-undo buffer
 79      (lambda ()
 80        (for-each (lambda (proc)
 81                    (proc buffer))
 82                  procs))))
 83
 84  (let* ((stk (buffer-undo-stack buffer))
 85         (stksiz (stack-size stk)))
 86    (unless (zero? stksiz)
 87      (let ((procs (stack-pops stk stksiz)))
 88        (%buffer-undo! buffer procs)))))
 89
 90;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 91
 92;;>| Buffer Operations
 93;;>
 94;;> Procedures which modify the buffer content.
 95;;> All operations can be undone using [buffer-undo!](#buffer-undo!).
 96
 97;;> Append the given `text` to the `buffer` after the given `line` number.
 98;;> The special line number 0 can be used here to add lines to the
 99;;> beginning of the buffer.
100
101(define (buffer-append! buffer line text)
102  (flexvector-add-all! (buffer-lines buffer) line text)
103  (buffer-register-undo buffer
104    (lambda (buffer)
105      ;; Will add an undo procedure to the stack, thus making
106      ;; the undo of the append operation itself reversible.
107      (buffer-remove! buffer (inc line) (+ line (length text))))))
108
109;;> Removes all lines within the `buffer` at the given inclusive range
110;;> range between `start` and `end`.
111
112(define (buffer-remove! buffer start end)
113  (let* ((lines (buffer-lines buffer))
114         (sline (max (dec start) 0))
115         (bkvec (flexvector->list lines sline end)))
116    (flexvector-remove-range! (buffer-lines buffer) sline end)
117    (buffer-register-undo buffer
118      (lambda (buffer)
119        ;; Will add an undo procedure to the stack, thus making
120        ;; the undo of the remove operation itself reversible.
121        (buffer-append! buffer sline bkvec)))))
122
123;; The following operations are all implemented in terms of
124;; buffer-append! and buffer-undo! and are therefore reversible.
125
126;;> Replace lines in the inclusive range between `start` and `end`
127;;> with the data given by `text` which must be a list of lines
128;;> (i.e. strings).
129
130(define (buffer-replace! buffer start end text)
131  (let* ((sline (max (dec start) 0))
132         (cap (- (buffer-length buffer) sline)))
133    (buffer-remove! buffer start end)
134    (buffer-append! buffer sline text)))
135
136;;> Join lines in the inclusive range between `start` and `end`
137;;> into a single line by removing all newline characters within
138;;> the specified range.
139
140(define (buffer-join! buffer start end)
141  (let* ((lines  (buffer-lines buffer))
142         (sindex (max (dec start) 0))
143         (joined (apply
144                   string-append
145                   "" (flexvector->list lines sindex end))))
146    (buffer-remove! buffer start end)
147    (buffer-append!
148      buffer
149      sindex
150      (list joined))))
151
152;;> Move lines in the inclusive range between `start` and `end`
153;;> to the destination line number `dest`. The destination *must*
154;;> always be outside the specified inclusive range.
155
156(define (buffer-move! buffer start end dest)
157  ;; Assumption: dest is always outside [start, end].
158  (let* ((lines  (buffer-lines buffer))
159         (sindex (max (dec start) 0))
160         (move   (flexvector->list lines sindex end))
161
162         (remove! (lambda () (buffer-remove! buffer start end)))
163         (append! (lambda () (buffer-append! buffer dest move))))
164    (if (> dest start)
165      (begin (append!) (remove!))
166      (begin (remove!) (append!)))))