1{-# LANGUAGE CPP #-}
2
3-----------------------------------------------------------------------------
4-- |
5-- Module      :  Plugins.StdinReader
6-- Copyright   :  (c) Spencer Janssen
7-- License     :  BSD-style (see LICENSE)
8--
9-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
10-- Stability   :  unstable
11-- Portability :  unportable
12--
13-- A plugin to display information from _XMONAD_LOG, specified at
14-- http://code.haskell.org/XMonadContrib/XMonad/Hooks/DynamicLog.hs
15--
16-----------------------------------------------------------------------------
17
18module Xmobar.Plugins.XMonadLog (XMonadLog(..)) where
19
20import Control.Monad
21import Graphics.X11
22import Graphics.X11.Xlib.Extras
23import Xmobar.Run.Exec
24#ifdef UTF8
25#undef UTF8
26import Codec.Binary.UTF8.String as UTF8
27#define UTF8
28#endif
29import Foreign.C (CChar)
30import Xmobar.X11.Events (nextEvent')
31import Xmobar.X11.Actions (stripActions)
32
33data XMonadLog = XMonadLog
34               | UnsafeXMonadLog
35               | XPropertyLog String
36               | UnsafeXPropertyLog String
37               | NamedXPropertyLog String String
38               | UnsafeNamedXPropertyLog String String
39    deriving (Read, Show)
40
41instance Exec XMonadLog where
42    alias XMonadLog = "XMonadLog"
43    alias UnsafeXMonadLog = "UnsafeXMonadLog"
44    alias (XPropertyLog atom) = atom
45    alias (NamedXPropertyLog _ name) = name
46    alias (UnsafeXPropertyLog atom) = atom
47    alias (UnsafeNamedXPropertyLog _ name) = name
48
49    start x cb = do
50        let atom = case x of
51                XMonadLog -> "_XMONAD_LOG"
52                UnsafeXMonadLog -> "_XMONAD_LOG"
53                XPropertyLog a -> a
54                UnsafeXPropertyLog a -> a
55                NamedXPropertyLog a _ -> a
56                UnsafeNamedXPropertyLog a _ -> a
57            sanitize = case x of
58                UnsafeXMonadLog -> id
59                UnsafeXPropertyLog _ -> id
60                UnsafeNamedXPropertyLog _ _ -> id
61                _ -> stripActions
62
63        d <- openDisplay ""
64        xlog <- internAtom d atom False
65
66        root  <- rootWindow d (defaultScreen d)
67        selectInput d root propertyChangeMask
68
69        let update = do
70                        mwp <- getWindowProperty8 d xlog root
71                        maybe (return ()) (cb . sanitize . decodeCChar) mwp
72
73        update
74
75        allocaXEvent $ \ep -> forever $ do
76            nextEvent' d ep
77            e <- getEvent ep
78            case e of
79                PropertyEvent { ev_atom = a } | a ==  xlog -> update
80                _ -> return ()
81
82        return ()
83
84decodeCChar :: [CChar] -> String
85#ifdef UTF8
86#undef UTF8
87decodeCChar = UTF8.decode . map fromIntegral
88#define UTF8
89#else
90decodeCChar = map (toEnum . fromIntegral)
91#endif
92