application/octet-stream
•
9.45 KB
•
255 lines
(import (TermApp) :term/TermApp)
(import (TextBuffer) :app/termed/buffer)
(def clipboard "")
(def buffers [])
(def bgcolor 1)
(defclass TextEditor
"A terminal-based text editor with controls very similar to Emacs"
(defn new (self term args)
(def ret { :term term
:cur-buffer #nil
:screen-width 0
:screen-height 0
:scroll-interval 8
:cx-active #f
:cx-key-down-handler {}
:key-down-handler {}
:focus? #f
:prototype* self })
(:text-mode ret)
(when (zero? (:length buffers))
(:new-buffer ret "*scratch*"))
(doseq (arg args)
(:load-buffer ret arg))
ret)
(defn set-cur-buffer! (self buf)
(set! self.scroll-interval (max 4 (int (/ self.screen-height 3))))
(set! buf.scroll-interval self.scroll-interval)
(set! self.cur-buffer buf))
(defn new-buffer (self filename)
(def buf (:new TextBuffer filename))
(array/push buffers buf)
(:set-cur-buffer! self buf)
buf)
(defn yank (self)
(:insert-text self.cur-buffer clipboard))
(defn kill-line (self)
(set! clipboard (:kill-line self.cur-buffer)))
(defn accent-color (self)
(if self.focus?
#xF4
#xF8))
(defn draw-modeline (self buf)
(def colored-modeline (cat " " (pad-end (:get-modeline buf) (dec self.screen-width))))
(:draw-text self.term colored-modeline 1 (dec self.screen-height) self.screen-width 1 (:accent-color self)))
(defn draw-buffer-line (self buf term-x term-y term-w line-y)
(def line (:get-line buf line-y))
(when-not line
(:draw-text self.term (pad-end "" term-w) term-x term-y term-w 1 #xFF)
(return))
(def gutter-color (if (= line-y buf.pos-y) (:accent-color self) #xFF))
(def ln (fmt " {:4} " (inc line-y)))
(:draw-text self.term ln term-x term-y 6 1 gutter-color)
(def buf-off 0)
(def buf-max (:length line))
(def max-w (min (- buf-max buf-off) (- term-w 5)))
(def mark-start 0)
(def mark-end 0)
(when (:use-region? buf)
(def rs-y (:region-start-y buf))
(def re-y (:region-end-y buf))
(def rs-x (:region-start-x buf))
(def re-x (:region-end-x buf))
(when (and (>= line-y rs-y)
(<= line-y re-y))
(set! mark-end max-w)
(when (= line-y rs-y)
(set! mark-start rs-x))
(when (= line-y re-y)
(set! mark-end re-x))))
(def c 0)
(def color 0)
(:draw-char self.term #x20 (+ 6 term-x) term-y #xFF)
(dotimes (i term-w)
(if (< i max-w)
(do (set! c (ref line (+ i buf-off)))
(set! color (if (and (>= i mark-start)
(< i mark-end)
(not (zero? c)))
(:accent-color self) #xFF))
(:draw-char self.term (if (zero? c) #x20 c) (+ 6 term-x i) term-y color))
(:draw-char self.term #x20 (+ 6 term-x i) term-y color))))
(defn draw-buffer (self buf x y w h)
(dotimes (cy h)
(:draw-buffer-line self buf x (+ cy y) w (+ cy buf.scroll-y)))
(:draw-modeline self buf))
(defn draw-screen (self)
(:draw-buffer self self.cur-buffer 1 1 self.screen-width (- self.screen-height 2))
(:set-cursor self.term
(+ 1 6 self.cur-buffer.pos-x)
(- (inc self.cur-buffer.pos-y)
self.cur-buffer.scroll-y)))
(defn stop (self)
(:stop self.term))
(defn quit (self)
(:quit self.term)
(exit 0))
(defn set-parent! (self parent)
(set! self.term parent))
(defn scroll-into-view (self)
(def buf self.cur-buffer)
(def frame-height (- self.screen-height 3))
(when (< (- buf.pos-y buf.scroll-y) 0)
(set! buf.scroll-y (* self.scroll-interval (int (floor (/ buf.pos-y self.scroll-interval))))))
(when (> (- buf.pos-y buf.scroll-y) frame-height)
(set! buf.scroll-y (* self.scroll-interval (int (ceil (/ (- buf.pos-y frame-height) self.scroll-interval))))))
(when (< buf.scroll-y 0)
(set! buf.scroll-y 0)))
(defn handle-key-down (self key)
(def handler (ref (if self.cx-active self.cx-key-down-handler self.key-down-handler) key))
(set! self.cx-active #f)
(when handler (handler self.cur-buffer)))
(defn kill-region (self)
(set! clipboard (:get-region self.cur-buffer))
(:delete-region self.cur-buffer))
(defn kill-ring-save (self)
(set! clipboard (:get-region self.cur-buffer))
(:keyboard-quit self.cur-buffer))
(defn resize (self width height)
(set! self.screen-width width)
(set! self.screen-height height)
(:set-cur-buffer! self self.cur-buffer))
(defn insert-char (self event)
(def handler (ref self.key-down-handler (:keyword event.char)))
(set! self.cx-active #f)
(if handler
(handler self.cur-buffer)
(:insert-char self.cur-buffer event.code)))
(defn handle-event (self event)
(case event.T
(:blur (set! self.focus? #f))
(:reparent (set! self.term event.parent))
(:focus (set! self.focus? #t))
(:draw (:scroll-into-view self) (:draw-screen self))
(:resize (:resize self event.width event.height))
(:key-down (:handle-key-down self event.key))
(:input (if self.cx-active
(:handle-key-down self (:keyword event.char))
(:insert-char self event)))))
(defn load-buffer (self filename)
(def buf (:new-buffer self filename))
(def text (slurp filename))
(def raw-lines (if text (split text "\n") #nil))
(def lines (:alloc Array (max 1 (:length raw-lines))))
(set! buf :lines lines)
(def i 0)
(doseq (line raw-lines buf)
(def cur-line (buffer/allocate (bit-shift-left (inc (bit-shift-right (:length line) 4)) 4)))
(buffer/copy cur-line line 0 (:length line))
(set! lines i cur-line)
(inc! i)))
(defn windmove-left (self)
(:windmove-left self.term))
(defn windmove-right (self)
(:windmove-right self.term))
(defn windmove-up (self)
(:windmove-up self.term))
(defn windmove-down (self)
(:windmove-down self.term))
(defn set-parent! (self parent)
(set! self.term parent))
(defn split-window-right (self)
(def new (:new TextEditor))
(:set-cur-buffer! new self.cur-buffer)
(:split-window-right self.term new))
(defn split-window-below (self)
(def new (:new TextEditor))
(:set-cur-buffer! new self.cur-buffer)
(:split-window-below self.term new))
(defn run (self)
(:run self.term self))
(defn fundamental-mode (self)
(def key-down-handler self.key-down-handler)
(def cx-key-down-handler self.cx-key-down-handler)
(set! key-down-handler :C-x (fn () (set! self.cx-active #t)))
(set! key-down-handler :C-spc :set-mark-command)
(set! key-down-handler :C-a :start-of-line)
(set! key-down-handler :C-b :backward-char)
(set! key-down-handler :C-e :end-of-line)
(set! key-down-handler :C-f :forward-char)
(set! key-down-handler :C-g :keyboard-quit)
(set! key-down-handler :C-p :previous-line)
(set! key-down-handler :C-n :next-line)
(set! key-down-handler :C-up (fn () (:windmove-up self)))
(set! key-down-handler :C-down (fn () (:windmove-down self)))
(set! key-down-handler :C-right (fn () (:windmove-right self)))
(set! key-down-handler :C-left (fn () (:windmove-left self)))
(set! key-down-handler :C-w (fn () (:kill-region self)))
(set! key-down-handler :M-w (fn () (:kill-ring-save self)))
(set! key-down-handler :M-< :beginning-of-buffer)
(set! key-down-handler :M-> :end-of-buffer)
(set! key-down-handler :left :backward-char)
(set! key-down-handler :right :forward-char)
(set! key-down-handler :up :previous-line)
(set! key-down-handler :down :next-line)
(set! key-down-handler :home :start-of-line)
(set! key-down-handler :end :end-of-line)
(set! key-down-handler :page-up :scroll-down-command)
(set! key-down-handler :page-down :scroll-up-command)
(set! cx-key-down-handler :h :mark-whole-buffer)
(set! cx-key-down-handler :2 (fn () (:split-window-below self)))
(set! cx-key-down-handler :3 (fn () (:split-window-right self)))
(set! cx-key-down-handler :0 (fn () (:stop self)))
(set! cx-key-down-handler :C-c (fn () (:quit self))))
(defn text-mode (self)
(:fundamental-mode self)
(def key-down-handler self.key-down-handler)
(set! key-down-handler :C-k (fn () (:kill-line self)))
(set! key-down-handler :backspace :backward-delete-char)
(set! key-down-handler :delete :delete-forward-char)
(set! key-down-handler :C-y (fn () (:yank self)))
(set! key-down-handler :insert (fn () (:yank self)))
(set! key-down-handler :ret :insert-newline)))
(defn main (args)
:export
(:run (:new TextEditor (:new TermApp) args)))
