From aa507d0bda3919e1885edb327b855908f2aafcb8 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 12:12:17 +0200 Subject: BufferedPipeReader: A plugin for temporary data display This plugin allows to display data from multiple pipes. New data will always overwrite the currently displayed data. However, if a timeout is specified, the previous content is restored. Configuration works like this: BufferedPipeReader [ ( Timeout, "/path/to/fifo/pipe" ), (..), .. ] If Timeout is set to 0 then the content is persistent, i.e. it will be reset to any previous value, it will itself become the previous value. If Timeout is set to a negative value the earth will stop spinning, so don't do it. --- src/Config.hs | 3 +- src/Plugins/BufferedPipeReader.hs | 78 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 80 insertions(+), 1 deletion(-) create mode 100644 src/Plugins/BufferedPipeReader.hs diff --git a/src/Config.hs b/src/Config.hs index 4405314..712687d 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -28,6 +28,7 @@ import {-# SOURCE #-} Runnable import Plugins.Monitors import Plugins.Date import Plugins.PipeReader +import Plugins.BufferedPipeReader import Plugins.CommandReader import Plugins.StdinReader import Plugins.XMonadLog @@ -113,7 +114,7 @@ infixr :*: -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature. -runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: +runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs new file mode 100644 index 0000000..1fb9dcb --- /dev/null +++ b/src/Plugins/BufferedPipeReader.hs @@ -0,0 +1,78 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.BufferedPipeReader +-- Copyright : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jochen Keil +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading (temporarily) from named pipes with reset +-- +----------------------------------------------------------------------------- + +module Plugins.BufferedPipeReader where + +import Control.Monad(forM_, when) +import Control.Concurrent +import Control.Concurrent.STM +import System.IO +-- import System.IO.Unsafe(unsafePerformIO) + +import Plugins + +data BufferedPipeReader = BufferedPipeReader String [(Int, String)] + deriving (Read, Show) + +-- pipeState :: MVar String +-- pipeState = unsafePerformIO $ newMVar "" + +-- pipe :: (String -> IO ()) -> Handle -> IO () +-- pipe cb h = hGetLineSafe h >>= cb + +instance Exec BufferedPipeReader where + alias ( BufferedPipeReader a _ ) = a + start ( BufferedPipeReader _ ps ) cb = do + + (chan, str, rst) <- initV + forM_ ps $ \p -> forkIO $ reader p chan + writer chan str rst + + where + initV :: IO ( TChan (Int, String), TVar String, TVar Bool ) + initV = atomically $ do + tc <- newTChan + ts <- newTVar "" + tb <- newTVar False + return (tc, ts, tb) + + reader :: (Int, FilePath) -> TChan (Int, String) -> IO () + reader p@(to, fp) tc = do + openFile fp ReadWriteMode >>= hGetLineSafe >>= \dt -> + atomically $ writeTChan tc (to, dt) + reader p tc + + writer :: TChan (Int, String) -> TVar String -> TVar Bool -> IO () + writer tc ts otb = do + (to, dt, ntb) <- update + cb dt + when (to /= 0) $ sfork $ reset to ts ntb + writer tc ts ntb + + where + sfork :: IO () -> IO () + sfork f = forkIO f >> return () + + update :: IO (Int, String, TVar Bool) + update = atomically $ do + (to, dt) <- readTChan tc + when (to == 0) $ writeTVar ts dt + writeTVar otb False + tb <- newTVar True + return (to, dt, tb) + + reset :: Int -> TVar String -> TVar Bool -> IO () + reset to ts tb = do + threadDelay ( to * 100 * 1000 ) + readTVarIO tb >>= flip when ( readTVarIO ts >>= cb ) -- cgit v1.2.3 From a52c4a076807ae04db67894aebd741924ff9f926 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 20:24:53 +0200 Subject: Modularize Window handling functions These functions are about creation, positioning and property setting of the xmobar window. An own module does them justice and eases the task of adding functions for revealing/hiding and toggling the window. --- src/Window.hs | 137 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Xmobar.hs | 130 +------------------------------------------------------ 2 files changed, 139 insertions(+), 128 deletions(-) create mode 100644 src/Window.hs diff --git a/src/Window.hs b/src/Window.hs new file mode 100644 index 0000000..34ecbf4 --- /dev/null +++ b/src/Window.hs @@ -0,0 +1,137 @@ +module Window where + +import Prelude hiding (catch) +import Graphics.X11.Xlib hiding (textExtents, textWidth) +import Graphics.X11.Xlib.Extras +import Graphics.X11.Xinerama + +import Control.Monad.Reader +import Data.Maybe(fromMaybe) +import System.Posix.Process (getProcessID) + +import Config +import XUtil + +-- $window + +-- | The function to create the initial window +createWin :: Display -> XFont -> Config -> IO (Rectangle,Window) +createWin d fs c = do + let dflt = defaultScreen d + srs <- getScreenInfo d + rootw <- rootWindow d dflt + (as,ds) <- textExtents fs "0" + let ht = as + ds + 4 + (r,o) = setPosition (position c) srs (fi ht) + win <- newWindow d (defaultScreenOfDisplay d) rootw r o + setProperties r c d win srs + when (lowerOnStart c) (lowerWindow d win) + mapWindow d win + return (r,win) + +-- | Updates the size and position of the window +repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle +repositionWin d win fs c = do + srs <- getScreenInfo d + (as,ds) <- textExtents fs "0" + let ht = as + ds + 4 + (r,_) = setPosition (position c) srs (fi ht) + moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r) + setProperties r c d win srs + return r + +setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool) +setPosition p rs ht = + case p' of + Top -> (Rectangle rx ry rw h, True) + TopW a i -> (Rectangle (ax a i) ry (nw i) h, True) + TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True) + Bottom -> (Rectangle rx ny rw h, True) + BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True) + BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True) + Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True) + OnScreen _ p'' -> setPosition p'' [scr] ht + where + (scr@(Rectangle rx ry rw rh), p') = + case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x) + _ -> (head rs, p) + ny = ry + fi (rh - ht) + center i = rx + fi (div (remwid i) 2) + right i = rx + fi (remwid i) + remwid i = rw - pw (fi i) + ax L = const rx + ax R = right + ax C = center + pw i = rw * min 100 i `div` 100 + nw = fi . pw . fi + h = fi ht + mh h' = max (fi h') h + ny' h' = ry + fi (rh - mh h') + safeIndex i = lookup i . zip [0..] + +setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO () +setProperties r c d w srs = do + a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False + c1 <- internAtom d "CARDINAL" False + a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False + c2 <- internAtom d "ATOM" False + v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False + p <- internAtom d "_NET_WM_PID" False + + setTextProperty d w "xmobar" wM_CLASS + setTextProperty d w "xmobar" wM_NAME + + changeProperty32 d w a1 c1 propModeReplace $ map fi $ + getStrutValues r (position c) (getRootWindowHeight srs) + changeProperty32 d w a2 c2 propModeReplace [fromIntegral v] + + getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral + +getRootWindowHeight :: [Rectangle] -> Int +getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) + where + getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr) + +getStrutValues :: Rectangle -> XPosition -> Int -> [Int] +getStrutValues r@(Rectangle x y w h) p rwh = + case p of + OnScreen _ p' -> getStrutValues r p' rwh + Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] + TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] + TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] + Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] + BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] + BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] + Static {} -> getStaticStrutValues p rwh + where st = fi y + fi h + sb = rwh - fi y + nx = fi x + nw = fi (x + fi w - 1) + +-- get some reaonable strut values for static placement. +getStaticStrutValues :: XPosition -> Int -> [Int] +getStaticStrutValues (Static cx cy cw ch) rwh + -- if the yPos is in the top half of the screen, then assume a Top + -- placement, otherwise, it's a Bottom placement + | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0] + | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe] + where st = cy + ch + sb = rwh - cy + xs = cx -- a simple calculation for horizontal (x) placement + xe = xs + cw +getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] + +drawBorder :: Border -> Display -> Drawable -> GC -> Pixel + -> Dimension -> Dimension -> IO () +drawBorder b d p gc c wi ht = case b of + NoBorder -> return () + TopB -> drawBorder (TopBM 0) d p gc c w h + BottomB -> drawBorder (BottomBM 0) d p gc c w h + FullB -> drawBorder (FullBM 0) d p gc c w h + TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0 + BottomBM m -> let rw = fi h - fi m in + sf >> drawLine d p gc 0 rw (fi w) rw + FullBM m -> let pad = 2 * fi m; mp = fi m in + sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) + where sf = setForeground d gc c + (w, h) = (wi - 1, ht - 1) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index c348f99..0b744de 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -41,15 +41,13 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception hiding (handle) import Data.Bits -import Data.Maybe(fromMaybe) -import Data.Typeable (Typeable) -import System.Posix.Process (getProcessID) -import System.Posix.Signals import Config import Parsers import Commands import Runnable +import Signal +import Window import XUtil -- $main @@ -197,115 +195,6 @@ startCommand (com,s,ss) return (Just h,var) where is = s ++ "Updating..." ++ ss --- $window - --- | The function to create the initial window -createWin :: Display -> XFont -> Config -> IO (Rectangle,Window) -createWin d fs c = do - let dflt = defaultScreen d - srs <- getScreenInfo d - rootw <- rootWindow d dflt - (as,ds) <- textExtents fs "0" - let ht = as + ds + 4 - (r,o) = setPosition (position c) srs (fi ht) - win <- newWindow d (defaultScreenOfDisplay d) rootw r o - setProperties r c d win srs - when (lowerOnStart c) (lowerWindow d win) - mapWindow d win - return (r,win) - --- | Updates the size and position of the window -repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle -repositionWin d win fs c = do - srs <- getScreenInfo d - (as,ds) <- textExtents fs "0" - let ht = as + ds + 4 - (r,_) = setPosition (position c) srs (fi ht) - moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r) - setProperties r c d win srs - return r - -setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool) -setPosition p rs ht = - case p' of - Top -> (Rectangle rx ry rw h, True) - TopW a i -> (Rectangle (ax a i) ry (nw i) h, True) - TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True) - Bottom -> (Rectangle rx ny rw h, True) - BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True) - BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True) - Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True) - OnScreen _ p'' -> setPosition p'' [scr] ht - where - (scr@(Rectangle rx ry rw rh), p') = - case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x) - _ -> (head rs, p) - ny = ry + fi (rh - ht) - center i = rx + fi (div (remwid i) 2) - right i = rx + fi (remwid i) - remwid i = rw - pw (fi i) - ax L = const rx - ax R = right - ax C = center - pw i = rw * min 100 i `div` 100 - nw = fi . pw . fi - h = fi ht - mh h' = max (fi h') h - ny' h' = ry + fi (rh - mh h') - safeIndex i = lookup i . zip [0..] - -setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO () -setProperties r c d w srs = do - a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False - c1 <- internAtom d "CARDINAL" False - a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False - c2 <- internAtom d "ATOM" False - v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False - p <- internAtom d "_NET_WM_PID" False - - setTextProperty d w "xmobar" wM_CLASS - setTextProperty d w "xmobar" wM_NAME - - changeProperty32 d w a1 c1 propModeReplace $ map fi $ - getStrutValues r (position c) (getRootWindowHeight srs) - changeProperty32 d w a2 c2 propModeReplace [fromIntegral v] - - getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral - -getRootWindowHeight :: [Rectangle] -> Int -getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) - where - getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr) - -getStrutValues :: Rectangle -> XPosition -> Int -> [Int] -getStrutValues r@(Rectangle x y w h) p rwh = - case p of - OnScreen _ p' -> getStrutValues r p' rwh - Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - Static {} -> getStaticStrutValues p rwh - where st = fi y + fi h - sb = rwh - fi y - nx = fi x - nw = fi (x + fi w - 1) - --- get some reaonable strut values for static placement. -getStaticStrutValues :: XPosition -> Int -> [Int] -getStaticStrutValues (Static cx cy cw ch) rwh - -- if the yPos is in the top half of the screen, then assume a Top - -- placement, otherwise, it's a Bottom placement - | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0] - | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe] - where st = cy + ch - sb = rwh - cy - xs = cx -- a simple calculation for horizontal (x) placement - xe = xs + cw -getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] - updateWin :: TVar [String] -> X () updateWin v = do xc <- ask @@ -346,21 +235,6 @@ drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do -- resync io $ sync d True -drawBorder :: Border -> Display -> Drawable -> GC -> Pixel - -> Dimension -> Dimension -> IO () -drawBorder b d p gc c wi ht = case b of - NoBorder -> return () - TopB -> drawBorder (TopBM 0) d p gc c w h - BottomB -> drawBorder (BottomBM 0) d p gc c w h - FullB -> drawBorder (FullBM 0) d p gc c w h - TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0 - BottomBM m -> let rw = fi h - fi m in - sf >> drawLine d p gc 0 rw (fi w) rw - FullBM m -> let pad = 2 * fi m; mp = fi m in - sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) - where sf = setForeground d gc c - (w, h) = (wi - 1, ht - 1) - -- | An easy way to print the stuff we need to print printStrings :: Drawable -> GC -> XFont -> Position -> Align -> [(String, String, Position)] -> X () -- cgit v1.2.3 From 77ce9cbe7f8371aadf24713a6d700a436d983eaf Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 19:54:22 +0200 Subject: Move signal handler and data types to own module This is necessary to make SignalType available for other modules without import loops. This also decoupels the modules and their functionality a bit more so this is generally a cleaner solution. --- src/Signal.hs | 33 +++++++++++++++++++++++++++++++++ src/Xmobar.hs | 25 +------------------------ 2 files changed, 34 insertions(+), 24 deletions(-) create mode 100644 src/Signal.hs diff --git a/src/Signal.hs b/src/Signal.hs new file mode 100644 index 0000000..3919d86 --- /dev/null +++ b/src/Signal.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Signal where + +import Data.Typeable (Typeable) +import Control.Concurrent +import Control.Exception hiding (handle) +import System.Posix.Signals + +data WakeUp = WakeUp deriving (Show,Typeable) +instance Exception WakeUp + +data SignalType = Wakeup + | Reposition + | ChangeScreen + +-- | Signal handling +setupSignalHandler :: IO (MVar SignalType) +setupSignalHandler = do + tid <- newEmptyMVar + installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing + installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing + return tid + +updatePosHandler :: MVar SignalType -> IO () +updatePosHandler sig = do + putMVar sig Reposition + return () + +changeScreenHandler :: MVar SignalType -> IO () +changeScreenHandler sig = do + putMVar sig ChangeScreen + return () diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 0b744de..6c2965c 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -39,7 +39,7 @@ import Control.Arrow ((&&&)) import Control.Monad.Reader import Control.Concurrent import Control.Concurrent.STM -import Control.Exception hiding (handle) +import Control.Exception (catch, SomeException(..)) import Data.Bits import Config @@ -70,11 +70,6 @@ data XConf = runX :: XConf -> X () -> IO () runX xc f = runReaderT f xc -data WakeUp = WakeUp deriving (Show,Typeable) -instance Exception WakeUp - -data SignalType = Wakeup | Reposition | ChangeScreen - -- | Starts the main event loop and threads startLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () startLoop xcfg@(XConf _ _ w _ _) vs = do @@ -162,24 +157,6 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do return (ocfg {position = OnScreen 1 o}) --- | Signal handling -setupSignalHandler :: IO (MVar SignalType) -setupSignalHandler = do - tid <- newEmptyMVar - installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing - installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing - return tid - -updatePosHandler :: MVar SignalType -> IO () -updatePosHandler sig = do - putMVar sig Reposition - return () - -changeScreenHandler :: MVar SignalType -> IO () -changeScreenHandler sig = do - putMVar sig ChangeScreen - return () - -- $command -- | Runs a command as an independent thread and returns its thread id -- cgit v1.2.3 From db34ddc05fd308986a1be4140f8f8ddf14598122 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 20:01:38 +0200 Subject: Add signals for {show,hid,toggl}ing Also make them {Read,Show}able which can be useful for printf debugging and does not hurt otherwise. --- src/Signal.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Signal.hs b/src/Signal.hs index 3919d86..0acdea1 100644 --- a/src/Signal.hs +++ b/src/Signal.hs @@ -13,6 +13,10 @@ instance Exception WakeUp data SignalType = Wakeup | Reposition | ChangeScreen + | Hide + | Reveal + | Toggle + deriving (Read, Show) -- | Signal handling setupSignalHandler :: IO (MVar SignalType) -- cgit v1.2.3 From 536273a9d980cf3e71d8d05813e18b3ebcaf9233 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 20:02:43 +0200 Subject: Extend the interface so that plugins can send signals Also: realign methods to look pretty again. --- src/Commands.hs | 4 ++++ src/Runnable.hs | 5 +++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Commands.hs b/src/Commands.hs index 1bfbb94..f31c53c 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -30,6 +30,8 @@ import Data.Char import System.Process import System.Exit import System.IO (hClose) + +import Signal import XUtil class Show e => Exec e where @@ -42,6 +44,8 @@ class Show e => Exec e where start :: e -> (String -> IO ()) -> IO () start e cb = go where go = run e >>= cb >> tenthSeconds (rate e) >> go + trigger :: e -> (Maybe SignalType -> IO ()) -> IO () + trigger _ sh = sh Nothing data Command = Com Program Args Alias Rate deriving (Show,Read,Eq) diff --git a/src/Runnable.hs b/src/Runnable.hs index 56fedb3..84d9b77 100644 --- a/src/Runnable.hs +++ b/src/Runnable.hs @@ -29,8 +29,9 @@ import Commands data Runnable = forall r . (Exec r, Read r, Show r) => Run r instance Exec Runnable where - start (Run a) = start a - alias (Run a) = alias a + start (Run a) = start a + alias (Run a) = alias a + trigger (Run a) = trigger a instance Show Runnable where show (Run x) = show x -- cgit v1.2.3 From fa4b999c73067cb55e316b94fe62aebb147cea98 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 10:12:39 +0200 Subject: Create signal handler in main and pass it down to the start* functions This is necessary for setting up the signal callback (trigger) from the Plugin interface. As another benefit it is now possible to implement the lowerOnStart config option properly by simply sending a Hide signal in startLoop. --- src/Main.hs | 7 +++++-- src/Window.hs | 1 - src/Xmobar.hs | 14 ++++++++------ 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 4c3f351..c7045b5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,6 +36,8 @@ import System.Environment import System.Posix.Files import Control.Monad (unless) +import Signal (setupSignalHandler, SignalType(..)) + -- $main -- | The main entry point @@ -55,9 +57,10 @@ main = do conf <- doOpts c o fs <- initFont d (font conf) cls <- mapM (parseTemplate conf) (splitTemplate conf) - vars <- mapM (mapM startCommand) cls + sig <- setupSignalHandler + vars <- mapM (mapM $ startCommand sig) cls (r,w) <- createWin d fs conf - startLoop (XConf d r w fs conf) vars + startLoop (XConf d r w fs conf) sig vars -- | Splits the template in its parts splitTemplate :: Config -> [String] diff --git a/src/Window.hs b/src/Window.hs index 34ecbf4..4917f57 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -25,7 +25,6 @@ createWin d fs c = do (r,o) = setPosition (position c) srs (fi ht) win <- newWindow d (defaultScreenOfDisplay d) rootw r o setProperties r c d win srs - when (lowerOnStart c) (lowerWindow d win) mapWindow d win return (r,win) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 6c2965c..1b58352 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -71,10 +71,10 @@ runX :: XConf -> X () -> IO () runX xc f = runReaderT f xc -- | Starts the main event loop and threads -startLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () -startLoop xcfg@(XConf _ _ w _ _) vs = do +startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () +startLoop xcfg@(XConf _ _ w _ conf) sig vs = do tv <- atomically $ newTVar [] - sig <- setupSignalHandler + when (lowerOnStart conf) $ putMVar sig Hide _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) #ifdef THREADED_RUNTIME @@ -156,19 +156,21 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do o -> return (ocfg {position = OnScreen 1 o}) - -- $command -- | Runs a command as an independent thread and returns its thread id -- and the TVar the command will be writing to. -startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String) -startCommand (com,s,ss) +startCommand :: MVar SignalType + -> (Runnable,String,String) + -> IO (Maybe ThreadId, TVar String) +startCommand sig (com,s,ss) | alias com == "" = do var <- atomically $ newTVar is atomically $ writeTVar var (s ++ ss) return (Nothing,var) | otherwise = do var <- atomically $ newTVar is let cb str = atomically $ writeTVar var (s ++ str ++ ss) h <- forkIO $ start com cb + _ <- forkIO $ trigger com ( maybe (return ()) (putMVar sig) ) return (Just h,var) where is = s ++ "Updating..." ++ ss -- cgit v1.2.3 From cc77b5a7bc8309f694fd0aed4110b92f16316c0b Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 20:30:40 +0200 Subject: Add functions for {reveal,hid,toggl}ing the window Toggling is based is based on the current window status. If unmapped then reveal else hide. Sync is necessary or delays might occur. The functions are called from the event loop when the according signal is received When mapping (revealing) the window again we need to set the struts property again. The easiest way to do this is to call repositionWin. However, repositionWin needs access to the Config structure which is available in eventLoop. Because decomposition wouldn't be easy and I don't want to pass Config down to showWindow (which would need to return the new Rectangle then) this is done here. --- src/Window.hs | 15 +++++++++++++++ src/Xmobar.hs | 11 +++++++++++ 2 files changed, 26 insertions(+) diff --git a/src/Window.hs b/src/Window.hs index 4917f57..e59c5ff 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -134,3 +134,18 @@ drawBorder b d p gc c wi ht = case b of sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) where sf = setForeground d gc c (w, h) = (wi - 1, ht - 1) + +hideWindow :: Display -> Window -> IO () +hideWindow d w = do + a <- internAtom d "_NET_WM_STRUT_PARTIAL" False + c <- internAtom d "CARDINAL" False + changeProperty32 d w a c propModeReplace $ replicate 12 0 + unmapWindow d w + sync d False + +showWindow :: Display -> Window -> IO () +showWindow d w = mapWindow d w >> sync d False + +isMapped :: Display -> Window -> IO Bool +isMapped d w = fmap ism $ getWindowAttributes d w + where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 1b58352..a65a236 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -140,7 +140,18 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do ncfg <- updateConfigPosition cfg reposWindow ncfg + Hide -> hide + Reveal -> reveal + Toggle -> toggle + where + hide = hideWindow d w >> eventLoop tv xc signal + reveal = do + r' <- repositionWin d w fs cfg + showWindow d w + eventLoop tv (XConf d r' w fs cfg) signal + toggle = isMapped d w >>= \b -> if b then hide else reveal + reposWindow rcfg = do r' <- repositionWin d w fs rcfg eventLoop tv (XConf d r' w fs rcfg) signal -- cgit v1.2.3 From 58427c76c892334522dfb28ea2d2a858469fc65a Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 09:43:49 +0200 Subject: Cosmetic surgery Realign methods, remove unnecessary imports and remove clutter --- src/Commands.hs | 16 ++++++++-------- src/Main.hs | 2 +- src/Plugins/BufferedPipeReader.hs | 6 ------ src/Window.hs | 1 - 4 files changed, 9 insertions(+), 16 deletions(-) diff --git a/src/Commands.hs b/src/Commands.hs index f31c53c..b501022 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -35,14 +35,14 @@ import Signal import XUtil class Show e => Exec e where - alias :: e -> String - alias e = takeWhile (not . isSpace) $ show e - rate :: e -> Int - rate _ = 10 - run :: e -> IO String - run _ = return "" - start :: e -> (String -> IO ()) -> IO () - start e cb = go + alias :: e -> String + alias e = takeWhile (not . isSpace) $ show e + rate :: e -> Int + rate _ = 10 + run :: e -> IO String + run _ = return "" + start :: e -> (String -> IO ()) -> IO () + start e cb = go where go = run e >>= cb >> tenthSeconds (rate e) >> go trigger :: e -> (Maybe SignalType -> IO ()) -> IO () trigger _ sh = sh Nothing diff --git a/src/Main.hs b/src/Main.hs index c7045b5..5ef5db6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,7 +36,7 @@ import System.Environment import System.Posix.Files import Control.Monad (unless) -import Signal (setupSignalHandler, SignalType(..)) +import Signal (setupSignalHandler) -- $main diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index 1fb9dcb..e232916 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -18,18 +18,12 @@ import Control.Monad(forM_, when) import Control.Concurrent import Control.Concurrent.STM import System.IO --- import System.IO.Unsafe(unsafePerformIO) import Plugins data BufferedPipeReader = BufferedPipeReader String [(Int, String)] deriving (Read, Show) --- pipeState :: MVar String --- pipeState = unsafePerformIO $ newMVar "" - --- pipe :: (String -> IO ()) -> Handle -> IO () --- pipe cb h = hGetLineSafe h >>= cb instance Exec BufferedPipeReader where alias ( BufferedPipeReader a _ ) = a diff --git a/src/Window.hs b/src/Window.hs index e59c5ff..9024fff 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -5,7 +5,6 @@ import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama -import Control.Monad.Reader import Data.Maybe(fromMaybe) import System.Posix.Process (getProcessID) -- cgit v1.2.3 From dd78c8bfa52ba0b10e6acf8bde8d467fb02a8d4e Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 10:25:52 +0200 Subject: Implement trigger method for BufferedPipeReader Plugin Using the trigger method activity on a pipe can now cause the window to appear (reveal) and disappear again after a given timeout. The timeout for hiding the window is the same as for restoring the pipes content. The timeout value is given in tenth of seconds. --- src/Plugins/BufferedPipeReader.hs | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index e232916..602862e 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -18,39 +18,48 @@ import Control.Monad(forM_, when) import Control.Concurrent import Control.Concurrent.STM import System.IO +import System.IO.Unsafe(unsafePerformIO) import Plugins +import Signal -data BufferedPipeReader = BufferedPipeReader String [(Int, String)] +data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)] deriving (Read, Show) +signal :: MVar SignalType +signal = unsafePerformIO newEmptyMVar instance Exec BufferedPipeReader where - alias ( BufferedPipeReader a _ ) = a - start ( BufferedPipeReader _ ps ) cb = do + alias ( BufferedPipeReader a _ ) = a + + trigger br@( BufferedPipeReader _ _ ) sh = + takeMVar signal >>= sh . Just >> trigger br sh + + start ( BufferedPipeReader _ ps ) cb = do (chan, str, rst) <- initV forM_ ps $ \p -> forkIO $ reader p chan writer chan str rst where - initV :: IO ( TChan (Int, String), TVar String, TVar Bool ) + initV :: IO ( TChan (Int, Bool, String), TVar String, TVar Bool ) initV = atomically $ do tc <- newTChan ts <- newTVar "" tb <- newTVar False return (tc, ts, tb) - reader :: (Int, FilePath) -> TChan (Int, String) -> IO () - reader p@(to, fp) tc = do + reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO () + reader p@(to, tg, fp) tc = do openFile fp ReadWriteMode >>= hGetLineSafe >>= \dt -> - atomically $ writeTChan tc (to, dt) + atomically $ writeTChan tc (to, tg, dt) reader p tc - writer :: TChan (Int, String) -> TVar String -> TVar Bool -> IO () + writer :: TChan (Int, Bool, String) -> TVar String -> TVar Bool -> IO () writer tc ts otb = do - (to, dt, ntb) <- update + (to, tg, dt, ntb) <- update cb dt + when tg $ putMVar signal Reveal when (to /= 0) $ sfork $ reset to ts ntb writer tc ts ntb @@ -58,15 +67,16 @@ instance Exec BufferedPipeReader where sfork :: IO () -> IO () sfork f = forkIO f >> return () - update :: IO (Int, String, TVar Bool) + update :: IO (Int, Bool, String, TVar Bool) update = atomically $ do - (to, dt) <- readTChan tc + (to, tg, dt) <- readTChan tc when (to == 0) $ writeTVar ts dt writeTVar otb False tb <- newTVar True - return (to, dt, tb) + return (to, tg, dt, tb) reset :: Int -> TVar String -> TVar Bool -> IO () reset to ts tb = do threadDelay ( to * 100 * 1000 ) - readTVarIO tb >>= flip when ( readTVarIO ts >>= cb ) + readTVarIO tb >>= + flip when ( putMVar signal Hide >> readTVarIO ts >>= cb ) -- cgit v1.2.3 From fc474471e12afd5ec958082a7246f2ee22fcc2cf Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 11:44:39 +0200 Subject: Bugfix: Replace TVar with TMVar for the old value This solves a problem when there is only one pipe in place. With a default value of "" and only one pipe with a timeout the value is overwritten with "" after the timeout. To prevent this from happening a TMVar is used which will never be filled if there is only one pipe. --- src/Plugins/BufferedPipeReader.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index 602862e..8a91967 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -42,10 +42,10 @@ instance Exec BufferedPipeReader where writer chan str rst where - initV :: IO ( TChan (Int, Bool, String), TVar String, TVar Bool ) + initV :: IO ( TChan (Int, Bool, String), TMVar String, TVar Bool ) initV = atomically $ do tc <- newTChan - ts <- newTVar "" + ts <- newEmptyTMVar tb <- newTVar False return (tc, ts, tb) @@ -55,7 +55,7 @@ instance Exec BufferedPipeReader where atomically $ writeTChan tc (to, tg, dt) reader p tc - writer :: TChan (Int, Bool, String) -> TVar String -> TVar Bool -> IO () + writer :: TChan (Int, Bool, String) -> TMVar String -> TVar Bool -> IO () writer tc ts otb = do (to, tg, dt, ntb) <- update cb dt @@ -70,13 +70,14 @@ instance Exec BufferedPipeReader where update :: IO (Int, Bool, String, TVar Bool) update = atomically $ do (to, tg, dt) <- readTChan tc - when (to == 0) $ writeTVar ts dt + when (to == 0) $ tryPutTMVar ts dt >> return () writeTVar otb False tb <- newTVar True return (to, tg, dt, tb) - reset :: Int -> TVar String -> TVar Bool -> IO () + reset :: Int -> TMVar String -> TVar Bool -> IO () reset to ts tb = do threadDelay ( to * 100 * 1000 ) - readTVarIO tb >>= - flip when ( putMVar signal Hide >> readTVarIO ts >>= cb ) + readTVarIO tb >>= \b -> when b $ do + putMVar signal Hide + atomically (tryTakeTMVar ts) >>= maybe (return ()) cb -- cgit v1.2.3 From 6c456e9e1f881fd70e9c1b357edfc5d63f7a3204 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 12:07:33 +0200 Subject: Bugfix: Do not hide the window when toggling is off for this pipe The window became hidden although the toggling behaviour was set to False for a particular pipe. This fixes this behaviour and hides the window only if the configuration option is set to True. --- src/Plugins/BufferedPipeReader.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index 8a91967..be6a652 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -60,7 +60,7 @@ instance Exec BufferedPipeReader where (to, tg, dt, ntb) <- update cb dt when tg $ putMVar signal Reveal - when (to /= 0) $ sfork $ reset to ts ntb + when (to /= 0) $ sfork $ reset to tg ts ntb writer tc ts ntb where @@ -75,9 +75,9 @@ instance Exec BufferedPipeReader where tb <- newTVar True return (to, tg, dt, tb) - reset :: Int -> TMVar String -> TVar Bool -> IO () - reset to ts tb = do + reset :: Int -> Bool -> TMVar String -> TVar Bool -> IO () + reset to tg ts tb = do threadDelay ( to * 100 * 1000 ) readTVarIO tb >>= \b -> when b $ do - putMVar signal Hide + when tg $ putMVar signal Hide atomically (tryTakeTMVar ts) >>= maybe (return ()) cb -- cgit v1.2.3 From 5074fdf2d6aa85ce17ad98112ec5019eb05a39c4 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 08:36:03 +0200 Subject: New configuration option "persistent" When persistent is set to True then xmobar will always be mapped (revealed) and never be hidden. The flag is checked in eventLoop and operation to map/unmap windows is not carried out if persistence is desired. --- src/Config.hs | 3 +++ src/Parsers.hs | 11 +++++++---- src/Xmobar.hs | 16 +++++++++++----- 3 files changed, 21 insertions(+), 9 deletions(-) diff --git a/src/Config.hs b/src/Config.hs index 712687d..47358b0 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -57,6 +57,8 @@ data Config = , borderColor :: String -- ^ Border color , lowerOnStart :: Bool -- ^ Lower to the bottom of the -- window stack on initialization + , persistent :: Bool -- ^ Whether automatic hiding should + -- be enabled or disabled , commands :: [Runnable] -- ^ For setting the command, the command arguments -- and refresh rate for the programs to run (optional) , sepChar :: String -- ^ The character to be used for indicating @@ -96,6 +98,7 @@ defaultConfig = , border = NoBorder , borderColor = "#BFBFBF" , lowerOnStart = True + , persistent = False , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10 , Run StdinReader] , sepChar = "%" diff --git a/src/Parsers.hs b/src/Parsers.hs index f5f00a9..c92480e 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -131,13 +131,15 @@ parseConfig = runParser parseConf fields "Config" . stripComments <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition <|?> pBorder <|?> pBdColor - <|?> pLowerOnStart <|?> pCommands - <|?> pSepChar <|?> pAlignSep - <|?> pTemplate + <|?> pLowerOnStart <|?> pPersistent + <|?> pCommands <|?> pSepChar + <|?> pAlignSep <|?> pTemplate fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" , "border", "borderColor" ,"template", "position" - , "lowerOnStart", "commands"] + , "lowerOnStart", "persistent", "commands" + ] + pFont = strField font "font" pBgColor = strField bgColor "bgColor" pFgColor = strField fgColor "fgColor" @@ -148,6 +150,7 @@ parseConfig = runParser parseConf fields "Config" . stripComments pPosition = field position "position" $ tillFieldEnd >>= read' "position" pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart" + pPersistent = field persistent "persistent" $ tillFieldEnd >>= read' "persistent" pBorder = field border "border" $ tillFieldEnd >>= read' "border" pCommands = field commands "commands" $ readCommands diff --git a/src/Xmobar.hs b/src/Xmobar.hs index a65a236..1ae55bb 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -145,11 +145,17 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do Toggle -> toggle where - hide = hideWindow d w >> eventLoop tv xc signal - reveal = do - r' <- repositionWin d w fs cfg - showWindow d w - eventLoop tv (XConf d r' w fs cfg) signal + isPersistent = not $ persistent cfg + + hide = when isPersistent (hideWindow d w) >> eventLoop tv xc signal + + reveal = if isPersistent + then do + r' <- repositionWin d w fs cfg + showWindow d w + eventLoop tv (XConf d r' w fs cfg) signal + else eventLoop tv xc signal + toggle = isMapped d w >>= \b -> if b then hide else reveal reposWindow rcfg = do -- cgit v1.2.3 From 509eee4e98b5a9a1362a87f0d88e317d08b4dec2 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 08:42:32 +0200 Subject: New SignalType TogglePersistent By sending a TogglePersistent signal the configuration option "persistent" can be changed. Thus it is possible to hide or show xmobar constantly. --- src/Signal.hs | 1 + src/Xmobar.hs | 3 +++ 2 files changed, 4 insertions(+) diff --git a/src/Signal.hs b/src/Signal.hs index 0acdea1..ad19fdd 100644 --- a/src/Signal.hs +++ b/src/Signal.hs @@ -16,6 +16,7 @@ data SignalType = Wakeup | Hide | Reveal | Toggle + | TogglePersistent deriving (Read, Show) -- | Signal handling diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 1ae55bb..adbe956 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -144,6 +144,9 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do Reveal -> reveal Toggle -> toggle + TogglePersistent -> eventLoop + tv xc { config = cfg { persistent = not $ persistent cfg } } signal + where isPersistent = not $ persistent cfg -- cgit v1.2.3 From f51060e267f4f79ed18e4a4ffe93dad2cbeb85f0 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 08:45:57 +0200 Subject: Add IPC with DBus as optional build dependency Not everybody has/wants the DBus library so this can be chosen at compile time. --- xmobar.cabal | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/xmobar.cabal b/xmobar.cabal index f153cd2..8e5b604 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -65,6 +65,10 @@ flag with_mpris description: MPRIS v1, v2 support default: False +flag with_dbus + description: Publish a Service on the Session Bus for controlling xmobar + default: False + flag with_threaded description: Use threaded runtime default: False @@ -165,3 +169,8 @@ executable xmobar build-depends: dbus-core >= 0.9.2.1, text >= 0.11.1.5 && < 0.12 other-modules: Plugins.Monitors.Mpris cpp-options: -DMPRIS + + if flag(with_dbus) || flag(all_extensions) + build-depends: dbus >= 0.10 + other-modules: IPC.DBus + cpp-options: -DDBUS -- cgit v1.2.3 From a7158c426ae008fb268f603f75d027683f726757 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 11:35:35 +0200 Subject: Add an initial (working) version of the DBus IPC module --- src/IPC/DBus.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 src/IPC/DBus.hs diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs new file mode 100644 index 0000000..64e3cca --- /dev/null +++ b/src/IPC/DBus.hs @@ -0,0 +1,66 @@ +----------------------------------------------------------------------------- +-- | +-- Module : DBus +-- Copyright : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jochen Keil +-- Stability : unstable +-- Portability : unportable +-- +-- DBus IPC module for Xmobar +-- +----------------------------------------------------------------------------- + +module IPC.DBus ( runIPC ) where + +import DBus +import DBus.Client +import Control.Monad ((>=>), join, when) +import Control.Concurrent + +import Signal + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (x:_) = Just x + +instance IsVariant SignalType where + toVariant = toVariant . show + fromVariant = fromVariant >=> parseSignalType + +parseSignalType :: String -> Maybe SignalType +parseSignalType = fmap fst . safeHead . reads + +busName :: BusName +busName = busName_ "org.Xmobar.Control" + +objectPath :: ObjectPath +objectPath = objectPath_ "/org/Xmobar/Control" + +interfaceName :: InterfaceName +interfaceName = interfaceName_ "org.Xmobar.Control" + +runIPC :: MVar SignalType -> IO () +runIPC mvst = do + client <- connectSession + requestName client busName [ nameDoNotQueue ] + export client objectPath [ sendSignalMethod mvst ] + +sendSignalMethod :: MVar SignalType -> Method +sendSignalMethod mvst = method interfaceName sendSignalName + (signature_ [variantType $ toVariant $ (undefined :: SignalType)]) + (signature_ []) + sendSignalMethodCall + where + sendSignalName :: MemberName + sendSignalName = memberName_ "SendSignal" + + sendSignalMethodCall :: MethodCall -> IO Reply + sendSignalMethodCall mc = do + when ( methodCallMember mc == sendSignalName ) $ sendSignal $ + join $ safeHead $ map fromVariant $ methodCallBody mc + return ( replyReturn [] ) + + sendSignal :: Maybe SignalType -> IO () + sendSignal = maybe (return ()) (putMVar mvst) -- cgit v1.2.3 From 1f603c25eea15d302a4aa1ebb879bbd8198a3b82 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 11:37:22 +0200 Subject: Move safeHead to Plugins.Utils safeHead is a very general utility function with suits better into a common Util module. --- src/IPC/DBus.hs | 5 +---- src/Plugins/Utils.hs | 6 +++++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs index 64e3cca..4357c48 100644 --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -20,10 +20,7 @@ import Control.Monad ((>=>), join, when) import Control.Concurrent import Signal - -safeHead :: [a] -> Maybe a -safeHead [] = Nothing -safeHead (x:_) = Just x +import Plugins.Utils (safeHead) instance IsVariant SignalType where toVariant = toVariant . show diff --git a/src/Plugins/Utils.hs b/src/Plugins/Utils.hs index 1dbcd40..bbfa84f 100644 --- a/src/Plugins/Utils.hs +++ b/src/Plugins/Utils.hs @@ -15,7 +15,7 @@ ------------------------------------------------------------------------------ -module Plugins.Utils (expandHome, changeLoop) where +module Plugins.Utils (expandHome, changeLoop, safeHead) where import Control.Monad import Control.Concurrent.STM @@ -37,3 +37,7 @@ changeLoop s f = atomically s >>= go new <- s guard (new /= old) return new) + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (x:_) = Just x -- cgit v1.2.3 From b318c3c18d3c2d4866c3f325f8ec6f00a42876fb Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 11:38:52 +0200 Subject: Move the IsVariant SignalType instance to Signal module This belongs here, otherwise ghc will complain about orphaned instances --- src/IPC/DBus.hs | 9 +-------- src/Signal.hs | 18 +++++++++++++++++- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs index 4357c48..b0597a4 100644 --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -16,19 +16,12 @@ module IPC.DBus ( runIPC ) where import DBus import DBus.Client -import Control.Monad ((>=>), join, when) +import Control.Monad (join, when) import Control.Concurrent import Signal import Plugins.Utils (safeHead) -instance IsVariant SignalType where - toVariant = toVariant . show - fromVariant = fromVariant >=> parseSignalType - -parseSignalType :: String -> Maybe SignalType -parseSignalType = fmap fst . safeHead . reads - busName :: BusName busName = busName_ "org.Xmobar.Control" diff --git a/src/Signal.hs b/src/Signal.hs index ad19fdd..f634c16 100644 --- a/src/Signal.hs +++ b/src/Signal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, CPP #-} module Signal where @@ -7,6 +7,13 @@ import Control.Concurrent import Control.Exception hiding (handle) import System.Posix.Signals +#ifdef DBUS +import DBus (IsVariant(..)) +import Control.Monad ((>=>)) + +import Plugins.Utils (safeHead) +#endif + data WakeUp = WakeUp deriving (Show,Typeable) instance Exception WakeUp @@ -19,6 +26,15 @@ data SignalType = Wakeup | TogglePersistent deriving (Read, Show) +#ifdef DBUS +instance IsVariant SignalType where + toVariant = toVariant . show + fromVariant = fromVariant >=> parseSignalType +#endif + +parseSignalType :: String -> Maybe SignalType +parseSignalType = fmap fst . safeHead . reads + -- | Signal handling setupSignalHandler :: IO (MVar SignalType) setupSignalHandler = do -- cgit v1.2.3 From 2af5fab3c8df61ec189bcc880524fe73a6e1e361 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Fri, 10 Aug 2012 11:40:01 +0200 Subject: Run the DBus event handler in startCommand Actually run this stuff --- src/Xmobar.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index adbe956..fb0860d 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -50,6 +50,10 @@ import Signal import Window import XUtil +#ifdef DBUS +import IPC.DBus +#endif + -- $main -- -- The Xmobar data type and basic loops and functions. @@ -191,6 +195,9 @@ startCommand sig (com,s,ss) let cb str = atomically $ writeTVar var (s ++ str ++ ss) h <- forkIO $ start com cb _ <- forkIO $ trigger com ( maybe (return ()) (putMVar sig) ) +#ifdef DBUS + runIPC sig +#endif return (Just h,var) where is = s ++ "Updating..." ++ ss -- cgit v1.2.3 From d433166f0bb3e1d7e8da20c1d9007bee2b39e522 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Sat, 11 Aug 2012 21:56:12 +0200 Subject: Add sample option for persistent and update option description Description for lowerOnStart was missing. --- readme.md | 8 ++++++++ samples/xmobar.config | 1 + 2 files changed, 9 insertions(+) diff --git a/readme.md b/readme.md index 5fba067..6fb6ef2 100644 --- a/readme.md +++ b/readme.md @@ -221,6 +221,14 @@ Other configuration options: : position = Top +`lowerOnStart` +: When True the window is initially hidden (can be toggled) + +`persistent` +: When True the window status is fixed i.e. hiding or revealing is not + possible. This option can be toggled at runtime. + + `border` : TopB, TopBM, BottomB, BottomBM, FullB, FullBM or NoBorder (default). diff --git a/samples/xmobar.config b/samples/xmobar.config index 1e41945..faf6ac6 100644 --- a/samples/xmobar.config +++ b/samples/xmobar.config @@ -5,6 +5,7 @@ Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" , fgColor = "grey" , position = Top , lowerOnStart = True + , persistent = False , commands = [ Run Weather "EGPF" ["-t",": C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"] 36000 , Run Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"] 10 , Run Network "eth1" ["-L","0","-H","32","--normal","green","--high","red"] 10 -- cgit v1.2.3 From d574e620411a6743805b3f0233b55bfdebfa05c9 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Sat, 11 Aug 2012 22:20:30 +0200 Subject: Documentation for the DBus Interface --- readme.md | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/readme.md b/readme.md index 6fb6ef2..5ea2cc4 100644 --- a/readme.md +++ b/readme.md @@ -301,6 +301,30 @@ xmobar --help): Mail bug reports and suggestions to +## The DBus Interface + +xmobar can be controlled over dbus. All signals defined in [src/Signal.hs] as +`data SignalType` can now be sent over dbus to xmobar. + +[src/Signal.hs]: https://github.com/jaor/xmobar/raw/master/src/Signal.hs + +- Bus Name: `org.Xmobar.Control` +- Object Path: `/org/Xmobar/Control` +- Member Name: Any of SignalType, e.g. `string:Reveal` +- Interface Name: `org.Xmobar.Control` + +An example using the `dbus-send` command line utility: + + dbus-send \ + --session \ + --dest=org.Xmobar.Control \ + --type=method_call \ + --print-reply \ + '/org/Xmobar/Control' \ + org.Xmobar.Control.SendSignal \ + "string:Toggle" + + ## The Output Template The output template must contain at least one command. xmobar will -- cgit v1.2.3 From a7a2234de9a4f5f7bc5cdd626f40d8505967d1c0 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Sat, 11 Aug 2012 22:21:15 +0200 Subject: Documentation for the BufferedPipeReader plugin (+ sample script) The sample script is quite generic. It works for demo purposes and can be used as a template for users to write their own scripts. --- readme.md | 29 +++++++++++++++++++++++++++++ samples/status.sh | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+) create mode 100755 samples/status.sh diff --git a/readme.md b/readme.md index 5ea2cc4..e66b438 100644 --- a/readme.md +++ b/readme.md @@ -951,6 +951,35 @@ can be used in the output template as `%mydate%` - Reads its displayed output from the given pipe. +`BufferedPipeReader Alias [ (Timeout, Bool, "/path/to/pipe1") + , (Timeout, Bool, "/path/to/pipe2") + , .. + ]` + +- Display data from multiple pipes. +- Timeout (in tenth of seconds) is the value after which the previous content is + restored i.e. if there was already something from a previous pipe it will be + put on display again, overwriting the current status. +- A pipe with Timout of 0 will be displayed permanently, just like `PipeReader` +- The boolean option indicates whether new data for this pipe should make xmobar + appear (unhide, reveal). In this case, the Timeout additionally specifies when + the window should be hidden again. The output is restored in any case. +- Use it for OSD like status bars e.g. for setting the volume or brightness: + + Run BufferedPipeReader "bpr" + [ ( 0, False, "/tmp/xmobar_window" ) + , ( 15, True, "/tmp/xmobar_status" ) + ] + + Have your window manager send window titles to `"/tmp/xmobar_window"`. They will + always be shown and not reveal your xmobar. + Sending some status information to `"/tmp/xmobar_status"` will reveal xmonad + for 1.5 seconds and temporarily overwrite the window titles. +- Take a look at [samples/status.sh] + +[samples/status.sh]: http://github.com/jaor/xmobar/raw/master/samples/status.sh + + `XMonadLog` - Aliases to XMonadLog diff --git a/samples/status.sh b/samples/status.sh new file mode 100755 index 0000000..fc8af11 --- /dev/null +++ b/samples/status.sh @@ -0,0 +1,47 @@ +#!/bin/sh + + +STATUSPIPE="/tmp/xmobar_status_jrk" +NORMAL='#eee8d5' +MUTED='#cb4b16' +FGCOLOR="#657b83" + +function isMuted () { + # retrieve mute status + # return an arbitrary string for true or nothing at all + echo +} + +function getPercent () { + # somehow retrieve the percent value as plain int (e.g. "66") + echo "66" +} + + +function percentBar () { + local res= i=1 + local percent=$( getPercent ) + + if [ -n "$( isMuted )" ]; then + res="" + else + res="" + fi + + while [ $i -lt $percent ]; do + res+='#' + i=$((i+1)) + done + + res+="" + + while [ $i -lt 100 ]; do + res+='-' + i=$((i+1)) + done + + echo "$res" +} + + +echo "$( percentBar )" > "$STATUSPIPE" -- cgit v1.2.3 From 901bd4c9067b05616392de238d525dd8d4a99f45 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Sat, 11 Aug 2012 21:22:45 +0200 Subject: Fix the MPRIS plugin to work with DBus >= 0.10 This commit updates the mpris plugin to use the DBus 0.10 interface. DBus-Core does no longer exist and is deprecated. DBus 0.10 does not use proxies anymore. The dependency on Data.Text also disappeared. Since I do not have/use mpris I cannot test if this works. It should however, since the functionality was just transformed to use the new interface. --- src/Plugins/Monitors/Mpris.hs | 61 ++++++++++++++++++++++++------------------- xmobar.cabal | 2 +- 2 files changed, 35 insertions(+), 28 deletions(-) diff --git a/src/Plugins/Monitors/Mpris.hs b/src/Plugins/Monitors/Mpris.hs index 0fa181c..b899a16 100644 --- a/src/Plugins/Monitors/Mpris.hs +++ b/src/Plugins/Monitors/Mpris.hs @@ -21,43 +21,50 @@ module Plugins.Monitors.Mpris ( mprisConfig, runMPRIS1, runMPRIS2 ) where import Plugins.Monitors.Common import Text.Printf (printf) -import qualified DBus.Client.Simple as C -import DBus.Types -import DBus.Connection ( ConnectionError ) + +import DBus +import qualified DBus.Client as DC + import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Text as T import Control.Exception (try) class MprisVersion a where - getProxy :: a -> C.Client -> String -> IO C.Proxy - getMetadataReply :: a -> C.Client -> String -> IO [Variant] + getMethodCall :: a -> String -> MethodCall + getMetadataReply :: a -> DC.Client -> String -> IO [Variant] + getMetadataReply mv c p = fmap methodReturnBody (DC.call_ c $ getMethodCall mv p) fieldsList :: a -> [String] data MprisVersion1 = MprisVersion1 instance MprisVersion MprisVersion1 where - getProxy MprisVersion1 c p = do - let playerBusName = T.concat ["org.mpris.", T.pack p] - C.proxy c (C.busName_ playerBusName) "/Player" - getMetadataReply MprisVersion1 c p = do - player <- getProxy MprisVersion1 c p - C.call player "org.freedesktop.MediaPlayer" "GetMetadata" [] - fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title", "tracknumber" ] + getMethodCall MprisVersion1 p = (methodCall objectPath interfaceName memberName) + { methodCallDestination = Just busName + } + where + busName = busName_ $ "org.mpris." ++ p + objectPath = objectPath_ $ "/Player" + interfaceName = interfaceName_ $ "org.freedesktop.MediaPlayer" + memberName = memberName_ $ "GetMetadata" + + fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title" + , "tracknumber" ] data MprisVersion2 = MprisVersion2 instance MprisVersion MprisVersion2 where - getProxy MprisVersion2 c p = do - let playerBusName = T.concat ["org.mpris.MediaPlayer2.", T.pack p] - C.proxy c (C.busName_ playerBusName) "/org/mpris/MediaPlayer2" - getMetadataReply MprisVersion2 c p = do - player <- getProxy MprisVersion2 c p - C.call player "org.freedesktop.DBus.Properties" - "Get" - (map (toVariant::String -> Variant) - ["org.mpris.MediaPlayer2.Player", "Metadata"] - ) + getMethodCall MprisVersion2 p = (methodCall objectPath interfaceName memberName) + { methodCallDestination = Just busName + , methodCallBody = arguments + } + where + busName = busName_ $ "org.mpris.MediaPlayer2." ++ p + objectPath = objectPath_ $ "/org/mpris/MediaPlayer2" + interfaceName = interfaceName_ $ "org.freedesktop.DBus.Properties" + memberName = memberName_ $ "Get" + arguments = map (toVariant::String -> Variant) + ["org.mpris.MediaPlayer2.Player", "Metadata"] + fieldsList MprisVersion2 = [ "xesam:album", "xesam:artist", "mpris:artUrl" , "mpris:length", "xesam:title", "xesam:trackNumber" ] @@ -67,8 +74,8 @@ mprisConfig = mkMConfig " - " [ "album", "artist", "arturl", "length" , "title", "tracknumber" ] -dbusClient :: C.Client -dbusClient = unsafePerformIO C.connectSession +dbusClient :: DC.Client +dbusClient = unsafePerformIO DC.connectSession runMPRIS :: (MprisVersion a) => a -> String -> [String] -> Monitor String runMPRIS version playerName _ = do @@ -95,10 +102,10 @@ unpackMetadata xs = ((map (\(k, v) -> (fromVar k, fromVar v))) . unpack . head) TypeStructure _ -> unpack $ head $ structureItems $ fromVar v _ -> [] -getMetadata :: (MprisVersion a) => a -> C.Client -> String -> IO [(String, Variant)] +getMetadata :: (MprisVersion a) => a -> DC.Client -> String -> IO [(String, Variant)] getMetadata version client player = do reply <- try (getMetadataReply version client player) :: - IO (Either ConnectionError [Variant]) + IO (Either DC.ClientError [Variant]) return $ case reply of Right metadata -> unpackMetadata metadata; Left _ -> [] diff --git a/xmobar.cabal b/xmobar.cabal index 8e5b604..54f932e 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -166,7 +166,7 @@ executable xmobar cpp-options: -DDATEZONE if flag(with_mpris) || flag(all_extensions) - build-depends: dbus-core >= 0.9.2.1, text >= 0.11.1.5 && < 0.12 + build-depends: dbus >= 0.10 other-modules: Plugins.Monitors.Mpris cpp-options: -DMPRIS -- cgit v1.2.3 From 89063445bca98bd27544e0fec4e1dfbfe2730c28 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz <jao@gnu.org> Date: Sat, 11 Aug 2012 23:34:05 +0200 Subject: A bit of documentation re mpris --- news.md | 2 ++ readme.md | 6 +++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/news.md b/news.md index 963f5c5..991a981 100644 --- a/news.md +++ b/news.md @@ -8,6 +8,8 @@ _New features_ MPD status (thanks to Ben Boeckel). - Dependencies updated to latest mtl and libmpd (thanks to Sergei Trofimovich). + - Dependencies on the deprecated dbus-core removed in favour of + dbus 0.10. _Bug fixes_ diff --git a/readme.md b/readme.md index e66b438..1c13d27 100644 --- a/readme.md +++ b/readme.md @@ -121,7 +121,7 @@ Otherwise, you'll need to install them yourself. `with_mpris` : Enables support for MPRIS v1/v2 protocol. - Requires the [dbus-core] and [text] packages. + Requires the [dbus] and [text] packages. `with_inotify` : Support for inotify in modern linux kernels. This option is needed @@ -676,7 +676,7 @@ Monitors have default aliases. ### `Mpris1 PlayerName Args RefreshRate` - Aliases to `mpris1` -- Requires [dbus-core] and [text] packages. +- Requires [dbus] and [text] packages. To activate, pass `--flags="with_mpris"` during compilation. - PlayerName: player supporting MPRIS v1 protocol, in lowercase. - Args: default monitor arguments. @@ -1188,7 +1188,7 @@ Copyright © 2010-2012 Jose Antonio Ortega Ruiz [iwlib]: http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html [hinotify]: http://hackage.haskell.org/package/hinotify/ [libmpd]: http://hackage.haskell.org/package/libmpd/ -[dbus-core]: http://hackage.haskell.org/package/dbus-core +[dbus]: http://hackage.haskell.org/package/dbus [text]: http://hackage.haskell.org/package/text [sawfish]: http://sawfish.wikia.com/ [utf8-string]: http://hackage.haskell.org/package/utf8-string/ -- cgit v1.2.3 -- cgit v1.2.3 From 8a53271cd677bea3223f7d25eb1f697aa3d96540 Mon Sep 17 00:00:00 2001 From: Jochen Keil <jochen.keil@gmail.com> Date: Sun, 12 Aug 2012 10:33:41 +0200 Subject: Catch error when DBus connection fails connectSession throws a ClientError Exception when DBUS_SESSION_BUS_ADDRESS is unset. Without exception handler this will result in program termination. Since the DBus handler merely sends a signal to the event loop it does no harm when it won't run. Normal operation will continue just if compiled without dbus support. --- src/IPC/DBus.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/IPC/DBus.hs b/src/IPC/DBus.hs index b0597a4..469a7c6 100644 --- a/src/IPC/DBus.hs +++ b/src/IPC/DBus.hs @@ -14,10 +14,14 @@ module IPC.DBus ( runIPC ) where +import Prelude hiding (catch) + import DBus import DBus.Client import Control.Monad (join, when) import Control.Concurrent +import Control.Exception (catch) +import System.IO (stderr, hPutStrLn) import Signal import Plugins.Utils (safeHead) @@ -32,10 +36,14 @@ interfaceName :: InterfaceName interfaceName = interfaceName_ "org.Xmobar.Control" runIPC :: MVar SignalType -> IO () -runIPC mvst = do - client <- connectSession - requestName client busName [ nameDoNotQueue ] - export client objectPath [ sendSignalMethod mvst ] +runIPC mvst = catch exportConnection printException + where + printException :: ClientError -> IO () + printException = hPutStrLn stderr . clientErrorMessage + exportConnection = do + client <- connectSession + requestName client busName [ nameDoNotQueue ] + export client objectPath [ sendSignalMethod mvst ] sendSignalMethod :: MVar SignalType -> Method sendSignalMethod mvst = method interfaceName sendSignalName -- cgit v1.2.3 From 2570b0d756121fb6314de514412b52f648d0fc25 Mon Sep 17 00:00:00 2001 From: Jochen Keil <jochen.keil@gmail.com> Date: Sun, 12 Aug 2012 10:39:08 +0200 Subject: Run the DBus/IPC handler only once on program start The startCommand function is called for every configured plugin. This results in multiple calls to runIPC. This it not necessary however. startLoop is a much more appropriate place, since the other signal handler (checker and eventer) are run here to. --- src/Xmobar.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index fb0860d..d758301 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -87,6 +87,9 @@ startLoop xcfg@(XConf _ _ w _ conf) sig vs = do _ <- forkIO (eventer sig `catch` #endif \(SomeException _) -> void (putStrLn "Thread eventer failed")) +#ifdef DBUS + runIPC sig +#endif eventLoop tv xcfg sig where -- Reacts on events from X @@ -195,9 +198,6 @@ startCommand sig (com,s,ss) let cb str = atomically $ writeTVar var (s ++ str ++ ss) h <- forkIO $ start com cb _ <- forkIO $ trigger com ( maybe (return ()) (putMVar sig) ) -#ifdef DBUS - runIPC sig -#endif return (Just h,var) where is = s ++ "Updating..." ++ ss -- cgit v1.2.3 From abb0b488741fc2f20a1486a6f122f7f6fa38e92d Mon Sep 17 00:00:00 2001 From: Jochen Keil <jochen.keil@gmail.com> Date: Sun, 12 Aug 2012 11:33:54 +0200 Subject: Fancier status script sample This sample script uses colors and unicode signs for drawing a status bar for e.g. volume. The unicode character can be simply changed to an ascii one in case of problems. --- samples/status.sh | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/samples/status.sh b/samples/status.sh index fc8af11..c84d7f2 100755 --- a/samples/status.sh +++ b/samples/status.sh @@ -1,10 +1,6 @@ #!/bin/sh - STATUSPIPE="/tmp/xmobar_status_jrk" -NORMAL='#eee8d5' -MUTED='#cb4b16' -FGCOLOR="#657b83" function isMuted () { # retrieve mute status @@ -17,23 +13,35 @@ function getPercent () { echo "66" } - function percentBar () { - local res= i=1 - local percent=$( getPercent ) - - if [ -n "$( isMuted )" ]; then - res="<fc=$MUTED>" + local i=1 res= + normal=47 high=80 + fgColor='#657b83' mutedColor='#cb4b16' + lowColor='#859900' midColor='#b58900' + highColor='#cb4b16' + + bar="$(echo -ne "\u2588")" + percent="$( getPercent )" + muted="$( isMuted )" + + if [ -n "$muted" ]; then + res="<fc=$mutedColor>" else - res="<fc=$NORMAL>" + res="<fc=$lowColor>" fi while [ $i -lt $percent ]; do - res+='#' + if [ $i -eq $normal -a -z "$muted" ]; then + res+="</fc><fc=$midColor>" + elif [ $i -eq $high -a -z "$muted" ]; then + res+="</fc><fc=$highColor>" + fi + + res+=$bar i=$((i+1)) done - res+="</fc><fc=$FGCOLOR>" + res+="</fc><fc=$fgColor>" while [ $i -lt 100 ]; do res+='-' @@ -43,5 +51,4 @@ function percentBar () { echo "$res</fc>" } - echo "$( percentBar )" > "$STATUSPIPE" -- cgit v1.2.3 From b8cf77207eb7dfa99f842f5b7e63fee95efe3796 Mon Sep 17 00:00:00 2001 From: Jochen Keil <jochen.keil@gmail.com> Date: Mon, 13 Aug 2012 07:28:55 +0200 Subject: Revert lowerOnStart to its original behaviour I misunderstood the intention of lowerOnStart and changed the implementation to what I thought it would have to do. This was wrong indeed, so back to original behaviour. --- readme.md | 3 --- src/Window.hs | 1 + src/Xmobar.hs | 1 - 3 files changed, 1 insertion(+), 4 deletions(-) diff --git a/readme.md b/readme.md index 1c13d27..7d06087 100644 --- a/readme.md +++ b/readme.md @@ -221,9 +221,6 @@ Other configuration options: : position = Top -`lowerOnStart` -: When True the window is initially hidden (can be toggled) - `persistent` : When True the window status is fixed i.e. hiding or revealing is not possible. This option can be toggled at runtime. diff --git a/src/Window.hs b/src/Window.hs index 9024fff..50bfc56 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -24,6 +24,7 @@ createWin d fs c = do (r,o) = setPosition (position c) srs (fi ht) win <- newWindow d (defaultScreenOfDisplay d) rootw r o setProperties r c d win srs + when (lowerOnStart c) (lowerWindow d win) mapWindow d win return (r,win) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index d758301..5328b6e 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -78,7 +78,6 @@ runX xc f = runReaderT f xc startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () startLoop xcfg@(XConf _ _ w _ conf) sig vs = do tv <- atomically $ newTVar [] - when (lowerOnStart conf) $ putMVar sig Hide _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) #ifdef THREADED_RUNTIME -- cgit v1.2.3 From 501b4afb25692bf8449088594d46a3c22645d325 Mon Sep 17 00:00:00 2001 From: Jochen Keil <jochen.keil@gmail.com> Date: Mon, 13 Aug 2012 07:30:27 +0200 Subject: Add a bit about DBus to documentation Only one process can export the dbus interface at a time. --- readme.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/readme.md b/readme.md index 7d06087..c78f9ab 100644 --- a/readme.md +++ b/readme.md @@ -302,6 +302,10 @@ xmobar --help): xmobar can be controlled over dbus. All signals defined in [src/Signal.hs] as `data SignalType` can now be sent over dbus to xmobar. +Due to current limitations of the implementation only one process of xmobar can +aquire the dbus. This is handled in a FCFS manor, meaning that the first process +will get the dbus interface. Other processes will run without further problems, +yet have no dbus interface. [src/Signal.hs]: https://github.com/jaor/xmobar/raw/master/src/Signal.hs -- cgit v1.2.3 From bd6ea2a17e3bb779d5e8d787ffcb170fecc92043 Mon Sep 17 00:00:00 2001 From: Jochen Keil <jochen.keil@gmail.com> Date: Mon, 13 Aug 2012 07:31:41 +0200 Subject: sh is not linked to bash on all systems This is a bash script, so for correctness is needs to be /bin/bash --- samples/status.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/samples/status.sh b/samples/status.sh index c84d7f2..94e8fe7 100755 --- a/samples/status.sh +++ b/samples/status.sh @@ -1,4 +1,4 @@ -#!/bin/sh +#!/bin/bash STATUSPIPE="/tmp/xmobar_status_jrk" -- cgit v1.2.3 From b3bdd804bda130d1ec0a66192e633ee0e0a476ca Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz <jao@gnu.org> Date: Mon, 13 Aug 2012 14:57:31 +0200 Subject: Missing import for 'when' --- src/Window.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Window.hs b/src/Window.hs index 50bfc56..a069f1f 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -1,6 +1,7 @@ module Window where import Prelude hiding (catch) +import Control.Monad (when) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama -- cgit v1.2.3 From bf525097ee78c008f2c96653b3c4eb03f4923246 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz <jao@gnu.org> Date: Mon, 13 Aug 2012 15:09:42 +0200 Subject: Missing file headers and linting --- src/Signal.hs | 16 ++++++++++++++++ src/Window.hs | 15 +++++++++++++++ src/Xmobar.hs | 2 +- 3 files changed, 32 insertions(+), 1 deletion(-) diff --git a/src/Signal.hs b/src/Signal.hs index f634c16..3c341f9 100644 --- a/src/Signal.hs +++ b/src/Signal.hs @@ -1,5 +1,21 @@ {-# LANGUAGE DeriveDataTypeable, CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Signal +-- Copyright : (c) Andrea Rosatto +-- : (c) Jose A. Ortega Ruiz +-- : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- Signal handling, including DBUS when available +-- +----------------------------------------------------------------------------- + module Signal where import Data.Typeable (Typeable) diff --git a/src/Window.hs b/src/Window.hs index a069f1f..0ffa139 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -1,3 +1,18 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Window +-- Copyright : (c) 2011-12 Jose A. Ortega Ruiz +-- : (c) 2012 Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- Window manipulation functions +-- +----------------------------------------------------------------------------- + module Window where import Prelude hiding (catch) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 5328b6e..2dbba11 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -76,7 +76,7 @@ runX xc f = runReaderT f xc -- | Starts the main event loop and threads startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () -startLoop xcfg@(XConf _ _ w _ conf) sig vs = do +startLoop xcfg@(XConf _ _ w _ _) sig vs = do tv <- atomically $ newTVar [] _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) -- cgit v1.2.3 From b973eb269f6017c488bb71474f457a3b479ea90e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz <jao@gnu.org> Date: Mon, 13 Aug 2012 15:09:58 +0200 Subject: Jochen in the list of contributors --- readme.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/readme.md b/readme.md index c78f9ab..36c2173 100644 --- a/readme.md +++ b/readme.md @@ -1126,11 +1126,11 @@ the greater Haskell community. In particular, xmobar [incorporates patches] by Ben Boeckel, Roman Cheplyaka, John Goerzen, Juraj Hercek, Tomas Janousek, Spencer -Janssen, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry -Kurochkin, Svein Ove, Martin Perner, Jens Petersen, Petr Rockai, -Andrew Sackville-West, Alexander Solovyov, Artem Tarasov, Sergei -Trofimovich, Thomas Tuegel, Jan Vornberger, Daniel Wagner and Norbert -Zeh. +Janssen, Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, +Dmitry Kurochkin, Svein Ove, Martin Perner, Jens Petersen, Petr +Rockai, Andrew Sackville-West, Alexander Solovyov, Artem Tarasov, +Sergei Trofimovich, Thomas Tuegel, Jan Vornberger, Daniel Wagner and +Norbert Zeh. [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors -- cgit v1.2.3 From 05f268c3a831325f65a662c6ccdff75a1c441d83 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz <jao@gnu.org> Date: Mon, 13 Aug 2012 15:10:15 +0200 Subject: New goodies by Jochen spelled out in NEWS --- news.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/news.md b/news.md index 991a981..447f5ed 100644 --- a/news.md +++ b/news.md @@ -6,10 +6,16 @@ _New features_ - New monitor `AutoMPD`, which uses asynchronous events to display MPD status (thanks to Ben Boeckel). + - New monitor `BufferedPipeReader` displaying data from multiple + pipes (thanks to Jochen Keil). + - DBUS support: Jochen implemented an extension for DBUS signal + handling. + - Hide/Reveal: one can send signals to xmobar and make it (un)hide + itself (Jochen again). - Dependencies updated to latest mtl and libmpd (thanks to Sergei Trofimovich). - Dependencies on the deprecated dbus-core removed in favour of - dbus 0.10. + dbus 0.10 (thanks to Jochen Keil).. _Bug fixes_ -- cgit v1.2.3