application/octet-stream
•
10.01 KB
•
309 lines
(defclass TextBuffer
"A buffer for text editors"
:export
(defn new (self filename)
(def lines [(buffer/allocate 16)])
{ :lines lines
:filename filename
:changed #f
:pos-x 0
:pos-y 0
:scroll-x 0
:scroll-y 0
:mark #nil
:scroll-interval 20
:prototype* self })
(defn get-line (self line-y)
(def lines (ref self :lines))
(if (or (< line-y 0)
(>= line-y (:length lines)))
#nil
(ref lines line-y)))
(defn line-length (self pos-y)
(def line (:get-line self pos-y))
(when-not line (return 0))
(dotimes (i (:length line) (:length line))
(when (zero? (ref line i))
(return i))))
(defn line-indent-depth (self pos-y)
(def line (:get-line self pos-y))
(when-not line (return 0))
(dotimes (i (:length line) (:length line))
(when (or (zero? (ref line i))
(> (ref line i) #x20))
(return i))))
(defn beginning-of-line (self)
(set! self :pos-x 0))
(defn start-of-line (self)
(def depth (:line-indent-depth self (ref self :pos-y)))
(if (> (ref self :pos-x) depth)
(set! self :pos-x depth)
(:beginning-of-line self)))
(defn end-of-line (self)
(set! self :pos-x (:line-length self (ref self :pos-y))))
(defn beginning-of-buffer (self)
(set! self :pos-y 0)
(set! self :pos-x 0))
(defn end-of-buffer (self)
(set! self :pos-y (- (:length (ref self :lines)) 1))
(:end-of-line self))
(defn backward-char (self)
(def pos-x (ref self :pos-x))
(when (< pos-x 1)
(def pos-y (ref self :pos-y))
(when (< pos-y 1)
(return))
(set! self :pos-y (dec pos-y))
(set! self :pos-x (:line-length self (dec pos-y)))
(return))
(set! self :pos-x (dec pos-x)))
(defn previous-line (self)
(def pos-x (ref self :pos-x))
(def pos-y (ref self :pos-y))
(when (< pos-y 1)
(return))
(set! self :pos-y (dec pos-y))
(set! self :pos-x (min pos-x (:line-length self (dec pos-y)))))
(defn next-line (self)
(def pos-x (ref self :pos-x))
(def pos-y (ref self :pos-y))
(def lines (ref self :lines))
(def ll (- (:length lines) 1))
(when (>= pos-y ll)
(return))
(set! self :pos-y (inc pos-y))
(set! self :pos-x (min pos-x (:line-length self (inc pos-y)))))
(defn forward-char (self)
(def pos-x (ref self :pos-x))
(def pos-y (ref self :pos-y))
(def ll (:line-length self pos-y))
(when (>= pos-x ll)
(when (>= (inc pos-y) (:length (ref self :lines)))
(return))
(set! self :pos-x 0)
(set! self :pos-y (inc pos-y))
(return))
(set! self :pos-x (inc pos-x)))
(defn delete-forward-char (self)
(when (:delete-region self) (return))
(def line (:get-line self (ref self :pos-y)))
(when-not line (return))
(def pos-x (ref self :pos-x))
(def bl (- (:length line) 2))
(def ll (:line-length self (ref self :pos-y)))
(when (< bl 0)
(return))
(when (>= pos-x ll)
(when (>= (ref self :pos-y) (- (:length (ref self :lines)) 1))
(return))
(set! self :pos-x 0)
(set! self :pos-y (inc (ref self :pos-y)))
(def clipboard (:kill-line self))
(:remove-line self)
(set! self :pos-y (- (ref self :pos-y) 1))
(set! self :pos-x pos-x)
(:insert-text self clipboard)
(set! self :pos-x pos-x)
(return))
(while (<= pos-x bl)
(set! line pos-x (ref line (inc pos-x)))
(inc! pos-x))
(set! line (- (:length line) 1) 0))
(defn remove-line (self y)
(when (:delete-region self) (return))
(set! y (or y (ref self :pos-y)))
(def lines (ref self :lines))
(def ll (- (:length lines) 1))
(def pos-y (ref self :pos-y))
(when (zero? pos-y) (return))
(while (< pos-y ll)
(set! lines pos-y (ref lines (inc pos-y)))
(inc! pos-y))
(:length! lines (max 0 ll)))
(defn backward-delete-line (self)
(def clipboard (:kill-line self))
(:remove-line self)
(set! self :pos-y (- (ref self :pos-y) 1))
(set! self :pos-x (:line-length self (ref self :pos-y)))
(def pos-x (ref self :pos-x))
(:insert-text self clipboard)
(set! self :pos-x pos-x))
(defn backward-delete-char (self)
(when (:delete-region self) (return))
(def line (:get-line self (ref self :pos-y)))
(when-not line (return))
(def pos-x (ref self :pos-x))
(when (< pos-x 1)
(return (:backward-delete-line self)))
(def bl (- (:length line) 1))
(while (<= pos-x bl)
(set! line (- pos-x 1) (ref line pos-x))
(inc! pos-x))
(set! line bl 0)
(set! self :pos-x (- (ref self :pos-x) 1)))
(defn keyboard-quit (self)
(set! self :mark #nil))
(defn use-region? (self)
(pair? (ref self :mark)))
(defn region-start-y (self)
(min (ref self :pos-y)
(cdr (ref self :mark))))
(defn region-end-y (self)
(max (ref self :pos-y)
(cdr (ref self :mark))))
(defn region-start-x (self)
(if (= (ref self :pos-y) (cdr (ref self :mark)))
(min (ref self :pos-x)
(car (ref self :mark)))
(if (< (ref self :pos-y) (cdr (ref self :mark)))
(ref self :pos-x)
(car (ref self :mark)))))
(defn region-end-x (self)
(if (= (ref self :pos-y) (cdr (ref self :mark)))
(max (ref self :pos-x)
(car (ref self :mark)))
(if (< (ref self :pos-y) (cdr (ref self :mark)))
(car (ref self :mark))
(ref self :pos-x))))
(defn set-mark-command (self)
(set! self :mark (cons (ref self :pos-x) (ref self :pos-y))))
(defn mark-whole-buffer (self)
(:end-of-buffer self)
(:set-mark-command self)
(:beginning-of-buffer self))
(defn delete-region (self)
(when (nil? (ref self :mark))
(return #f))
(def rs-y (:region-start-y self))
(def re-y (:region-end-y self))
(def rs-x (:region-start-x self))
(def re-x (:region-end-x self))
(set! self :mark #nil)
(def times (if (= rs-y re-y)
(- re-x rs-x)
(+ re-x (- (inc (:line-length self rs-y)) rs-x))))
(def line-y (inc rs-y))
(while (< line-y re-y)
(set! self :pos-y (inc rs-y))
(:remove-line self)
(inc! line-y))
(set! self :pos-x rs-x)
(set! self :pos-y rs-y)
(dotimes (i times)
(:delete-forward-char self))
#t)
(defn get-region (self)
(when (nil? (ref self :mark))
(return ""))
(def rs-y (:region-start-y self))
(def re-y (:region-end-y self))
(def rs-x (:region-start-x self))
(def re-x (:region-end-x self))
(def buf #nil)
(def lines (ref self :lines))
(def line-y rs-y)
(while (<= line-y re-y)
(def mark-start 0)
(def mark-end 0)
(set! mark-end (:line-length self line-y))
(when (= line-y rs-y)
(set! mark-start rs-x))
(when (= line-y re-y)
(set! mark-end re-x))
(set! buf (cons (buffer->string (ref lines line-y) mark-end mark-start) buf))
(inc! line-y))
(join (nreverse buf) "\n"))
(defn insert-char (self c)
(:delete-region self)
(when (zero? c) (return))
(when (= c #\LineFeed)
(return (:insert-newline self)))
(def line (:get-line self (ref self :pos-y)))
(when-not line (return))
(def pos-x (ref self :pos-x))
(def i (- (:length line) 1))
(when-not (zero? (ref line i))
(:length! line (+ (:length line) 16))
(set! i (- (:length line) 1)))
(while (> i pos-x)
(set! line i (ref line (dec i)))
(dec! i))
(set! line pos-x c)
(set! self :pos-x (inc pos-x)))
(defn insert-text (self text)
(dotimes (i (:length text))
(:insert-char self (ref text i))))
(defn kill-line (self)
(set! self :mark #nil)
(def lines (ref self :lines))
(def pos-x (ref self :pos-x))
(def cur-line (ref lines (ref self :pos-y)))
(def ll (:line-length self (ref self :pos-y)))
(def ret (buffer->string (:cut cur-line pos-x ll)))
(while (< pos-x ll)
(set! cur-line pos-x 0)
(inc! pos-x))
(return ret))
(defn insert-newline (self)
(:delete-region self)
(def lines (ref self :lines))
(:length! lines (inc (:length lines)))
(def clipboard (:kill-line self))
(set! self :pos-y (inc (ref self :pos-y)))
(def ll (ref self :pos-y))
(def pos-y (- (:length lines) 1))
(while (> pos-y ll)
(set! lines pos-y (ref lines (- pos-y 1)))
(set! pos-y (- pos-y 1)))
(set! lines (ref self :pos-y) (buffer/allocate 16))
(set! self :pos-x 0)
(:insert-text self clipboard)
(set! self :pos-x 0))
(defn goto-line (self line)
(set! self :pos-y (max 0 (min (- (:length (ref self :lines)) 1) line)))
(set! self :pos-x (max 0 (min (- (:line-length self (ref self :pos-y)) 1) (ref self :pos-x)))))
(defn scroll-up-command (self)
(:goto-line self (+ (ref self :pos-y) (ref self :scroll-interval))))
(defn scroll-down-command (self)
(:goto-line self (- (ref self :pos-y) (ref self :scroll-interval))))
(defn get-buf-name (self buf)
(def filename (ref self :filename))
(def saved (if (ref self :changed) "*" ""))
(fmt "{filename}{saved}")))
