Add XMonadLog.

Ignore-this: 99ce96d00494d6bd681ef524bb93f8c7
Support for writing WM status to a root window property was just added to
xmonad, this is the accompanying xmobar plugin.  The idea is to use XMonadLog
rather than StdinReader with xmonad, this should hopefully be more robust than
communicating over a pipe.

darcs-hash:20091107010104-a5988-5d111c1cba277269dc2dda2a5f4aaae384d4be3a.gz

1 files changed, 66 insertions, 0 deletions

diff --git a/Plugins/XMonadLog.hs b/Plugins/XMonadLog.hs
new file mode 100644
index 0000000..34fae31
--- /dev/null
+++ b/Plugins/XMonadLog.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.StdinReader
+-- Copyright   :  (c) Spencer Janssen
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A plugin to display information from _XMONAD_LOG, specified at
+-- http://code.haskell.org/XMonadContrib/XMonad/Hooks/DynamicLog.hs
+--
+-----------------------------------------------------------------------------
+
+module Plugins.XMonadLog (XMonadLog(..)) where
+
+import Control.Monad
+import Graphics.X11
+import Graphics.X11.Xlib.Extras
+import Plugins
+#ifdef UTF8
+#undef UTF8
+import Codec.Binary.UTF8.String as UTF8
+#define UTF8
+#endif
+import Foreign.C (CChar)
+import XUtil (nextEvent')
+
+
+data XMonadLog = XMonadLog
+    deriving (Read, Show)
+
+instance Exec XMonadLog where
+    start XMonadLog cb = do
+        d <- openDisplay ""
+        xlog <- internAtom d "_XMONAD_LOG" False
+
+        root  <- rootWindow d (defaultScreen d)
+        selectInput d root propertyChangeMask
+
+        let update = do
+                        mwp <- getWindowProperty8 d xlog root
+                        maybe (return ()) (cb . decodeCChar) mwp
+
+        update
+
+        allocaXEvent $ \ep -> forever $ do
+            nextEvent' d ep
+            e <- getEvent ep
+            case e of
+                PropertyEvent { ev_atom = a } | a ==  xlog -> update
+                _ -> return ()
+
+        return ()
+
+decodeCChar :: [CChar] -> String
+#ifdef UTF8
+#undef UTF8
+decodeCChar = UTF8.decode . map fromIntegral
+#define UTF8
+#else
+decodeCChar = map (toEnum . fromIntegral)
+#endif