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