it <- fromIntegral `fmap` getIdleTime
- return $ CaptureData winData it
+ return $ CaptureData winData it (T.pack "")
xSetErrorHandler
let rwin = defaultRootWindow dpy
+ -- Desktops
+ a <- internAtom dpy "_NET_CURRENT_DESKTOP" False
+ p <- getWindowProperty32 dpy a rwin
+ let desk_index = do {[d] <- p; return (fromIntegral d)}
+
+ a <- internAtom dpy "_NET_DESKTOP_NAMES" False
+ tp <- getTextProperty dpy rwin a
+ names <- wcTextPropertyToTextList dpy tp
+
+ let current_desktop = case desk_index of
+ Nothing -> ""
+ Just n -> if 1 <= n && n <= length names
+ then names !! (n-1)
+ else show n
+ -- Windows
a <- internAtom dpy "_NET_CLIENT_LIST" False
p <- getWindowProperty32 dpy a rwin
it <- fromIntegral `fmap` getXIdleTime dpy
closeDisplay dpy
- return $ CaptureData winData it
+ return $ CaptureData winData it (T.pack current_desktop)
getWindowTitle :: Display -> Window -> IO String
getWindowTitle dpy = myFetchName dpy
{ cWindows :: [ (Bool, Text, Text) ]
-- ^ Active window, window title, programm name
, cLastActivity :: Integer -- ^ in milli-seconds
+ , cDesktop :: Text
+ -- ^ Current desktop name
}
deriving (Show, Read)
instance NFData CaptureData where
- rnf (CaptureData a b) = a `deepseq` b `deepseq` ()
+ rnf (CaptureData a b c) = a `deepseq` b `deepseq` c `deepseq` ()
type ActivityData = [Activity]
-- 2 Using ListOfStringable
ls_put strs cd = do
-- A version tag
- putWord8 2
+ putWord8 3
ls_put strs (cWindows cd)
ls_put strs (cLastActivity cd)
+ ls_put strs (cDesktop cd)
ls_get strs = do
v <- getWord8
case v of
- 1 -> CaptureData <$> get <*> get
- 2 -> CaptureData <$> ls_get strs <*> ls_get strs
+ 1 -> CaptureData <$> get <*> get <*> pure ""
+ 2 -> CaptureData <$> ls_get strs <*> ls_get strs <*> pure ""
+ 3 -> CaptureData <$> ls_get strs <*> ls_get strs <*> ls_get strs
_ -> error $ "Unsupported CaptureData version tag " ++ show v
-- | 'getMany n' get 'n' elements in order, without blowing the stack.
import Data.Binary
import Control.Applicative ((<$>))
import Control.Arrow (first)
-import Prelude hiding (length, map)
+import Prelude hiding (length, map, null)
import qualified Prelude
import GHC.Exts( IsString(..) )
import Control.DeepSeq
concat :: [Text] -> Text
concat = Text . BS.concat . Prelude.map toBytestring
+
+null :: Text -> Bool
+null = BS.null . toBytestring
, dumpSamples
) where
-import Data.MyText (unpack, Text)
+import Data.MyText (unpack, null, Text)
import Data.Aeson
import qualified Data.ByteString.Lazy as LBS
import Data.Time
import Data
import Text.Printf
-import Data.List
+import Data.List hiding (null)
+import Prelude hiding (null)
data DumpFormat
= DFShow
"date" .= tlTime,
"rate" .= tlRate,
"inactive" .= cLastActivity tlData,
- "windows" .= map (\(a,p,t) -> object ["active" .= a, "program" .= p, "title" .= t]) (cWindows tlData)
+ "windows" .= map (\(a,p,t) -> object ["active" .= a, "program" .= p, "title" .= t]) (cWindows tlData),
+ "desktop" .= cDesktop tlData
]
readDumpFormat :: String -> Maybe DumpFormat
where
go tle = do
dumpHeader tz (tlTime tle) (cLastActivity cd)
+ dumpDesktop (cDesktop cd)
mapM_ dumpWindow (cWindows cd)
dumpTags ad
where
(unpack program ++ ":")
(unpack title)
+dumpDesktop :: Text -> IO ()
+dumpDesktop d
+ | null d = return ()
+ | otherwise = printf " Current Desktop: %s\n" (unpack d)
+
dumpSample :: TimeZone -> TimeLogEntry CaptureData -> IO ()
dumpSample tz tle = do
dumpHeader tz (tlTime tle) (cLastActivity (tlData tle))
+ dumpDesktop (cDesktop (tlData tle))
mapM_ dumpWindow (cWindows (tlData tle))
dumpSamples :: TimeZone -> DumpFormat -> TimeLog CaptureData -> IO ()
upgrade = map $ \(TimeLogEntry a b c) -> D.TimeLogEntry a b (upgradeCD c)
upgradeCD :: CaptureData -> D.CaptureData
-upgradeCD (CaptureData a b) = D.CaptureData (map (\(b,s1,s2) -> (b, T.pack s1, T.pack s2)) a) b
+upgradeCD (CaptureData a b) = D.CaptureData (map (\(b,s1,s2) -> (b, T.pack s1, T.pack s2)) a) b (T.pack "")