diff options
| -rw-r--r-- | jterm.hs | 48 |
1 files changed, 43 insertions, 5 deletions
@@ -2,7 +2,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -import Control.Concurrent (threadDelay) import Control.Exception import Control.Monad import Control.Monad.Trans @@ -30,16 +29,52 @@ import qualified Streamly.Data.Stream.Prelude as S import System.Environment import System.IO.Unsafe import System.Posix.Pty -import System.Process + +doubleClickDelay = 300 data Buffer = Buffer { pos :: Word, content :: Rope, cursor :: (Word, Word), selection :: Maybe (CInt, CInt), - pty :: Pty + pty :: Pty, + lastLeftClick :: Time } +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) + _ -> (searchFor False 0 ws ws p, searchFor True 0 ws ws p) + + where + l = R.length rp + + 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 + 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) + drawWin display win bgcolour fgcolour linecolour selcolour font = do buf <- get lift $ do @@ -220,7 +255,10 @@ handleEvent display win bgcolour fgcolour linecolour selcolour font event = do (0, 1) -> do -- left click down p <- lift $ getPos x y b - put $ b {cursor = (p, p), selection = Just (x, y)} + 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} @@ -410,5 +448,5 @@ main = do withXftColorValue display visual colourmap (XRenderColor 0xaeae 0xf7f7 0xffff 0xffff) $ \linecolour -> do selectInput display win (exposureMask .|. buttonPressMask .|. buttonReleaseMask .|. keyPressMask .|. pointerMotionMask) allocaXEvent $ \e -> - flip runStateT (Buffer 0 "" (0, 0) Nothing pty) $ + flip runStateT (Buffer 0 "" (0, 0) Nothing pty 0) $ S.parList (S.eager True) [S.repeatM (lift $ waitEvent display e), S.repeatM (lift $ watch pty)] & S.fold (F.drainMapM (handleEvent display win bgcolour fgcolour linecolour selcolour font)) |