Record the name of the current desktop

diff --git a/src/Capture/Win32.hs b/src/Capture/Win32.hs
index 09759be..3623960 100644 (file)
--- a/src/Capture/Win32.hs
+++ b/src/Capture/Win32.hs
@@ -26,4 +26,4 @@ captureData = do
 
         it <- fromIntegral `fmap` getIdleTime
 
-        return $ CaptureData winData it
+        return $ CaptureData winData it (T.pack "")

diff --git a/src/Capture/X11.hs b/src/Capture/X11.hs
index ef577d6..c9efe8c 100644 (file)
--- a/src/Capture/X11.hs
+++ b/src/Capture/X11.hs
@@ -36,6 +36,21 @@ captureData = do
         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
 
@@ -54,7 +69,7 @@ captureData = do
         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

diff --git a/src/Data.hs b/src/Data.hs
index 53ad088..5735542 100644 (file)
--- a/src/Data.hs
+++ b/src/Data.hs
@@ -34,11 +34,13 @@ data CaptureData = CaptureData
         { 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]
 
@@ -105,14 +107,16 @@ instance StringReferencingBinary CaptureData where
 -- 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.

diff --git a/src/Data/MyText.hs b/src/Data/MyText.hs
index a038523..62bacb1 100644 (file)
--- a/src/Data/MyText.hs
+++ b/src/Data/MyText.hs
@@ -7,7 +7,7 @@ import Data.Binary.Get
 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
@@ -78,3 +78,6 @@ map f = pack . Prelude.map f . unpack
 
 concat :: [Text] -> Text
 concat = Text . BS.concat . Prelude.map toBytestring
+
+null :: Text -> Bool
+null = BS.null . toBytestring

diff --git a/src/DumpFormat.hs b/src/DumpFormat.hs
index 0531e74..eb6bbdc 100644 (file)
--- a/src/DumpFormat.hs
+++ b/src/DumpFormat.hs
@@ -7,7 +7,7 @@ module DumpFormat
     , 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
@@ -16,7 +16,8 @@ import Data.Char
 
 import Data
 import Text.Printf
-import Data.List
+import Data.List hiding (null)
+import Prelude hiding (null)
 
 data DumpFormat
     = DFShow
@@ -32,7 +33,8 @@ instance ToJSON (TimeLogEntry CaptureData) where
         "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
@@ -48,6 +50,7 @@ dumpActivity = mapM_ go
  where
     go tle = do
         dumpHeader tz (tlTime tle) (cLastActivity cd)
+        dumpDesktop (cDesktop cd)
         mapM_ dumpWindow (cWindows cd)
         dumpTags ad
       where
@@ -70,9 +73,15 @@ dumpWindow (active, title, program) = do
         (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 ()

diff --git a/src/UpgradeLog1.hs b/src/UpgradeLog1.hs
index 37c3f2f..482b11f 100644 (file)
--- a/src/UpgradeLog1.hs
+++ b/src/UpgradeLog1.hs
@@ -57,6 +57,6 @@ upgrade :: TimeLog CaptureData -> D.TimeLog D.CaptureData
 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 "")