implement double click selections

1 files changed, 43 insertions, 5 deletions

diff --git a/jterm.hs b/jterm.hs
index 11b8bc2..25bda76 100644
--- a/jterm.hs
+++ b/jterm.hs
@@ -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))