summaryrefslogtreecommitdiff
path: root/jterm.hs
diff options
context:
space:
mode:
Diffstat (limited to 'jterm.hs')
-rw-r--r--jterm.hs81
1 files changed, 51 insertions, 30 deletions
diff --git a/jterm.hs b/jterm.hs
index 170e195..24955b0 100644
--- a/jterm.hs
+++ b/jterm.hs
@@ -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
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-22 23:37:12 +0000