Add editor submodule with the implementation of a gap-buffer

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