Add tests for gap-buffer manipulation

lisp/local-projects/sextant/editor/all.lisp

@@ -0,0 +1,4 @@
+(uiop:define-package :sextant/editor/all
+  (:nicknames :editor)
+  (:use-reexport
+   :sextant/editor/gap-buffer))

lisp/local-projects/sextant/editor/gap-buffer.lisp

@@ -0,0 +1,93 @@
+(uiop:define-package :sextant/editor/gap-buffer
+  (:use :cl)
+  (:export #:gap-buffer-data
+           #:gap-buffer-gap-start
+           #:gap-buffer-gap-end
+           #:make-gap-buffer
+           #:gap-buffer-print
+           #:gap-buffer-move-gap
+           #:gap-buffer-insert-string
+           #:gap-buffer-delete))
+(in-package :sextant/editor/gap-buffer)
+
+(defconstant +gap-size+ 64)
+
+(defstruct (gap-buffer (:constructor %make-gap-buffer) (:print-object gap-buffer-print))
+  data
+  gap-start
+  gap-end)
+
+(defun make-gap-buffer (spec)
+  (multiple-value-bind (stream size)
+      (etypecase spec
+        (string (values (make-string-input-stream spec) (length spec)))
+        (pathname (let ((stream (open spec :if-does-not-exist nil)))
+                    (values stream (file-length stream)))))
+    (let ((gb (%make-gap-buffer :data (make-array (+ size +gap-size+)
+                                                    :element-type 'character
+                                                    :initial-element #\Space
+                                                    :adjustable t)
+                                :gap-start size
+                                :gap-end (+ size +gap-size+))))
+      (read-sequence (gap-buffer-data gb) stream)
+      gb)))
+
+(defun gap-buffer-gap-length (gb)
+  (- (gap-buffer-gap-end gb) (gap-buffer-gap-start gb)))
+
+(defun gap-buffer-length (gb)
+  (- (array-dimension (gap-buffer-data gb) 0) (gap-buffer-gap-length gb)))
+
+(defun gap-buffer-print (gb &optional stream)
+  (let ((data (gap-buffer-data gb))
+        (start (gap-buffer-gap-start gb))
+        (end (gap-buffer-gap-end gb)))
+    (format stream "#S(GAP-BUFFER \"~a[~a-~a(~a)]~a\")" (subseq data 0 start) start end (- end start)
+            (subseq data end (array-dimension data 0)))))
+
+(defun gap-buffer-move-gap (gb point)
+  (let ((data (gap-buffer-data gb))
+        (start (gap-buffer-gap-start gb))
+        (end (gap-buffer-gap-end gb))
+        (point (min point (gap-buffer-length gb))))
+    (let ((distance (abs (- point start))))
+      (cond
+        ((< point start)
+         (setf (subseq data (- end distance) end)
+               (subseq data point start))
+         (decf (gap-buffer-gap-start gb) distance)
+         (decf (gap-buffer-gap-end gb) distance))
+        ((> point start)
+         (setf (subseq data start (+ start distance))
+               (subseq data end (+ end distance)))
+         (incf (gap-buffer-gap-start gb) distance)
+         (incf (gap-buffer-gap-end gb) distance))))
+    gb))
+
+(defun gap-buffer-grow-gap (gb &optional (grow-size +gap-size+))
+  (let ((data (gap-buffer-data gb))
+        (end (gap-buffer-gap-end gb)))
+    (let* ((old-size (array-dimension data 0))
+           (new-size (+ old-size grow-size))
+           (new-data (adjust-array data new-size :initial-element #\Space)))
+      (setf (subseq data (+ end grow-size) new-size)
+            (subseq data end old-size))
+      (incf (gap-buffer-gap-end gb) grow-size)
+      (setf (gap-buffer-data gb) new-data)
+      gb)))
+
+(defun gap-buffer-insert-string (gb str)
+  (let ((len (length str)))
+    (when (> len (gap-buffer-gap-length gb))
+      (gap-buffer-grow-gap gb (+ (- len (gap-buffer-gap-length gb)) +gap-size+)))
+    (let ((data (gap-buffer-data gb))
+          (start (gap-buffer-gap-start gb)))
+      (setf (subseq data start (+ start len)) str)
+      (incf (gap-buffer-gap-start gb) len)
+      gb)))
+
+(defun gap-buffer-delete (gb size &optional (direction :before))
+  (ecase direction
+    (:before (decf (gap-buffer-gap-start gb) (min (gap-buffer-gap-start gb) size)))
+    (:after (incf (gap-buffer-gap-end gb) (min (- (array-dimension (gap-buffer-data gb) 0) (gap-buffer-gap-end gb)) size))))
+  gb)

lisp/local-projects/sextant/sextant.asd

@@ -5,5 +5,8 @@
   :around-compile (lambda (thunk)
                     (proclaim '(optimize (debug 3) (safety 3) (speed 0)))
                     (funcall thunk))
-  :depends-on #.(append (uiop:read-file-form (merge-pathnames #p"../../../dependencies.sexp" (or *load-pathname* *compile-file-pathname*))))
+  :depends-on #.(append (uiop:read-file-form (merge-pathnames #p"../../../dependencies.sexp" (or *load-pathname* *compile-file-pathname*)))
+                        '("sextant/editor/all"))
   :components ((:file "sextant")))
+
+(register-system-packages "sextant/editor/all" '(:editor))

minimal.pro

@@ -1,4 +1,5 @@
 TEMPLATE = subdirs
+QT =
 SUBDIRS = parser \
           sextant
 

sextant-tests.lisp

@@ -2,3 +2,43 @@
 (ql:quickload :fiveam)
 
 (use-package :fiveam)
+(use-package :editor)
+
+(def-suite all-tests)
+
+(def-suite gap-buffer :in all-tests)
+(in-suite gap-buffer)
+
+(defparameter gb (make-gap-buffer "abcdefghijklmnopqrstuvwxyz"))
+(test make-gap-buffer
+      (is (equal "#S(GAP-BUFFER \"abcdefghijklmnopqrstuvwxyz[26-90(64)]\")" (gap-buffer-print gb))))
+
+(test move-gap
+      (is (equal "#S(GAP-BUFFER \"abcdefghijklmno[15-79(64)]pqrstuvwxyz\")" (gap-buffer-print (gap-buffer-move-gap gb 15))))
+      (is (equal "#S(GAP-BUFFER \"ab[2-66(64)]cdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-move-gap gb 2)))))
+
+(test insert-string
+      (is (equal "#S(GAP-BUFFER \"ab123456789[11-66(55)]cdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-insert-string gb "123456789"))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns[28-66(38)]cdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-insert-string gb "pyfgcrlaoeuidhtns"))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth[51-66(15)]cdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-insert-string gb ";qjkxbmwvzlrcgpoaeusnth"))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth0123456789[61-66(5)]cdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-insert-string gb "0123456789")))))
+
+(test grow-gap
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth01234567899876543210abcdefghij[81-145(64)]cdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-insert-string gb "9876543210abcdefghij")))))
+
+(test delete
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth01234567899876543210abcdefghij[81-148(67)]fghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-delete gb 3 :after))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth01234567899876543210abcdefghij[81-169(88)]\")" (gap-buffer-print (gap-buffer-delete gb 23 :after))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth01234567899876543210abcdefghij[81-169(88)]\")" (gap-buffer-print (gap-buffer-delete gb 23 :after))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbmwvzlrcgpoaeusnth0123456[58-169(111)]\")" (gap-buffer-print (gap-buffer-delete gb 23))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789pyfgcrlaoeuidhtns;qjkxbm[35-169(134)]\")" (gap-buffer-print (gap-buffer-delete gb 23))))
+      (is (equal "#S(GAP-BUFFER \"ab123456789p[12-169(157)]\")" (gap-buffer-print (gap-buffer-delete gb 23))))
+      (is (equal "#S(GAP-BUFFER \"[0-169(169)]\")" (gap-buffer-print (gap-buffer-delete gb 23)))))
+
+(test insert-string-move-gap
+      (is (equal "#S(GAP-BUFFER \"abcdefghijklmnopqrstuvwxyz[26-169(143)]\")" (gap-buffer-print (gap-buffer-insert-string gb "abcdefghijklmnopqrstuvwxyz"))))
+      (is (equal "#S(GAP-BUFFER \"[0-143(143)]abcdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-move-gap gb 0))))
+      (is (equal "#S(GAP-BUFFER \"0123456789[10-143(133)]abcdefghijklmnopqrstuvwxyz\")" (gap-buffer-print (gap-buffer-insert-string gb "0123456789"))))
+      (is (equal "#S(GAP-BUFFER \"0123456789abcdefghijklmnopqrstuvwxyz[36-169(133)]\")" (gap-buffer-print (gap-buffer-move-gap gb 200)))))
+
+(run! 'all-tests)

sextant.pro

@@ -1,5 +1,6 @@
 TEMPLATE = app
 CONFIG += debug
+QT =
 TARGET = sextant
 DESTDIR = $$PWD
 OBJECTS_DIR = $$PWD/tmp/sextant

ts-parser.pro

@@ -1,5 +1,6 @@
 TEMPLATE = lib
 CONFIG += staticlib debug
+QT =
 TARGET = sextant-parser
 DESTDIR = $$PWD
 OBJECTS_DIR = $$PWD/tmp/parser/