{-# LANGUAGE CPP #-}
module Xmobar.Plugins.XMonadLog (XMonadLog(..)) where
import Control.Monad
import Graphics.X11
import Graphics.X11.Xlib.Extras
import Xmobar.Run.Exec
import Xmobar.Run.Actions (stripActions)
#ifdef UTF8
#undef UTF8
import Codec.Binary.UTF8.String as UTF8
#define UTF8
#endif
import Foreign.C (CChar)
import Data.List (intercalate)
import Xmobar.X11.Events (nextEvent')
data XMonadLog = XMonadLog
| UnsafeXMonadLog
| XPropertyLog String
| UnsafeXPropertyLog String
| NamedXPropertyLog String String
| UnsafeNamedXPropertyLog String String
deriving (ReadPrec [XMonadLog]
ReadPrec XMonadLog
Int -> ReadS XMonadLog
ReadS [XMonadLog]
(Int -> ReadS XMonadLog)
-> ReadS [XMonadLog]
-> ReadPrec XMonadLog
-> ReadPrec [XMonadLog]
-> Read XMonadLog
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XMonadLog]
$creadListPrec :: ReadPrec [XMonadLog]
readPrec :: ReadPrec XMonadLog
$creadPrec :: ReadPrec XMonadLog
readList :: ReadS [XMonadLog]
$creadList :: ReadS [XMonadLog]
readsPrec :: Int -> ReadS XMonadLog
$creadsPrec :: Int -> ReadS XMonadLog
Read, Int -> XMonadLog -> ShowS
[XMonadLog] -> ShowS
XMonadLog -> String
(Int -> XMonadLog -> ShowS)
-> (XMonadLog -> String)
-> ([XMonadLog] -> ShowS)
-> Show XMonadLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XMonadLog] -> ShowS
$cshowList :: [XMonadLog] -> ShowS
show :: XMonadLog -> String
$cshow :: XMonadLog -> String
showsPrec :: Int -> XMonadLog -> ShowS
$cshowsPrec :: Int -> XMonadLog -> ShowS
Show)
instance Exec XMonadLog where
alias :: XMonadLog -> String
alias XMonadLog
XMonadLog = String
"XMonadLog"
alias XMonadLog
UnsafeXMonadLog = String
"UnsafeXMonadLog"
alias (XPropertyLog String
atom) = String
atom
alias (NamedXPropertyLog String
_ String
name) = String
name
alias (UnsafeXPropertyLog String
atom) = String
atom
alias (UnsafeNamedXPropertyLog String
_ String
name) = String
name
start :: XMonadLog -> (String -> IO ()) -> IO ()
start XMonadLog
x String -> IO ()
cb = do
let atom :: String
atom = case XMonadLog
x of
XMonadLog
XMonadLog -> String
"_XMONAD_LOG"
XMonadLog
UnsafeXMonadLog -> String
"_XMONAD_LOG"
XPropertyLog String
a -> String
a
UnsafeXPropertyLog String
a -> String
a
NamedXPropertyLog String
a String
_ -> String
a
UnsafeNamedXPropertyLog String
a String
_ -> String
a
stripNL :: ShowS
stripNL = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" - " ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
sanitize :: ShowS
sanitize = case XMonadLog
x of
XMonadLog
UnsafeXMonadLog -> ShowS
forall a. a -> a
id
UnsafeXPropertyLog String
_ -> ShowS
forall a. a -> a
id
UnsafeNamedXPropertyLog String
_ String
_ -> ShowS
forall a. a -> a
id
XMonadLog
_ -> ShowS
stripActions ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
stripNL
Display
d <- String -> IO Display
openDisplay String
""
Atom
xlog <- Display -> String -> Bool -> IO Atom
internAtom Display
d String
atom Bool
False
Atom
root <- Display -> ScreenNumber -> IO Atom
rootWindow Display
d (Display -> ScreenNumber
defaultScreen Display
d)
Display -> Atom -> Atom -> IO ()
selectInput Display
d Atom
root Atom
propertyChangeMask
let update :: IO ()
update = do
Maybe [CChar]
mwp <- Display -> Atom -> Atom -> IO (Maybe [CChar])
getWindowProperty8 Display
d Atom
xlog Atom
root
IO () -> ([CChar] -> IO ()) -> Maybe [CChar] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (String -> IO ()
cb (String -> IO ()) -> ([CChar] -> String) -> [CChar] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sanitize ShowS -> ([CChar] -> String) -> [CChar] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CChar] -> String
decodeCChar) Maybe [CChar]
mwp
IO ()
update
(XEventPtr -> IO Any) -> IO Any
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO Any) -> IO Any)
-> (XEventPtr -> IO Any) -> IO Any
forall a b. (a -> b) -> a -> b
$ \XEventPtr
ep -> IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
Display -> XEventPtr -> IO ()
nextEvent' Display
d XEventPtr
ep
Event
e <- XEventPtr -> IO Event
getEvent XEventPtr
ep
case Event
e of
PropertyEvent { ev_atom :: Event -> Atom
ev_atom = Atom
a } | Atom
a Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
xlog -> IO ()
update
Event
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decodeCChar :: [CChar] -> String
#ifdef UTF8
#undef UTF8
decodeCChar :: [CChar] -> String
decodeCChar = [Word8] -> String
UTF8.decode ([Word8] -> String) -> ([CChar] -> [Word8]) -> [CChar] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CChar -> Word8) -> [CChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#define UTF8
#else
decodeCChar = map (toEnum . fromIntegral)
#endif