unify buffer editing through delins and fix ptycursor movement

1 files changed, 29 insertions, 21 deletions

diff --git a/jterm.hs b/jterm.hs
index 812f085..681c283 100644
--- a/jterm.hs
+++ b/jterm.hs
@@ -344,13 +344,13 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do
               case (mod, keysym) of
                 (4, 117) ->
                   -- ctrl-u (delete content before cursor)
-                  delins' 0 start ""
+                  delins 0 start ""
                 (4, 105) ->
                   -- ctrl-i (delete content after cursor)
-                  delins' end (R.length (content b)) ""
+                  delins end (R.length (content b)) ""
                 (4, 108) ->
                   -- ctrl-l (restrip buffer of ansi codes)
-                  delins' 0 (R.length (content b)) (content b & R.toText & stripAnsiEscapeCodes & R.fromText)
+                  delins 0 (R.length (content b)) (content b & R.toText & stripAnsiEscapeCodes & R.fromText)
                 (4, 99) -> lift $ do
                   -- ctrl-c (copy)
                   storeBuffer display (R.toText selstr & T.unpack) 0
@@ -359,7 +359,7 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do
                 (4, 120) -> do
                   -- ctrl-x (cut)
                   lift $ storeBuffer display (R.toText selstr & T.unpack) 0
-                  delins' start end ""
+                  delins start end ""
                 (4, 118) -> lift $ do
                   -- ctrl-v (paste)
                   prop <- internAtom display "JTERM_CLIPBOARD" True
@@ -401,23 +401,20 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do
                   scrolldown ((681 * pageheight) `div` 1000)
                 (_, 65288) -> do
                   -- backspace
-                  delins' (start - 1) end ""
+                  delins (start - 1) end ""
                 _ -> when (toAppend /= "") $ do
-                  delins' start end toAppend
-                  when (toAppend == "\n" && start >= ptycursor b) $ sendline
+                  delins start end toAppend
+                  when (toAppend == "\n" && start == R.length (content b)) $ sendline
       redraw
     T toAppend -> do
-      let c = content b <> R.fromText expandedTabs
-          pos = R.length c
-          noesc = stripAnsiEscapeCodes toAppend
+      let noesc = stripAnsiEscapeCodes toAppend
           expandedTabs = T.intercalate "\n" $ map expandTabs $ T.splitOn "\n" noesc
-      put $ b {content = c, ptycursor = pos}
-      when (start == R.length (content b)) $ modify $ \b -> b {cursor = (pos, pos)}
+      delins' True (ptycursor b) (ptycursor b) $ R.fromText expandedTabs
       redraw
     Notify -> do
       prop <- lift $ internAtom display "JTERM_CLIPBOARD" False
       Just (R.fromText . T.pack . map castCCharToChar -> str) <- lift $ getWindowProperty8 display prop win
-      delins' start end str
+      delins start end str
       redraw
     Expose -> redraw
     Selection e -> lift $ allocaXEvent $ \ev -> do
@@ -437,6 +434,7 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do
     sendline = do
       b <- get
       let cmd = between (ptycursor b) (R.length $ content b) (content b)
+      put $ b {ptycursor = R.length (content b)}
       lift $ send b $ cmd
 
     sendCommand b c = do
@@ -449,18 +447,28 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do
 
     between s e rp = R.splitAt e rp & fst & R.splitAt s & snd
     
-    delins' s e ins = do
+    delins = delins' False
+    
+    delins' movepty s e ins = do
       b <- get
       let l = R.length ins
-          delta = p + l + s - e
           p = ptycursor b
-      put $ b {content = delins s e (content b) ins, cursor = (s + l, s + l), ptycursor = if e < p then delta else if s < p then s else p}
+          p' = if e < p then p + l + s - e 
+               else if s < p then s 
+               else p
+          (cs, ce) = cursor b
+          c' = if cs <= e && ce > e then (s + l, ce)
+               else if cs < s && ce >= s then (cs, s)
+               else if cs >= s && ce <= e then (s + l, s + l)
+               else if ce < s then (cs, ce)
+               else (cs + l + s - e, ce + l + s - e)
+      put $ b {content = doedit s e (content b) ins, cursor = c', ptycursor = if movepty then s + l else p'}
 
-    delins :: Word -> Word -> Rope -> Rope -> Rope
-    delins s e rp ins =
-      let (before, _) = R.splitAt s rp
-          (_, after) = R.splitAt e rp
-       in before <> ins <> after
+      where
+        doedit s e rp ins =
+           let (before, _) = R.splitAt s rp
+               (_, after) = R.splitAt e rp
+           in before <> ins <> after
 
     xy2lc :: Word -> Word -> IO (Word, Word)
     xy2lc x y = do