[bpt/guile.git] / ice-9 / gap-buffer.scm

;;; gap-buffer.scm --- String buffer that supports point

;;;	Copyright (C) 2002 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this software; see the file COPYING.  If not, write to
;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;; Boston, MA 02111-1307 USA
;;;
;;; As a special exception, the Free Software Foundation gives permission
;;; for additional uses of the text contained in its release of GUILE.
;;;
;;; The exception is that, if you link the GUILE library with other files
;;; to produce an executable, this does not by itself cause the
;;; resulting executable to be covered by the GNU General Public License.
;;; Your use of that executable is in no way restricted on account of
;;; linking the GUILE library code into it.
;;;
;;; This exception does not however invalidate any other reasons why
;;; the executable file might be covered by the GNU General Public License.
;;;
;;; This exception applies only to the code released by the
;;; Free Software Foundation under the name GUILE.  If you copy
;;; code from other Free Software Foundation releases into a copy of
;;; GUILE, as the General Public License permits, the exception does
;;; not apply to the code that you add in this way.  To avoid misleading
;;; anyone as to the status of such modified files, you must delete
;;; this exception notice from them.
;;;
;;; If you write modifications of your own for GUILE, it is your choice
;;; whether to permit this exception to apply to your modifications.
;;; If you do not wish that, delete this exception notice.
;;;

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>

;;; Commentary:

;; A gap buffer is a structure that models a string but allows relatively
;; efficient insertion of text somewhere in the middle.  The insertion
;; location is called `point' with minimum value 1, and a maximum value of the
;; length of the string (which is not fixed).
;;
;; Specifically, we allocate a continuous buffer of characters that is
;; composed of the BEFORE, the GAP and the AFTER (reading L->R), like so:
;;
;;                          +--- POINT
;;                          v
;;    +--------------------+--------------------+--------------------+
;;    |       BEFORE       |        GAP         |       AFTER        |
;;    +--------------------+--------------------+--------------------+
;;
;;     <----- bef-sz ----->|<----- gap-sz ----->|<----- aft-sz ----->
;;
;;     <-------------------|       usr-sz       |------------------->
;;
;;     <-------------------------- all-sz -------------------------->
;;
;; This diagram also shows how the different sizes are computed, and the
;; location of POINT.  Note that the user-visible buffer size `usr-sz' does
;; NOT include the GAP, while the allocation `all-sz' DOES.
;;
;; The consequence of this arrangement is that "moving point" is simply a
;; matter of kicking characters across the GAP, while insertion can be viewed
;; as filling up the gap, increasing `bef-sz' and decreasing `gap-sz'.  When
;; `gap-sz' falls below some threshold, we reallocate with a larger `all-sz'.
;;
;; In the implementation, we actually keep track of the AFTER start offset
;; `aft-ofs' since it is used more often than `gap-sz'.  In fact, most of the
;; variables in the diagram are for conceptualization only.
;;
;; A gap buffer port is a soft port (see Guile manual) that wraps a gap
;; buffer.  Character and string writes, as well as character reads, are
;; supported.  Flushing and closing are not supported.
;;
;; These procedures are exported:
;;   (gb? OBJ)
;;   (make-gap-buffer . INIT)
;;   (gb-point GB)
;;   (gb-point-min GB)
;;   (gb-point-max GB)
;;   (gb-insert-string! GB STRING)
;;   (gb-insert-char! GB CHAR)
;;   (gb-delete-char! GB COUNT)
;;   (gb-goto-char GB LOCATION)
;;   (gb->string GB)
;;   (gb-filter! GB STRING-PROC)
;;   (gb->lines GB)
;;   (gb-filter-lines! GB LINES-PROC)
;;   (make-gap-buffer-port GB)
;;
;; INIT is an optional port or a string.  COUNT and LOCATION are integers.
;; STRING-PROC is a procedure that takes and returns a string.  LINES-PROC is
;; a procedure that takes and returns a list of strings, each representing a
;; line of text (newlines are stripped and added back automatically).
;;
;; (The term and concept of "gap buffer" are borrowed from Emacs.  We will
;; gladly return them when libemacs.so is available. ;-)
;;
;; Notes:
;; - overrun errors are suppressed silently

;;; Code:

(define-module (ice-9 gap-buffer)
  :autoload (srfi srfi-13) (string-join)
  :export (gb?
           make-gap-buffer
           gb-point
           gb-point-min
           gb-point-max
           gb-insert-string!
           gb-insert-char!
           gb-delete-char!
           gb-erase!
           gb-goto-char
           gb->string
           gb-filter!
           gb->lines
           gb-filter-lines!
           make-gap-buffer-port))

(define gap-buffer
  (make-record-type 'gap-buffer
                    '(s                 ; the buffer, a string
                      all-sz            ; total allocation
                      gap-ofs           ; GAP starts, aka (1- point)
                      aft-ofs           ; AFTER starts
                      )))

(define gb? (record-predicate gap-buffer))

(define s:       (record-accessor gap-buffer 's))
(define all-sz:  (record-accessor gap-buffer 'all-sz))
(define gap-ofs: (record-accessor gap-buffer 'gap-ofs))
(define aft-ofs: (record-accessor gap-buffer 'aft-ofs))

(define s!       (record-modifier gap-buffer 's))
(define all-sz!  (record-modifier gap-buffer 'all-sz))
(define gap-ofs! (record-modifier gap-buffer 'gap-ofs))
(define aft-ofs! (record-modifier gap-buffer 'aft-ofs))

;; todo: expose
(define default-initial-allocation 128)
(define default-chunk-size 128)
(define default-realloc-threshold 32)

(define (round-up n)
  (* default-chunk-size (+ 1 (quotient n default-chunk-size))))

(define new (record-constructor gap-buffer '()))

(define (realloc gb inc)
  (let* ((old-s   (s: gb))
         (all-sz  (all-sz: gb))
         (new-sz  (+ all-sz inc))
         (gap-ofs (gap-ofs: gb))
         (aft-ofs (aft-ofs: gb))
         (new-s   (make-string new-sz))
         (new-aft-ofs (+ aft-ofs inc)))
    (substring-move! old-s 0 gap-ofs new-s 0)
    (substring-move! old-s aft-ofs all-sz new-s new-aft-ofs)
    (s! gb new-s)
    (all-sz! gb new-sz)
    (aft-ofs! gb new-aft-ofs)))

(define (make-gap-buffer . init)        ; port/string
  (let ((gb (new)))
    (cond ((null? init)
           (s! gb (make-string default-initial-allocation))
           (all-sz! gb default-initial-allocation)
           (gap-ofs! gb 0)
           (aft-ofs! gb default-initial-allocation))
          (else (let ((jam! (lambda (string len)
                              (let ((alloc (round-up len)))
                                (s! gb (make-string alloc))
                                (all-sz! gb alloc)
                                (substring-move! string 0 len (s: gb) 0)
                                (gap-ofs! gb len)
                                (aft-ofs! gb alloc))))
                      (v (car init)))
                  (cond ((port? v)
                         (let ((next (lambda () (read-char v))))
                           (let loop ((c (next)) (acc '()) (len 0))
                             (if (eof-object? c)
                                 (jam! (list->string (reverse acc)) len)
                                 (loop (next) (cons c acc) (1+ len))))))
                        ((string? v)
                         (jam! v (string-length v)))
                        (else (error "bad init type"))))))
    gb))

(define (gb-point gb)
  (1+ (gap-ofs: gb)))

(define (gb-point-min gb) 1)            ; no narrowing (for now)

(define (gb-point-max gb)
  (1+ (- (all-sz: gb) (- (aft-ofs: gb) (gap-ofs: gb)))))

(define (insert-prep gb len)
  (let* ((gap-ofs (gap-ofs: gb))
         (aft-ofs (aft-ofs: gb))
         (slack (- (- aft-ofs gap-ofs) len)))
    (and (< slack default-realloc-threshold)
         (realloc gb (round-up (- slack))))
    gap-ofs))

(define (gb-insert-string! gb string)
  (let* ((len (string-length string))
         (gap-ofs (insert-prep gb len)))
    (substring-move! string 0 len (s: gb) gap-ofs)
    (gap-ofs! gb (+ gap-ofs len))))

(define (gb-insert-char! gb char)
  (let ((gap-ofs (insert-prep gb 1)))
    (string-set! (s: gb) gap-ofs char)
    (gap-ofs! gb (+ gap-ofs 1))))

(define (gb-delete-char! gb count)
  (cond ((< count 0)                    ; backwards
         (gap-ofs! gb (max 0 (+ (gap-ofs: gb) count))))
        ((> count 0)                    ; forwards
         (aft-ofs! gb (min (all-sz: gb) (+ (aft-ofs: gb) count))))
        ((= count 0)                    ; do nothing
         #t)))

(define (gb-erase! gb)
  (gap-ofs! gb 0)
  (aft-ofs! gb (all-sz: gb)))

(define (point++n! gb n s gap-ofs aft-ofs) ; n>0; warning: reckless
  (substring-move-left! s aft-ofs (+ aft-ofs n) s gap-ofs)
  (gap-ofs! gb (+ gap-ofs n))
  (aft-ofs! gb (+ aft-ofs n)))

(define (point+-n! gb n s gap-ofs aft-ofs) ; n<0; warning: reckless
  (substring-move-right! s (+ gap-ofs n) gap-ofs s (+ aft-ofs n))
  (gap-ofs! gb (+ gap-ofs n))
  (aft-ofs! gb (+ aft-ofs n)))

(define (gb-goto-char gb new-point)
  (let ((pmax (gb-point-max gb)))
    (or (and (< new-point 1)    (gb-goto-char gb 1))
        (and (> new-point pmax) (gb-goto-char gb pmax))
        (let ((delta (- new-point (gb-point gb))))
          (or (= delta 0)
              ((if (< delta 0)
                   point+-n!
                   point++n!)
               gb delta (s: gb) (gap-ofs: gb) (aft-ofs: gb))))))
  new-point)

(define (gb->string gb)
  (let ((s (s: gb)))
    (string-append (substring s 0 (gap-ofs: gb))
                   (substring s (aft-ofs: gb)))))

(define (gb-filter! gb string-proc)
  (let ((new (string-proc (gb->string gb))))
    (gb-erase! gb)
    (gb-insert-string! gb new)))

(define (gb->lines gb)
  (let ((str (gb->string gb)))
    (let loop ((start 0) (acc '()))
      (cond ((string-index str #\newline start)
             => (lambda (w)
                  (loop (1+ w) (cons (substring str start w) acc))))
            (else (reverse (cons (substring str start) acc)))))))

(define (gb-filter-lines! gb lines-proc)
  (let ((new-lines (lines-proc (gb->lines gb))))
    (gb-erase! gb)
    (gb-insert-string! gb (string-join new-lines #\newline))))

(define (make-gap-buffer-port gb)
  (or (gb? gb)
      (error "not a gap-buffer:" gb))
  (make-soft-port
   (vector
    (lambda (c) (gb-insert-char! gb c))
    (lambda (s) (gb-insert-string! gb s))
    #f
    (lambda () (let ((gap-ofs (gap-ofs: gb))
                     (aft-ofs (aft-ofs: gb)))
                 (if (= aft-ofs (all-sz: gb))
                     #f
                     (let* ((s (s: gb))
                            (c (string-ref s aft-ofs)))
                       (string-set! s gap-ofs c)
                       (gap-ofs! gb (1+ gap-ofs))
                       (aft-ofs! gb (1+ aft-ofs))
                       c))))
    #f)
   "rw"))

;;; gap-buffer.scm ends here
Commit	Line	Data
c517e175 TTN	1	;;; gap-buffer.scm --- String buffer that supports point
	2
	3	;;; Copyright (C) 2002 Free Software Foundation, Inc.
	4	;;;
	5	;;; This program is free software; you can redistribute it and/or modify
	6	;;; it under the terms of the GNU General Public License as published by
	7	;;; the Free Software Foundation; either version 2, or (at your option)
	8	;;; any later version.
	9	;;;
	10	;;; This program is distributed in the hope that it will be useful,
	11	;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	;;; GNU General Public License for more details.
	14	;;;
	15	;;; You should have received a copy of the GNU General Public License
	16	;;; along with this software; see the file COPYING. If not, write to
	17	;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	18	;;; Boston, MA 02111-1307 USA
	19	;;;
	20	;;; As a special exception, the Free Software Foundation gives permission
	21	;;; for additional uses of the text contained in its release of GUILE.
	22	;;;
	23	;;; The exception is that, if you link the GUILE library with other files
	24	;;; to produce an executable, this does not by itself cause the
	25	;;; resulting executable to be covered by the GNU General Public License.
	26	;;; Your use of that executable is in no way restricted on account of
	27	;;; linking the GUILE library code into it.
	28	;;;
	29	;;; This exception does not however invalidate any other reasons why
	30	;;; the executable file might be covered by the GNU General Public License.
	31	;;;
	32	;;; This exception applies only to the code released by the
	33	;;; Free Software Foundation under the name GUILE. If you copy
	34	;;; code from other Free Software Foundation releases into a copy of
	35	;;; GUILE, as the General Public License permits, the exception does
	36	;;; not apply to the code that you add in this way. To avoid misleading
	37	;;; anyone as to the status of such modified files, you must delete
	38	;;; this exception notice from them.
	39	;;;
	40	;;; If you write modifications of your own for GUILE, it is your choice
	41	;;; whether to permit this exception to apply to your modifications.
	42	;;; If you do not wish that, delete this exception notice.
	43	;;;
	44
	45	;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
	46
	47	;;; Commentary:
	48
	49	;; A gap buffer is a structure that models a string but allows relatively
	50	;; efficient insertion of text somewhere in the middle. The insertion
	51	;; location is called `point' with minimum value 1, and a maximum value of the
	52	;; length of the string (which is not fixed).
	53	;;
	54	;; Specifically, we allocate a continuous buffer of characters that is
	55	;; composed of the BEFORE, the GAP and the AFTER (reading L->R), like so:
	56	;;
	57	;; +--- POINT
	58	;; v
	59	;; +--------------------+--------------------+--------------------+
	60	;; \| BEFORE \| GAP \| AFTER \|
	61	;; +--------------------+--------------------+--------------------+
	62	;;
	63	;; <----- bef-sz ----->\|<----- gap-sz ----->\|<----- aft-sz ----->
	64	;;
65	;; <-------------------\| usr-sz \|------------------->
66	;;
67	;; <-------------------------- all-sz -------------------------->
68	;;
69	;; This diagram also shows how the different sizes are computed, and the
70	;; location of POINT. Note that the user-visible buffer size `usr-sz' does
71	;; NOT include the GAP, while the allocation `all-sz' DOES.
72	;;
73	;; The consequence of this arrangement is that "moving point" is simply a
74	;; matter of kicking characters across the GAP, while insertion can be viewed
75	;; as filling up the gap, increasing `bef-sz' and decreasing `gap-sz'. When
76	;; `gap-sz' falls below some threshold, we reallocate with a larger `all-sz'.
77	;;
78	;; In the implementation, we actually keep track of the AFTER start offset
79	;; `aft-ofs' since it is used more often than `gap-sz'. In fact, most of the
80	;; variables in the diagram are for conceptualization only.
81	;;
82	;; A gap buffer port is a soft port (see Guile manual) that wraps a gap
83	;; buffer. Character and string writes, as well as character reads, are
84	;; supported. Flushing and closing are not supported.
85	;;
86	;; These procedures are exported:
87	;; (gb? OBJ)
88	;; (make-gap-buffer . INIT)
89	;; (gb-point GB)
90	;; (gb-point-min GB)
91	;; (gb-point-max GB)
92	;; (gb-insert-string! GB STRING)
93	;; (gb-insert-char! GB CHAR)
94	;; (gb-delete-char! GB COUNT)
95	;; (gb-goto-char GB LOCATION)
96	;; (gb->string GB)
97	;; (gb-filter! GB STRING-PROC)
98	;; (gb->lines GB)
99	;; (gb-filter-lines! GB LINES-PROC)
100	;; (make-gap-buffer-port GB)
101	;;
102	;; INIT is an optional port or a string. COUNT and LOCATION are integers.
103	;; STRING-PROC is a procedure that takes and returns a string. LINES-PROC is
104	;; a procedure that takes and returns a list of strings, each representing a
105	;; line of text (newlines are stripped and added back automatically).
106	;;
107	;; (The term and concept of "gap buffer" are borrowed from Emacs. We will
108	;; gladly return them when libemacs.so is available. ;-)
109	;;
110	;; Notes:
111	;; - overrun errors are suppressed silently
112
113	;;; Code:
114
115	(define-module (ice-9 gap-buffer)
116	:autoload (srfi srfi-13) (string-join)
117	:export (gb?
118	make-gap-buffer
119	gb-point
120	gb-point-min
121	gb-point-max
122	gb-insert-string!
123	gb-insert-char!
124	gb-delete-char!
125	gb-erase!
126	gb-goto-char
127	gb->string
128	gb-filter!
129	gb->lines
130	gb-filter-lines!
131	make-gap-buffer-port))
132
133	(define gap-buffer
134	(make-record-type 'gap-buffer
135	'(s ; the buffer, a string
136	all-sz ; total allocation
137	gap-ofs ; GAP starts, aka (1- point)
138	aft-ofs ; AFTER starts
139	)))
140
141	(define gb? (record-predicate gap-buffer))
142
143	(define s: (record-accessor gap-buffer 's))
144	(define all-sz: (record-accessor gap-buffer 'all-sz))
145	(define gap-ofs: (record-accessor gap-buffer 'gap-ofs))
146	(define aft-ofs: (record-accessor gap-buffer 'aft-ofs))
147
148	(define s! (record-modifier gap-buffer 's))
149	(define all-sz! (record-modifier gap-buffer 'all-sz))
150	(define gap-ofs! (record-modifier gap-buffer 'gap-ofs))
151	(define aft-ofs! (record-modifier gap-buffer 'aft-ofs))
152
153	;; todo: expose
154	(define default-initial-allocation 128)
155	(define default-chunk-size 128)
156	(define default-realloc-threshold 32)
157
158	(define (round-up n)
159	(* default-chunk-size (+ 1 (quotient n default-chunk-size))))
160
161	(define new (record-constructor gap-buffer '()))
162
163	(define (realloc gb inc)
164	(let* ((old-s (s: gb))
165	(all-sz (all-sz: gb))
166	(new-sz (+ all-sz inc))
167	(gap-ofs (gap-ofs: gb))
168	(aft-ofs (aft-ofs: gb))
169	(new-s (make-string new-sz))
170	(new-aft-ofs (+ aft-ofs inc)))
171	(substring-move! old-s 0 gap-ofs new-s 0)
172	(substring-move! old-s aft-ofs all-sz new-s new-aft-ofs)
173	(s! gb new-s)
174	(all-sz! gb new-sz)
175	(aft-ofs! gb new-aft-ofs)))
176
177	(define (make-gap-buffer . init) ; port/string
178	(let ((gb (new)))
179	(cond ((null? init)
180	(s! gb (make-string default-initial-allocation))
181	(all-sz! gb default-initial-allocation)
182	(gap-ofs! gb 0)
183	(aft-ofs! gb default-initial-allocation))
184	(else (let ((jam! (lambda (string len)
185	(let ((alloc (round-up len)))
186	(s! gb (make-string alloc))
187	(all-sz! gb alloc)
188	(substring-move! string 0 len (s: gb) 0)
189	(gap-ofs! gb len)
190	(aft-ofs! gb alloc))))
191	(v (car init)))
192	(cond ((port? v)
193	(let ((next (lambda () (read-char v))))
194	(let loop ((c (next)) (acc '()) (len 0))
195	(if (eof-object? c)
196	(jam! (list->string (reverse acc)) len)
197	(loop (next) (cons c acc) (1+ len))))))
198	((string? v)
199	(jam! v (string-length v)))
200	(else (error "bad init type"))))))
201	gb))
202
203	(define (gb-point gb)
204	(1+ (gap-ofs: gb)))
205
206	(define (gb-point-min gb) 1) ; no narrowing (for now)
207
208	(define (gb-point-max gb)
209	(1+ (- (all-sz: gb) (- (aft-ofs: gb) (gap-ofs: gb)))))
210
211	(define (insert-prep gb len)
212	(let* ((gap-ofs (gap-ofs: gb))
213	(aft-ofs (aft-ofs: gb))
214	(slack (- (- aft-ofs gap-ofs) len)))
215	(and (< slack default-realloc-threshold)
216	(realloc gb (round-up (- slack))))
217	gap-ofs))
218
219	(define (gb-insert-string! gb string)
220	(let* ((len (string-length string))
221	(gap-ofs (insert-prep gb len)))
222	(substring-move! string 0 len (s: gb) gap-ofs)
223	(gap-ofs! gb (+ gap-ofs len))))
224
225	(define (gb-insert-char! gb char)
226	(let ((gap-ofs (insert-prep gb 1)))
227	(string-set! (s: gb) gap-ofs char)
228	(gap-ofs! gb (+ gap-ofs 1))))
229
230	(define (gb-delete-char! gb count)
231	(cond ((< count 0) ; backwards
232	(gap-ofs! gb (max 0 (+ (gap-ofs: gb) count))))
233	((> count 0) ; forwards
234	(aft-ofs! gb (min (all-sz: gb) (+ (aft-ofs: gb) count))))
235	((= count 0) ; do nothing
236	#t)))
237
238	(define (gb-erase! gb)
239	(gap-ofs! gb 0)
240	(aft-ofs! gb (all-sz: gb)))
241
242	(define (point++n! gb n s gap-ofs aft-ofs) ; n>0; warning: reckless
243	(substring-move-left! s aft-ofs (+ aft-ofs n) s gap-ofs)
244	(gap-ofs! gb (+ gap-ofs n))
245	(aft-ofs! gb (+ aft-ofs n)))
246
247	(define (point+-n! gb n s gap-ofs aft-ofs) ; n<0; warning: reckless
248	(substring-move-right! s (+ gap-ofs n) gap-ofs s (+ aft-ofs n))
249	(gap-ofs! gb (+ gap-ofs n))
250	(aft-ofs! gb (+ aft-ofs n)))
251
252	(define (gb-goto-char gb new-point)
253	(let ((pmax (gb-point-max gb)))
254	(or (and (< new-point 1) (gb-goto-char gb 1))
255	(and (> new-point pmax) (gb-goto-char gb pmax))
256	(let ((delta (- new-point (gb-point gb))))
257	(or (= delta 0)
258	((if (< delta 0)
259	point+-n!
260	point++n!)
261	gb delta (s: gb) (gap-ofs: gb) (aft-ofs: gb))))))
262	new-point)
263
264	(define (gb->string gb)
265	(let ((s (s: gb)))
266	(string-append (substring s 0 (gap-ofs: gb))
267	(substring s (aft-ofs: gb)))))
268
269	(define (gb-filter! gb string-proc)
270	(let ((new (string-proc (gb->string gb))))
271	(gb-erase! gb)
272	(gb-insert-string! gb new)))
273
274	(define (gb->lines gb)
275	(let ((str (gb->string gb)))
276	(let loop ((start 0) (acc '()))
277	(cond ((string-index str #\newline start)
278	=> (lambda (w)
279	(loop (1+ w) (cons (substring str start w) acc))))
280	(else (reverse (cons (substring str start) acc)))))))
281
282	(define (gb-filter-lines! gb lines-proc)
283	(let ((new-lines (lines-proc (gb->lines gb))))
284	(gb-erase! gb)
285	(gb-insert-string! gb (string-join new-lines #\newline))))
286
287	(define (make-gap-buffer-port gb)
288	(or (gb? gb)
289	(error "not a gap-buffer:" gb))
290	(make-soft-port
291	(vector
292	(lambda (c) (gb-insert-char! gb c))
293	(lambda (s) (gb-insert-string! gb s))
294	#f
295	(lambda () (let ((gap-ofs (gap-ofs: gb))
296	(aft-ofs (aft-ofs: gb)))
297	(if (= aft-ofs (all-sz: gb))
298	#f
299	(let* ((s (s: gb))
300	(c (string-ref s aft-ofs)))
301	(string-set! s gap-ofs c)
302	(gap-ofs! gb (1+ gap-ofs))
303	(aft-ofs! gb (1+ aft-ofs))
304	c))))
305	#f)
306	"rw"))
307
308	;;; gap-buffer.scm ends here