diff options
| -rw-r--r-- | jterm.hs | 50 |
1 files changed, 29 insertions, 21 deletions
@@ -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 |