diff options
| -rw-r--r-- | jterm.hs | 81 |
1 files changed, 51 insertions, 30 deletions
@@ -32,6 +32,10 @@ import System.Posix.Pty doubleClickDelay = 300 +a -. b + | b > a = 0 + | otherwise = a - b + data Buffer = Buffer { pos :: Word, content :: Rope, @@ -41,39 +45,50 @@ data Buffer = Buffer lastLeftClick :: Time } +search :: Rope -> Rope -> Word -> Maybe Word +search needle haystack p = go (n - 1) (p + n) + where + index rope i = R.splitAt (i + 1) rope & fst & R.splitAt i & snd + go i j + | j > R.length haystack = Nothing + | index needle i == index haystack j = if i == 0 then Just j else go (i - 1) (j - 1) + | otherwise = go (n - 1) $ j + n - i + + n = R.length needle + expandAround :: Rope -> Word -> (Word, Word) expandAround rp p = - case (getc p, getc (p+2)) of - ("(", _) -> (p, searchFor True 0 (=="(") (==")") (p+1)) - (_, ")") -> (searchFor False 0 (==")") (=="(") p, p+1) - ("[", _) -> (p, searchFor True 0 (=="[") (=="]") (p+1)) - (_, "]") -> (searchFor False 0 (=="]") (=="[") p, p + 1) - ("{", _) -> (p, searchFor True 0 (=="{") (=="}") (p+1)) - (_, "}") -> (searchFor False 0 (=="}") (=="{") p, p + 1) - ("'", _) -> (p, searchFor True 0 (=="'") (=="'") (p + 1)) - (_, "'") -> (searchFor False 0 (=="'") (=="'") p, p + 1) - ("\"", _) -> (p, searchFor True 0 (=="\"") (=="\"") (p + 1)) - (_, "\"") -> (searchFor False 0 (=="\"") (=="\"") p, p + 1) - ("`", _) -> (p, searchFor True 0 (=="`") (=="`") (p + 1)) - (_, "`") -> (searchFor False 0 (=="`") (=="`") p, p + 1) + case (getc p, getc (p + 2)) of + ("(", _) -> (p, searchFor True 0 (== "(") (== ")") (p + 1)) + (_, ")") -> (searchFor False 0 (== ")") (== "(") p, p + 1) + ("[", _) -> (p, searchFor True 0 (== "[") (== "]") (p + 1)) + (_, "]") -> (searchFor False 0 (== "]") (== "[") p, p + 1) + ("{", _) -> (p, searchFor True 0 (== "{") (== "}") (p + 1)) + (_, "}") -> (searchFor False 0 (== "}") (== "{") p, p + 1) + ("'", _) -> (p, searchFor True 0 (== "'") (== "'") (p + 1)) + (_, "'") -> (searchFor False 0 (== "'") (== "'") p, p + 1) + ("\"", _) -> (p, searchFor True 0 (== "\"") (== "\"") (p + 1)) + (_, "\"") -> (searchFor False 0 (== "\"") (== "\"") p, p + 1) + ("`", _) -> (p, searchFor True 0 (== "`") (== "`") (p + 1)) + (_, "`") -> (searchFor False 0 (== "`") (== "`") p, p + 1) _ -> (searchFor False 0 ws ws p, searchFor True 0 ws ws p) - where l = R.length rp - ws x = x `elem` [" ", "\t", "(", ")", "[", "]", "{", "}", "\n", "'", "\"", ",", ";", ":", "|"] + ws x = x `elem` [" ", "\t", "(", ")", "[", "]", "{", "}", "\n", "'", "\"", ",", ";", ":", "|", "!"] getc i | i == 0 = let (sel, _) = R.splitAt 1 rp in R.toText sel - | i < l = let (R.splitAt (i-1) -> (_, sel), _) = R.splitAt i rp in R.toText sel + | i < l = let (R.splitAt (i - 1) -> (_, sel), _) = R.splitAt i rp in R.toText sel getc _ = "" searchFor fwd n a b p = case getc p of "" -> if fwd then p - 1 else p - c -> if b c && n == 0 - then if fwd then p - 1 else p - else searchFor fwd (n + if a c then 1 else if b c then -1 else 0) a b (if fwd then p + 1 else p - 1) + c -> + if b c && n == 0 + then if fwd then p - 1 else p + else searchFor fwd (n + if a c then 1 else if b c then -1 else 0) a b (if fwd then p + 1 else p - 1) drawWin display win bgcolour fgcolour linecolour selcolour font = do buf <- get @@ -247,6 +262,7 @@ handleEvent :: Display -> Drawable -> XftColor -> XftColor -> XftColor -> XftCol handleEvent display win bgcolour fgcolour linecolour selcolour font event = do b <- get let (start, end) = cursor b + selstr = R.splitAt end (content b) & fst & R.splitAt start & snd case event of Key (_, _, time, x, y, _, _, mod, keycode, _) -> do keysym <- lift $ keycodeToKeysym display keycode 0 @@ -255,13 +271,21 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do (0, 1) -> do -- left click down p <- lift $ getPos x y b - if (time - lastLeftClick b) < doubleClickDelay then - put $ b {cursor = expandAround (content b) p, selection = Nothing, lastLeftClick = time} - else - put $ b {cursor = (p, p), selection = Just (x, y), lastLeftClick = time} + if (time - lastLeftClick b) < doubleClickDelay + then put $ b {cursor = expandAround (content b) p, selection = Nothing, lastLeftClick = time} + else put $ b {cursor = (p, p), selection = Just (x, y), lastLeftClick = time} (_, 1) -> -- left click up put $ b {selection = Nothing} + (0, 3) -> + -- right click down + case search selstr (content b) (1 + end) of + Just p -> do + (_, _, _, _, m, _, _) <- lift $ getGeometry display win + let (height, width) = fontSize display font + pageheight = fromIntegral m `div` fromIntegral height + put $ b {cursor = (p, p + end - start), pos = max (pos b) $ R.lengthInLines (R.splitAt p (content b) & fst) -. pageheight + 1} + Nothing -> pure () (0, 4) -> scrollup 3 -- scroll wheel (0, 5) -> scrolldown 3 _ -> @@ -277,14 +301,12 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do put $ b {content = content b & R.toText & stripAnsiEscapeCodes & R.fromText} (4, 99) -> lift $ do -- ctrl-c (copy) - let (R.splitAt start -> (_, sel), _) = R.splitAt end (content b) - storeBuffer display (R.toText sel & T.unpack) 0 + storeBuffer display (R.toText selstr & T.unpack) 0 xSetSelectionOwner display pRIMARY win time xSetSelectionOwner display sECONDARY win time (4, 120) -> do -- ctrl-x (cut) - let (R.splitAt start -> (_, sel), _) = R.splitAt end (content b) - lift $ storeBuffer display (R.toText sel & T.unpack) 0 + lift $ storeBuffer display (R.toText selstr & T.unpack) 0 put $ b {content = delins start end (content b) "", cursor = (start + 1, start + 1)} (4, 118) -> lift $ do -- ctrl-v (paste) @@ -297,8 +319,7 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do T.writeFile (home <> "/jterm.log") (R.toText (content b)) (4, 115) -> do -- ctrl-s (send) - let (R.splitAt start -> (_, sel), _) = R.splitAt end (content b) - lift $ send b (sel <> "\n") + lift $ send b (selstr <> "\n") (_, 65361) -> do -- left let s = start - min start 1 @@ -328,7 +349,7 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do scrolldown ((681 * pageheight) `div` 1000) (_, 65288) -> do -- backspace - let s = if start > 0 then start - 1 else 0 + let s = start -. 1 put $ b {content = delins s end (content b) "", cursor = (s, s)} when (start == R.length (content b)) $ lift $ sendCommand b Erase _ -> when (toAppend /= "") $ do |