editor.lisp

(import * from gui)
(import * from layout)

(setf *font* "\"Droid Sans Mono\",\"Courier New\",\"Courier\",monospace")
(setf *fontsz* 16)
(setf *vshift* 4)
(setf *vextra* 2)

(defvar *edit-commands* #(("copy" "Clipboard copy (works only when bound to OS default)")
                          ("cut" "Clipboard cut (works only when bound to OS default)")
                          ("paste" "Clipboard paste (works only when bound to OS default)")
                          ("goto-line" "Goto line number")
                          ("indent" "Indent selection or current line")
                          ("autocomplete" "Current word autocompletion")
                          ("goto-0" "Goto saved position #0")
                          ("goto-1" "Goto saved position #1")
                          ("goto-2" "Goto saved position #2")
                          ("goto-3" "Goto saved position #3")
                          ("goto-4" "Goto saved position #4")
                          ("goto-5" "Goto saved position #5")
                          ("goto-6" "Goto saved position #6")
                          ("goto-7" "Goto saved position #7")
                          ("goto-8" "Goto saved position #8")
                          ("goto-9" "Goto saved position #9")
                          ("def-0" "Save current position as #0")
                          ("def-1" "Save current position as #1")
                          ("def-2" "Save current position as #2")
                          ("def-3" "Save current position as #3")
                          ("def-4" "Save current position as #4")
                          ("def-5" "Save current position as #5")
                          ("def-6" "Save current position as #6")
                          ("def-7" "Save current position as #7")
                          ("def-8" "Save current position as #8")
                          ("def-9" "Save current position as #9")
                          ("find-replace" "Find/replace dialog")
                          ("page-up" "Move to previous page")
                          ("page-down" "Move to next page")
                          ("line-end" "Move to end of line")
                          ("text-end" "Move to end of text")
                          ("line-begin" "Move to begin of line")
                          ("text-begin" "Move to begin of text")
                          ("left" "Move to previous char")
                          ("up" "Move to previous line")
                          ("right" "Move to next char")
                          ("down" "Move to next line")
                          ("delete" "Delete current char or selection")
                          ("backspace" "Delete previous char or selection")
                          ("enter" "Inserts a new line")
                          ("esc" "Quits interactive modes")
                          ("isearch" "Start interactive search")
                          ("undo" "Undo last change")
                          ("redo" "Redo last undone change")
                          ("record-macro" "Start recording a macro")
                          ("play-macro" "Stop recording or start playback of a macro")))

(defvar *keybindings* #(("ctrl-C" "copy")
                        ("alt-C" "copy")
                        ("ctrl-X" "cut")
                        ("alt-X" "cut")
                        ("ctrl-V" "paste")
                        ("alt-V" "paste")
                        ("ctrl-L" "goto-line")
                        ("Tab" "indent")
                        ("alt-#191" "autocomplete")
                        ("ctrl-0" "goto-0")
                        ("ctrl-1" "goto-1")
                        ("ctrl-2" "goto-2")
                        ("ctrl-3" "goto-3")
                        ("ctrl-4" "goto-4")
                        ("ctrl-5" "goto-5")
                        ("ctrl-6" "goto-6")
                        ("ctrl-7" "goto-7")
                        ("ctrl-8" "goto-8")
                        ("ctrl-9" "goto-9")
                        ("ctrl-alt-0" "def-0")
                        ("ctrl-alt-1" "def-1")
                        ("ctrl-alt-2" "def-2")
                        ("ctrl-alt-3" "def-3")
                        ("ctrl-alt-4" "def-4")
                        ("ctrl-alt-5" "def-5")
                        ("ctrl-alt-6" "def-6")
                        ("ctrl-alt-7" "def-7")
                        ("ctrl-alt-8" "def-8")
                        ("ctrl-alt-9" "def-9")
                        ("ctrl-R" "find-replace")
                        ("PgUp" "page-up")
                        ("shift-PgUp" "page-up")
                        ("PgDn" "page-down")
                        ("shift-PgDn" "page-down")
                        ("End" "line-end")
                        ("shift-End" "line-end")
                        ("ctrl-End" "text-end")
                        ("ctrl-shift-End" "text-end")
                        ("Home" "line-begin")
                        ("shift-Home" "line-begin")
                        ("ctrl-Home" "text-begin")
                        ("ctrl-shift-Home" "text-begin")
                        ("Left" "left")
                        ("shift-Left" "left")
                        ("Up" "up")
                        ("shift-Up" "up")
                        ("Right" "right")
                        ("shift-Right" "right")
                        ("Down" "down")
                        ("shift-Down" "down")
                        ("Del" "delete")
                        ("Backspace" "backspace")
                        ("Enter" "enter")
                        ("Esc" "esc")
                        ("ctrl-S" "isearch")
                        ("ctrl-Z" "undo")
                        ("ctrl-Y" "redo")
                        ("F3" "record-macro")
                        ("F4" "play-macro")))

(defun font (ctx opts)
  (let ((font ""))
    (when opts.bold
      (incf font " bold"))
    (when opts.italic
      (incf font " italic"))
    (setf ctx.fillStyle (or opts.color "#000000"))
    (setf ctx.font ~"{(slice font 1)} {*fontsz*}px {*font*}")))

(defobject line
           (text
             start-signature
             end-signature
             (start-context #())
             (end-context #())
             (sections (list))))

(defobject section (from to style))

(defun signature (d)
  (+ "{"
     (join (map (lambda (k)
                  ~"{k}:{(json (aref d k))}")
                (sort (keys d)))
           ",")
     "}"))

(defobject rcache (text sections w x tx canvas))

(defun draw-line (text sections h w
                       ctx x y tx cache)
  (declare (ignorable h))
  (let* ((key (json (list text sections w x tx)))
         (ix (index key (first cache))))
    (when (= ix -1)
      (push key (first cache))
      (let ((row (create-element "canvas")))
        (setf row.width w)
        (setf row.height h)
        (push row (second cache)))
      (setf ix (1- (length (first cache))))
      (let ((xx 0)
            (ctx ((aref (second cache) ix).getContext "2d")))
        (setf ctx.textBaseline "top")
        (block loop
          (dolist (s sections)
            (when (> (+ x tx) w)
              (return-from loop))
            (when (> s.from xx)
              (let ((part (slice text xx s.from)))
                (font ctx #())
                (ctx.fillText part (+ tx x) *vshift*)
                (incf x (ctx.measureText part).width)
                (setf xx s.from)))
            (when (< (+ tx x) w)
              (let ((part (slice text s.from s.to)))
                (font ctx s.style)
                (let ((pw (ctx.measureText part).width))
                  (when s.style.background
                    (setf ctx.fillStyle s.style.background)
                    (ctx.fillRect (+ tx x) 0 pw h))
                  (setf ctx.fillStyle (or s.style.color "#000000"))
                  (ctx.fillText part (+ tx x) *vshift*)
                  (when s.style.underline
                    (setf ctx.fillStyle s.style.underline)
                    (ctx.fillRect (+ tx x) (+ 0 (1- h)) pw 1))
                  (incf x pw)
                  (setf xx s.to)))))
          (when (< (+ tx x) w)
            (when (> (length text) xx)
              (let ((part (slice text xx)))
                (font ctx #())
                (ctx.fillText part (+ tx x) *vshift*)
                (incf x (ctx.measureText part).width)))))))
    (let ((key (first (splice (first cache) ix 1)))
          (canvas (first (splice (second cache) ix 1))))
      (insert (first cache) 0 key)
      (insert (second cache) 0 canvas)
      (ctx.drawImage canvas 0 y)
      (do () ((< (length (first cache)) 100))
        (pop (first cache))
        (pop (second cache))))))

(defun ifind (text lines row col)
  (let ((lt (if (= text (lowercase text)) #'lowercase (lambda (x) x))))
    (dolist (r (range row (length lines)))
      (let ((i (index text (funcall lt (slice (aref lines r).text col)))))
        (when (>= i 0)
          (return-from ifind (list r (+ i col)))))
      (setf col 0))))

(defvar nullmode
        #((parmatch (lambda (lines row col)
                      (declare (ignorable lines row col))
                      null))
          (compute-end-context (lambda (line)
                                 (declare (ignorable line))
                                 #()))
          (autoindent (lambda (lines row)
                        (do ((i 0 (1+ i)))
                          ((or (= row 0)
                               (/= (aref (aref lines (1- row)).text i) " "))
                           (setf (aref lines row).text
                                 (+ (str-repeat " " i)
                                    (lstrip (aref lines row).text)))
                           (length (aref lines row).text)))))))

(defun search-replace-dialog (callback last-search last-replace last-regexp)
  (let** ((w (window 0 0 0.5 220 title: "Search/replace"))
          (search (add-widget w (input "search")))
          (replace (add-widget w (input "replace")))
          (regexp (add-widget w (checkbox "Regular expression")))
          (ok (add-widget w (button "OK" #'ok default: false)))
          (cancel (add-widget w (button "Cancel" #'cancel)))
          (oldcf document.activeElement)
          (#'ok ()
            (when oldcf (set-timeout (lambda () (oldcf.focus)) 10))
            (hide-window w)
            (funcall callback
                     (text search)
                     (text replace)
                     (checked regexp)))
          (#'cancel ()
            (when oldcf (set-timeout (lambda () (oldcf.focus)) 10))
            (hide-window w)))
    (dolist (f (list search replace))
      (set-handler f onkeydown
                   (let ((block true))
                     (cond
                       ((= event.which 27) (cancel))
                       (true (setf block false)))
                     (when block
                       (event.stopPropagation)
                       (event.preventDefault)))))
    (set-layout w (V border: 8 spacing: 8
                     size: 40
                     (dom search)
                     (dom replace)
                     (dom regexp)
                     size: 30
                     (H :filler:
                        size: 80
                        (dom ok)
                        (dom cancel)
                        :filler:)))
    (setf (text search) last-search)
    (setf (text replace) last-replace)
    (setf (checked regexp) last-regexp)
    (set-timeout (lambda () (search.lastChild.focus)) 10)
    (show-window w center: true)))

(defun goto-line (f)
  (let** ((w (window 0 0 300 140 title: "Goto line" close: false))
          (line (add-widget w (input "line" autofocus: true)))
          (ok (add-widget w (button "OK" #'ok)))
          (cancel (add-widget w (button "Cancel" #'cancel)))
          (#'ok ()
            (let ((n (atoi (text line))))
              (when n
                (hide-window w)
                (funcall f n))))
          (#'cancel ()
            (hide-window w)
            (funcall f null)))
    (set-layout w (V border: 8 spacing: 8
                     size: 40 (dom line)
                     :filler: size: 30
                     (H :filler: size: 80 (dom ok) (dom cancel) :filler:)))
    (show-window w center: true modal: true)))

(defun must-propagate (event)
  (and (or event.metaKey event.altKey event.ctrlKey)
       (or (= event.which #.(char-code "C"))
           (= event.which #.(char-code "X"))
           (= event.which #.(char-code "V")))))

(defun regular-key (event)
  (and (>= event.which 31)
       (not event.metaKey)
       (not event.ctrlKey)
       (not event.altKey)))

(defvar *kbmacro* (list))

(defun editor (name content &optional (mode nullmode))
  (macrolet ((mutate (redo undo)
                     `(progn
                        (when (< (length undo) modified-level)
                          (setf modified-level -1))
                        (push (list (lambda () ,undo) (lambda () ,redo)) undo)
                        (setf redo (list))
                        (setf lastins undefined)
                        (funcall (second (last undo))))))
    (let** ((frame (set-style (create-element "div")
                              position "absolute"))
            (status (set-style (create-element "div")
                               whiteSpace "pre"
                               position "absolute"
                               backgroundColor "#888888"
                               fontFamily "\"Droid Sans mono\",\
                               \"Courier New\",\
                               \"Courier\",\
                               \"monospace\""
                               color "#FFFFFF"))
            (screen (set-style (create-element "canvas")
                               position "absolute"))
            (lines (list))
            (cw null)
            (ch (let ((d (create-element "div"))
                      (r null))
                  (set-style d
                             fontFamily *font*
                             fontSize (+ *fontsz* "px"))
                  (setf d.textContent "Ñgj")
                  (document.body.appendChild d)
                  (setf r (d.getBoundingClientRect))
                  (document.body.removeChild d)
                  (+ *vextra* (- r.bottom r.top))))
            (top 0)
            (left 0)
            (row 0)
            (col 0)
            (s-row 0)
            (s-col 0)
            (ifind-mode false)
            (ifind-text "")
            (ifind-stack (list))
            (ifind-last-text "")
            (ireplace-mode null)
            (last-search "")
            (last-replace "")
            (last-regexp false)
            (hinput (create-element "textarea"))
            (undo (list))
            (redo (list))
            (lastvalid -1)
            (lastins undefined)
            (focused false)
            (modified-level 0)
            (wordlist (list))
            (from-autocomplete false)
            (kbrecording false)
            (goto-targets #())
            (draw-cache (list (list) (list)))
            (#'set-goto-target (char)
              (baloon ~"Position {char} saved")
              (setf (aref goto-targets char)
                    (list row col s-row s-col
                          left top)))
            (#'goto (char)
              (setf ireplace-mode null)
              (setf ifind-mode false)
              (let ((x (aref goto-targets char)))
                (when x
                  (baloon ~"Position {char}")
                  (setf row (first x))
                  (setf col (second x))
                  (setf s-row (third x))
                  (setf s-col (fourth x))
                  (setf left (fifth x))
                  (setf top (sixth x))
                  (fix))))
            (#'search (regexp)
              (do ((r row)
                   (c col))
                ((or (>= r (length lines))
                     (regexp.exec (slice (aref lines r).text c)))
                 (if (< r (length lines))
                     (let ((m (regexp.exec (slice (aref lines r).text c))))
                       (list r (+ c m.index) (+ c m.index (length (first m)))))))
                (incf r)
                (setf c 0)))
            (#'search-replace (search replace regexp)
              (setf last-search search)
              (setf last-replace replace)
              (setf last-regexp regexp)
              (setf search (if regexp
                               (regexp search)
                               (regexp (regexp-escape search))))
              (unless regexp
                (setf replace (replace replace "\\$" "$$$$")))
              (setf ireplace-mode #((search search)
                                    (replace replace)))
              (hinput.focus)
              (search-replace-next "N"))
            (#'search-replace-next (action)
              (do () ((not ireplace-mode))
                (when (/= action "N")
                  (let* ((line (aref lines row).text)
                         (res (replace (slice line s-col col)
                                       ireplace-mode.search
                                       ireplace-mode.replace)))
                    (change-line row
                                 (+ col
                                    (- (length res) (- col s-col)))
                                 (+ (slice line 0 s-col)
                                    res
                                    (slice line col)))))
                (let ((x (search ireplace-mode.search)))
                  (if (and x (/= (second x) (third x)))
                      (progn
                        (setf row (first x))
                        (setf s-col (second x))
                        (setf s-row row)
                        (setf col (third x))
                        (setf top (max 0 (- row 10)))
                        (when (/= action "!")
                          (fix)
                          (return-from search-replace-next)))
                      (setf ireplace-mode null))))
              (fix))
            (#'ensure (r)
              (do ()
                ((>= lastvalid r))
                (let ((start-signature (if (= lastvalid -1)
                                           "{}"
                                           (aref lines lastvalid).end-signature))
                      (line (aref lines (1+ lastvalid))))
                  (unless (= start-signature line.start-signature)
                    (setf line.start-signature start-signature)
                    (setf line.start-context
                          (if (= lastvalid -1)
                              #()
                              (aref lines lastvalid).end-context))
                    (setf line.end-context
                          (mode.compute-end-context line))
                    (setf line.end-signature
                          (signature line.end-context)))
                  (incf lastvalid))))
            (#'touch (r)
              (when (<= r lastvalid)
                (setf lastvalid (1- r)))
              (setf (aref lines r).start-signature null))
            (#'refresh ()
              (dolist (L lines)
                (setf L.start-signature null))
              (setf lastvalid -1)
              (update))
            (#'modified ()
              (/= (length undo) modified-level))
            (#'clear-modified ()
              (setf modified-level (length undo))
              (update))
            (#'update ()
              (setf screen.width screen.offsetWidth)
              (setf screen.height screen.offsetHeight)
              (let ((cr top)
                    (ctx (screen.getContext "2d"))
                    (info "")
                    (changed (if (modified) "*" "")))
                (when (null? cw)
                  (font ctx #())
                  (setf cw (/ (ctx.measureText "XXXXXXXXXX").width 10)))
                (setf ctx.fillStyle (cond
                                      (kbrecording "#FFFFDD")
                                      (ifind-mode "#DDFFFF")
                                      (ireplace-mode "#DDFFDD")
                                      (true "#FFFFFF")))
                (ctx.fillRect 0 0 screen.width screen.height)
                (setf ctx.textBaseline "top")
                (do () ((or (>= cr (length lines))
                            (>= (* (- cr top) ch) screen.offsetHeight))
                        (cond
                          (ifind-mode
                            (setf info ~"Incremental search: \"{ifind-text}\""))
                          (ireplace-mode
                            (setf info ~"Replace? (Y/N/!)"))
                          (true
                            (when (and (> col 0)
                                       (find (aref lines row "text" (1- col))
                                             "})]"))
                              (let ((m (mode.parmatch lines row col)))
                                (when m
                                  (let ((y0 (* (- (first m) top) ch))
                                        (x0 (* (- (second m) left) cw))
                                        (y1 (* (- row top) ch))
                                        (x1 (* (- col left 1) cw)))
                                    (setf ctx.fillStyle "rgba(255,0,0,0.25)")
                                    (ctx.fillRect x0 y0 (+ cw 2) (+ ch 2))
                                    (ctx.fillRect x1 y1 (+ cw 2) (+ ch 2))
                                    (setf info (+ "Match: \""
                                                  (slice (aref lines (first m)).text
                                                         (second m)
                                                         (+ (second m) 20))
                                                  "\""))))))))
                        (let ((coords (cond
                                        ((and (= row s-row) (= col s-col))
                                         (+ (1+ row) ":" col))
                                        ((= row s-row)
                                         (+ (1+ row) ":"
                                            (min col s-col) "-"
                                            (max col s-col)))
                                        (true
                                          (+ (1+ (min row s-row))
                                             ":"
                                             (if (< row s-row) col s-col)
                                             "-"
                                             (1+ (max row s-row))
                                             ":"
                                             (if (< row s-row) s-col col))))))
                          (setf status.textContent
                                ~" {name}{changed} \
                                ({coords}) \
                                {info}")))
                  (ensure cr)
                  (let ((line (aref lines cr))
                        (s0 (min row s-row))
                        (s1 (max row s-row)))
                    (when (<= s0 cr s1)
                      (let ((x0 0)
                            (x1 0))
                        (cond
                          ((= s0 s1)
                           (setf x0 (min col s-col))
                           (setf x1 (max col s-col)))
                          ((= cr s0)
                           (setf x0 (if (< row s-row) col s-col))
                           (setf x1 (1+ (length line.text))))
                          ((= cr s1)
                           (setf x1 (if (< row s-row) s-col col)))
                          (true
                            (setf x1 (1+ (length line.text)))))
                        (when (> x1 (length line.text))
                          (setf x1 (+ 1 left (floor (/ screen.offsetWidth cw)))))
                        (when (< x0 x1)
                          (setf ctx.fillStyle "#FFFF00")
                          (ctx.fillRect (* (- x0 left) cw)
                                        (* (- cr top) ch)
                                        (* (- x1 x0) cw)
                                        ch))))
                    (draw-line line.text line.sections
                               ch screen.offsetWidth
                               ctx 0 (* (- cr top) ch) (- (* cw left))
                               draw-cache)
                    (when (and focused (= cr row))
                      (setf ctx.fillStyle "#FF0000")
                      (ctx.fillRect (* cw (- col left)) (* ch (- cr top))
                                    2 ch))
                    (incf cr)))))
            (#'words ()
              (let* ((nonword (regexp (or mode.nonword "[^a-zA-Z_]")))
                     (before (split (join (map (get text) (slice lines 0 (1+ row))) "\n")
                                    nonword))
                     (after (split (join (map (get text) (slice lines (1+ row))) "\n")
                                   nonword))
                     (seen #())
                     (result (list)))
                (dolist (word (append (reverse before)
                                      after
                                      (if mode.words (mode.words) (list))))
                  (unless (aref seen word)
                    (setf (aref seen word) true)
                    (push word result)))
                result))
            (#'fix ()
              (let ((screen-lines (floor (/ screen.offsetHeight ch)))
                    (screen-cols (floor (/ screen.offsetWidth cw))))
                (when (or (NaN? screen-lines) (< screen-lines 1))
                  (setf screen-lines 1))
                (when (or (NaN? screen-cols) (< screen-cols 1))
                  (setf screen-cols 1))
                (setf row (max 0 (min (1- (length lines)) row)))
                (setf col (max 0 (min (length (aref lines row).text) col)))
                (setf s-row (max 0 (min (1- (length lines)) s-row)))
                (setf s-col (max 0 (min (length (aref lines s-row).text) s-col)))
                (setf left (max 0 (- col screen-cols) (min left col)))
                (setf top (max 0 (- row -1 screen-lines) (min row top (- (length lines) screen-lines)))))
              (update))
            (#'selection ()
              (let ((txt ""))
                (if (= row s-row)
                    (setf txt (slice (aref lines row).text
                                     (min col s-col)
                                     (max col s-col)))
                    (let ((r0 (min row s-row))
                          (r1 (max row s-row))
                          (c0 (if (< row s-row) col s-col))
                          (c1 (if (< row s-row) s-col col)))
                      (setf txt (+ (slice (aref lines r0).text c0) "\n"))
                      (dotimes (i (- r1 r0 1))
                        (incf txt (+ (aref lines (+ r0 i 1)).text "\n")))
                      (incf txt (slice (aref lines r1).text 0 c1))))
                txt))
            (#'clipboard-copy (&optional quiet)
              (when (or (/= col s-col) (/= row s-row))
                (setf ireplace-mode null)
                (setf ifind-mode false)
                (setf wordlist (list))
                (setf hinput.value (selection))
                (hinput.setSelectionRange 0 (length hinput.value))
                (hinput.focus)
                (unless quiet
                  (baloon ~"{(length hinput.value)} char copied"))
                (set-timeout (lambda () (setf hinput.value "")) 100)))
            (#'insert-text (text)
              (when (or (/= col s-col) (/= row s-row))
                (delete-selection))
              (let ((pasted-lines (split (replace text "\r" "") "\n"))
                    (start-row row))
                (let ((r0 row)
                      (c0 col)
                      (r1 null)
                      (c1 null))
                  (mutate
                    (let ((line (aref lines r0))
                          (r r0)
                          (c c0))
                      (if (= (length pasted-lines) 1)
                          (progn
                            (setf line.text
                                  (+ (slice line.text 0 c)
                                     (aref pasted-lines 0)
                                     (slice line.text c)))
                            (setf col (+ c (length (aref pasted-lines 0))))
                            (setf row r)
                            (touch r))
                          (let ((tail (slice line.text c)))
                            (setf line.text
                                  (+ (slice line.text 0 c)
                                     (aref pasted-lines 0)))
                            (touch r)
                            (dotimes (i (- (length pasted-lines) 2))
                              (let ((newline (new-line (aref pasted-lines (1+ i)))))
                                (incf r)
                                (insert lines r newline)))
                            (let ((newline (new-line (+ (last pasted-lines) tail))))
                              (incf r)
                              (insert lines r newline)
                              (setf row r)
                              (setf col (length (last pasted-lines))))))
                      (setf s-col col)
                      (setf s-row row)
                      (setf r1 row)
                      (setf c1 col))
                    (let ((line (aref lines r0)))
                      (setf line.text
                            (+ (slice line.text 0 c0)
                               (slice (aref lines r1).text c1)))
                      (when (> r1 r0)
                        (splice lines (1+ r0) (- r1 r0)))
                      (touch r0)
                      (setf row r0)
                      (setf col c0)
                      (setf s-row r0)
                      (setf s-col c0))))
                (fix)
                (list start-row row)))
            (#'clipboard-cut ()
              (when (or (/= col s-col) (/= row s-row))
                (clipboard-copy true)
                (delete-selection)
                (fix)))
            (#'clipboard-paste ()
              (setf ireplace-mode null)
              (setf ifind-mode false)
              (setf wordlist (list))
              (setf hinput.value "")
              (hinput.focus)
              (set-timeout (lambda ()
                             (insert-text hinput.value)
                             (setf hinput.value ""))
                           100))
            (#'change-line (r c text)
              (setf wordlist (list))
              (let ((oldtext (aref lines r).text)
                    (oldr row)
                    (oldc col)
                    (oldsr s-row)
                    (oldsc s-col)
                    (l-undo (if (= lastins r)
                                (first (pop undo)))))
                (mutate
                  (progn
                    (setf (aref lines r).text text)
                    (setf row r)
                    (setf col c)
                    (setf s-row row)
                    (setf s-col col)
                    (touch r))
                  (progn
                    (setf (aref lines r).text oldtext)
                    (setf row oldr)
                    (setf col oldc)
                    (setf s-row oldsr)
                    (setf s-col oldsc)
                    (touch r)))
                (when l-undo
                  (setf (first (last undo)) l-undo))
                (setf lastins r)))
            (#'indent-selection ()
              (let ((oldpos (list row col s-row s-col))
                    (old (map (get text)
                              (slice lines
                                     (min row s-row)
                                     (1+ (max row s-row))))))
                (mutate
                  (progn
                    (setf (list row col s-row s-col) oldpos)
                    (dolist (r (range (min row s-row) (1+ (max row s-row))))
                      (when (> r 0)
                        (ensure (1- r)))
                      (mode.autoindent lines r)
                      (unless (= r row)
                        (setf (aref lines r).text (rstrip (aref lines r).text)))
                      (touch r))
                    (setf col (length (aref lines row).text))
                    (setf s-row row)
                    (setf s-col col))
                  (progn
                    (setf (list row col s-row s-col) oldpos)
                    (let ((wp (min s-row row)))
                      (dolist (x old)
                        (setf (aref lines wp).text x)
                        (touch wp)
                        (incf wp)))))
                (fix)))
            (#'delete-selection ()
              (setf wordlist (list))
              (if (= row s-row)
                  (let ((text (aref lines row).text)
                        (r row)
                        (cc col)
                        (sc s-col))
                    (mutate
                      (progn
                        (setf (aref lines r).text
                              (+ (slice text 0 (min cc sc))
                                 (slice text (max cc sc))))
                        (setf row r)
                        (setf col (min cc sc))
                        (setf s-col col)
                        (touch r))
                      (progn
                        (setf (aref lines r).text text)
                        (setf row r)
                        (setf col cc)
                        (setf s-col sc)
                        (touch r))))
                  (let ((changed-lines null)
                        (org-r0 null)
                        (rr row)
                        (cc col)
                        (sr s-row)
                        (sc s-col)
                        (r0 (min row s-row))
                        (r1 (max row s-row))
                        (c0 (if (< row s-row) col s-col))
                        (c1 (if (< row s-row) s-col col)))
                    (mutate
                      (progn
                        ;; Move lines to var for undo
                        (setf changed-lines
                              (slice lines (1+ r0) (1+ r1)))
                        (setf org-r0 (aref lines r0).text)
                        ;; Delete the lines
                        (setf (aref lines r0).text
                              (+ (slice (aref lines r0).text 0 c0)
                                 (slice (aref lines r1).text c1)))
                        (splice lines (1+ r0) (- r1 r0))
                        (setf row r0)
                        (setf col c0)
                        (setf s-row row)
                        (setf s-col col)
                        (touch row))
                      (progn
                        ;; Recover
                        (setf (aref lines r0).text org-r0)
                        (setf lines (append (slice lines 0 (1+ r0))
                                            changed-lines
                                            (slice lines (1+ r0))))
                        (setf changed-lines null)
                        (setf row rr)
                        (setf col cc)
                        (setf s-row sr)
                        (setf s-col sc)
                        (dolist (r (range r0 (1+ r1)))
                          (touch r)))))))
            (#'undo ()
              (setf wordlist (list))
              (when (> (length undo) 0)
                (setf lastins undefined)
                (funcall (first (last undo)))
                (push (pop undo) redo)))
            (#'redo ()
              (setf wordlist (list))
              (when (> (length redo) 0)
                (setf lastins undefined)
                (funcall (second (last redo)))
                (push (pop redo) undo)))
            (#'exec (cmd)
              (case cmd
                ("copy" (clipboard-copy))
                ("cut" (clipboard-cut))
                ("paste" (clipboard-paste))
                ("goto-line" (goto-line (lambda (L)
                                          (when (and L (<= 1 L (1+ (length lines))))
                                            (setf row (1- L))
                                            (setf col 0)
                                            (setf s-row (1- L))
                                            (setf s-col 0)
                                            (fix))
                                          (focus frame))))
                ("indent" (indent-selection))
                ("autocomplete"
                   (when (and (= row s-row) (>= s-col col))
                     (let ((line (aref lines row).text)
                           (nonword (regexp (or mode.nonword "[^a-zA-Z]")))
                           (i col)
                           (words (if (length wordlist)
                                      wordlist
                                      (setf wordlist (words)))))
                       (do () ((or (= i 0) (nonword.exec (aref line (1- i)))))
                         (decf i))
                       (when (and (< i col) (length words))
                         (let* ((prefix (slice line i col))
                                (cw (+ prefix (selection)))
                                (matching (filter (lambda (x)
                                                    (= (slice x 0 (length prefix)) prefix))
                                                  (slice words 1)))
                                (ci (index cw matching)))
                           (when (length matching)
                             (setf ci (% (1+ ci) (length matching)))
                             (setf line (+ (slice line 0 col)
                                           (slice (aref matching ci) (- col i))
                                           (slice line s-col)))
                             (change-line row col line)
                             (setf s-col (+ i (length (aref matching ci))))
                             (setf wordlist words)))))))
                ("def-0" (set-goto-target "0"))
                ("def-1" (set-goto-target "1"))
                ("def-2" (set-goto-target "2"))
                ("def-3" (set-goto-target "3"))
                ("def-4" (set-goto-target "4"))
                ("def-5" (set-goto-target "5"))
                ("def-6" (set-goto-target "6"))
                ("def-7" (set-goto-target "7"))
                ("def-8" (set-goto-target "8"))
                ("def-9" (set-goto-target "9"))
                ("goto-0" (goto "0"))
                ("goto-1" (goto "1"))
                ("goto-2" (goto "2"))
                ("goto-3" (goto "3"))
                ("goto-4" (goto "4"))
                ("goto-5" (goto "5"))
                ("goto-6" (goto "6"))
                ("goto-7" (goto "7"))
                ("goto-8" (goto "8"))
                ("goto-9" (goto "9"))
                ("find-replace"
                   (setf ifind-mode false)
                   (setf ireplace-mode null)
                   (search-replace-dialog
                    #'search-replace
                    last-search
                    last-replace
                    last-regexp))
                ("page-up"
                   (let ((delta (floor (/ screen.offsetHeight ch))))
                     (decf top delta)
                     (decf row delta)))
                ("page-down"
                   (let ((delta (floor (/ screen.offsetHeight ch))))
                     (incf top delta)
                     (incf row delta)))
                ("line-end" (setf col (length (aref lines row).text)))
                ("text-end" (setf row (1- (length lines))) (setf col (length (aref lines row).text)))
                ("line-begin" (setf col 0))
                ("text-begin" (setf row 0) (setf col 0))
                ("left"
                   (if (> col 0)
                       (decf col)
                       (when (> row 0)
                         (decf row)
                         (setf col (length (aref lines row).text)))))
                ("right"
                   (if (< col (length (aref lines row).text))
                       (incf col)
                       (when (< row (1- (length lines)))
                         (incf row)
                         (setf col 0))))
                ("down"
                   (if (< row (1- (length lines)))
                       (progn
                         (incf row)
                         (when (> col (length (aref lines row).text))
                           (setf col (length (aref lines row).text))))
                       (setf col (length (aref lines row).text))))
                ("up"
                   (if (> row 0)
                       (progn
                         (decf row)
                         (when (> col (length (aref lines row).text))
                           (setf col (length (aref lines row).text))))
                       (setf col 0)))
                ("delete"
                   (when (and (= row s-row) (= col s-col))
                     (if (< s-col (length (aref lines row).text))
                         (incf s-col)
                         (when (< s-row (1- (length lines)))
                           (incf s-row)
                           (setf s-col 0))))
                   (delete-selection))
                ("backspace"
                   (if ifind-mode
                       (progn
                         (when (> (length ifind-text) 0)
                           (setf row (first (last ifind-stack)))
                           (setf col (second (last ifind-stack)))
                           (setf top (third (last ifind-stack)))
                           (setf left (fourth (last ifind-stack)))
                           (setf ifind-text (fifth (last ifind-stack)))
                           (setf ifind-last-text ifind-text)
                           (pop ifind-stack)
                           (setf s-row row)
                           (setf s-col (+ col (length ifind-text))))
                         (fix))
                       (if (and (= row s-row) (= col s-col))
                           (if (> col 0)
                               (let ((text (aref lines row).text))
                                 (change-line row (1- col)
                                              (+ (slice text 0 (1- col))
                                                 (slice text col))))
                               (when (> row 0)
                                 (let ((rr row)
                                       (sz (length (aref lines row).text)))
                                   (mutate
                                    (let ((line (aref lines rr))
                                          (prev-line (aref lines (1- rr))))
                                      (setf col (length prev-line.text))
                                      (incf prev-line.text line.text)
                                      (splice lines rr 1)
                                      (touch (1- rr))
                                      (setf row (1- rr))
                                      (setf s-col col)
                                      (setf s-row row))
                                    (let* ((prev-line (aref lines (1- rr)))
                                           (line (new-line (slice prev-line.text (- sz)))))
                                      (setf prev-line.text (slice prev-line.text 0 (- sz)))
                                      (insert lines rr line)
                                      (setf row rr)
                                      (setf col 0)
                                      (setf s-col col)
                                      (setf s-row row)
                                      (touch (1- rr))
                                      (touch rr))))))
                           (delete-selection))))
                ("enter"
                   (if ifind-mode
                       (setf ifind-mode false)
                       (progn
                         (when (or (/= row s-row) (/= col s-col))
                           (if from-autocomplete
                               (progn
                                 (setf row s-row)
                                 (setf col s-col))
                               (delete-selection)))
                         (let* ((r row)
                                (c col)
                                (text (aref lines row).text))
                           (mutate
                            (let ((line (aref lines r))
                                  (newline (new-line (slice text c))))
                              (setf line.text (rstrip (slice text 0 c)))
                              (touch r)
                              (setf row (1+ r))
                              (insert lines row newline)
                              (setf col (or (mode.autoindent lines row) 0))
                              (touch (1+ r))
                              (setf s-row row)
                              (setf s-col col))
                            (let ((line (aref lines r)))
                              (setf line.text text)
                              (splice lines (1+ r) 1)
                              (touch r)
                              (setf row r)
                              (setf col c)
                              (setf s-row row)
                              (setf s-col col)))))))
                ("esc"
                   (when ifind-mode
                     (setf ifind-mode false)
                     (setf row (first (first ifind-stack)))
                     (setf col (second (first ifind-stack)))
                     (setf top (third (first ifind-stack)))
                     (setf left (fourth (first ifind-stack)))
                     (fix)))
                ("isearch"
                   (setf ireplace-mode null)
                   (if ifind-mode
                       (progn
                         (when (= ifind-text "")
                           (setf ifind-text ifind-last-text))
                         (let ((f (ifind ifind-text lines row (+ col (length ifind-text)))))
                           (when f
                             (push (list row col top left ifind-text) ifind-stack)
                             (setf row (first f))
                             (setf col (second f))
                             (setf s-row row)
                             (setf s-col (+ col (length ifind-text))))))
                       (progn
                         (setf ifind-mode true)
                         (setf ifind-text "")
                         (setf ifind-stack (list (list row col top left ifind-text)))))
                   (fix))
                ("undo"
                   (setf ireplace-mode null)
                   (setf ifind-mode false)
                   (undo)
                   (fix))
                ("redo"
                   (setf ireplace-mode null)
                   (setf ifind-mode false)
                   (redo)
                   (fix))))
            (#'insert-char (char)
              (cond
                (ifind-mode
                 (let* ((tx (+ ifind-text char))
                        (f (ifind tx lines row col)))
                   (when f
                     (push (list row col top left ifind-text) ifind-stack)
                     (setf row (first f))
                     (setf col (second f))
                     (setf ifind-text tx)
                     (setf ifind-last-text tx)
                     (setf s-row row)
                     (setf s-col (+ col (length tx))))))
                (ireplace-mode
                 (when (find char "ynYN!")
                   (search-replace-next (uppercase char))))
                ((>= char " ")
                 (when (or (/= row s-row) (/= col s-col))
                   (if from-autocomplete
                       (progn
                         (setf row s-row)
                         (setf col s-col))
                       (delete-selection)))
                 (let ((text (aref lines row).text))
                   (change-line row (1+ col)
                                (+ (slice text 0 col)
                                   char
                                   (slice text col))))))))
      (setf frame.lines (lambda () lines))
      (setf frame.selection #'selection)
      (setf frame.pos (lambda () (list row col)))
      (setf frame.set-pos (lambda (r c sr sc)
                            (setf row r)
                            (setf col c)
                            (setf s-row sr)
                            (setf s-col sc)
                            (fix)))
      (setf frame.name (lambda () name))
      (setf frame.rename (lambda (x)
                           (setf name x)
                           (update)))
      (setf frame.buffer (lambda ()
                           (join (map (get text) lines) "\n")))
      (setf frame.modified #'modified)
      (setf frame.clear-modified #'clear-modified)
      (setf frame.update #'update)
      (setf frame.focus (lambda () (hinput.focus)))
      (setf frame.words #'words)
      (setf frame.refresh #'refresh)
      (setf frame.insert-text #'insert-text)
      (setf frame.indent-selection #'indent-selection)
      (set-style hinput
                 position "fixed"
                 px/left 0
                 px/top -100
                 px/width 1
                 px/height 1
                 outline "none"
                 border "none"
                 px/padding 0
                 px/margin 0)
      (append-child frame screen)
      (append-child frame status)
      (append-child frame hinput)
      (dolist (L (split content "\n"))
        (push (new-line L) lines))
      (setf frame."data-resize"
            (lambda (x0 y0 x1 y1)
              (set-style screen
                         px/left 0
                         px/top 0
                         px/width (round (- x1 x0))
                         px/height (round (- y1 y0 ch)))
              (set-style status
                         px/left 0
                         px/top (round (- y1 y0 ch))
                         px/width (round (- x1 x0))
                         px/height ch)
              (update)))
      (set-handler frame onmousewheel
        (let ((delta (floor (/ event.wheelDelta -60)))
              (screen-lines (floor (/ screen.offsetHeight ch))))
          (setf top (max 0 (min (+ top delta) (- (length lines) screen-lines)))))
        (update))
      (set-handler hinput onkeydown
        (let ((cmd (aref *keybindings* (key-name event))))
          (if cmd
              (progn
                (cond
                  ((= cmd "record-macro")
                   (setf *kbmacro* (list))
                   (setf kbrecording true)
                   (baloon "Starting keyboard macro recording"))
                  ((= cmd "play-macro")
                   (if kbrecording
                       (progn
                         (setf kbrecording false)
                         (baloon "Stop keyboard macro recording"))
                       (dolist (c *kbmacro*)
                         (if (= "insert-char" (first c))
                             (insert-char (second c))
                             (progn
                               (exec (first c))
                               (setf from-autocomplete (= (first c) "autocomplete"))
                               (unless (second c)
                                 (setf s-row row)
                                 (setf s-col col))))
                         (fix))))
                  (true
                   (exec cmd)
                   (when kbrecording
                     (push (list cmd (or event.shiftKey ifind-mode from-autocomplete))
                           *kbmacro*))))
                (unless (find cmd '("isearch" "backspace"))
                  (setf ifind-mode false)
                  (setf ireplace-mode null))
                (unless (must-propagate event)
                  (event.preventDefault)
                  (event.stopPropagation))
                (setf from-autocomplete (= cmd "autocomplete"))
                (unless (or event.shiftKey
                            ifind-mode
                            from-autocomplete
                            (= cmd "paste")
                            (= cmd "play-macro"))
                  (setf s-row row)
                  (setf s-col col))
                (fix)
                true)
              false)))
    (set-handler hinput onfocus
      (setf focused true)
      (update))
    (set-handler hinput onblur
      (setf focused false)
      (update))
    (set-handler hinput onkeypress
      (when (regular-key event)
        ;; Stop regular typing only (ctrl-cxv needs propagating)
        (event.preventDefault)
        (event.stopPropagation))
      (when kbrecording
        (push (list "insert-char" (char event.keyCode)) *kbmacro*))
      (insert-char (char (or event.keyCode event.charCode)))
      (fix))
    (set-handler screen onmousedown
                   (setf ireplace-mode null)
                   (setf ifind-mode false)
                   (hinput.focus)
                   (labels ((pos (x y)
                                 (let (((x0 y0) (element-pos screen)))
                                   (decf x x0)
                                   (decf y y0)
                                   (if (and (< 0 x screen.clientWidth)
                                            (< 0 y screen.clientHeight))
                                       (let ((a (max 0 (min (1- (length lines)) (+ (floor (/ y ch)) top)))))
                                         (list a (max 0 (min (+ left (floor (/ x cw))) (length (aref lines a).text)))))
                                       (list null null)))))
                     (let (((r c) (apply #'pos (event-pos event))))
                       (unless (null? r)
                         (event.preventDefault)
                         (event.stopPropagation)
                         (setf row r)
                         (setf col c)
                         (setf s-row r)
                         (setf s-col c)
                         (fix)
                         (let* ((scroller-delta 0)
                                (scroller (set-interval (lambda ()
                                                          (incf top scroller-delta)
                                                          (incf row scroller-delta)
                                                          (fix))
                                                        20)))
                           (tracking (lambda (x y)
                                       (let (((r c) (pos x y)))
                                         (if (null? r)
                                             (let (((sx sy) (element-pos screen))
                                                   (sh screen.offsetHeight))
                                               (declare (ignorable sx))
                                               (when (< y sy)
                                                 (setf scroller-delta (floor (/ (- y sy) ch))))
                                               (when (> y (+ sy sh))
                                                 (setf scroller-delta (1+ (floor (/ (- y (+ sy sh)) ch))))))
                                             (progn
                                               (setf scroller-delta 0)
                                               (setf row r)
                                               (setf col c)
                                               (fix)))))
                                     (lambda () (clear-interval scroller))))))))
      (set-timeout #'fix 10)
      (set-timeout (lambda () (hinput.focus)) 10)
      frame)))

(defun fullscreen-editor (name content &optional (mode nullmode))
  (let ((editor (editor name content mode))
        (frame (create-element "div")))
    (set-style frame
               position "absolute"
               px/left 8
               px/top 8
               px/bottom 8
               px/right 8)
    (set-style editor
               position "absolute"
               px/left 0
               px/top 0)
    (append-child frame editor)
    (append-child document.body frame)
    (let ((fw 0) (fh 0))
      (set-interval (lambda ()
                      (let ((w frame.offsetWidth)
                            (h frame.offsetHeight))
                        (when (or (/= w fw) (/= h fh))
                          (setf fw w)
                          (setf fh h)
                          (set-style editor
                                     px/left 0
                                     px/top 0
                                     px/width fw
                                     px/height fh)
                          (editor."data-resize" 0 0 fw fh))))
                    10))
    editor))

(export editor fullscreen-editor nullmode new-section)