From 8782f37ac9cebf2d1e6da77e9a975faec68c3c26 Mon Sep 17 00:00:00 2001 From: daniel Date: Sat, 14 Nov 2009 06:15:09 +0100 Subject: rework XMonad.Util.Dzen Ignore-this: 16d93f91c54f7d195b1a418e6c0351c5 darcs-hash:20091114051509-c98ca-aeb393daca11b2760066b030f45f6691571e3a1f.gz --- XMonad/Util/Dzen.hs | 157 ++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 145 insertions(+), 12 deletions(-) (limited to 'XMonad/Util') diff --git a/XMonad/Util/Dzen.hs b/XMonad/Util/Dzen.hs index 793d205..a7fb3db 100644 --- a/XMonad/Util/Dzen.hs +++ b/XMonad/Util/Dzen.hs @@ -13,36 +13,169 @@ ----------------------------------------------------------------------------- module XMonad.Util.Dzen ( + -- * Flexible interface + dzenConfig, + timeout, + font, + xScreen, + vCenter, + hCenter, + center, + onCurr, + x, + y, + addArgs, + + -- * Legacy interface dzen, - dzenWithArgs, dzenScreen, - seconds + dzenWithArgs, + + -- * Miscellaneous + seconds, + chomp, + (>=>) ) where +import Control.Monad +import Data.List import XMonad +import XMonad.StackSet import XMonad.Util.Run (runProcessWithInputAndWait, seconds) +type DzenConfig = (Int, [String]) -> X (Int, [String]) + +-- | @dzenConfig config s@ will display the string @s@ according to the +-- configuration @config@. For example, to display the string @\"foobar\"@ with +-- all the default settings, you can simply call +-- +-- > dzenConfig return "foobar" +-- +-- Or, to set a longer timeout, you could use +-- +-- > dzenConfig (timeout 10) "foobar" +-- +-- You can combine configurations with the (>=>) operator. To display +-- @\"foobar\"@ for 10 seconds on the first screen, you could use +-- +-- > dzenConfig (timeout 10 >=> xScreen 0) "foobar" +-- +-- As a final example, you could adapt the above to display @\"foobar\"@ for +-- 10 seconds on the current screen with +-- +-- > dzenConfig (timeout 10 >=> onCurr xScreen) "foobar" +dzenConfig :: DzenConfig -> String -> X () +dzenConfig conf s = do + (t, args) <- conf (seconds 3, []) + runProcessWithInputAndWait "dzen2" args (chomp s) t + +-- | dzen wants exactly one newline at the end of its input, so this can be +-- used for your own invocations of dzen. However, all functions in this +-- module will call this for you. +chomp :: String -> String +chomp = (++"\n") . reverse . dropWhile ('\n' ==) . reverse + +-- | Set the timeout, in seconds. This defaults to 3 seconds if not +-- specified. +timeout :: Rational -> DzenConfig +timeout = timeoutMicro . seconds + +-- | Set the timeout, in microseconds. Mostly here for the legacy +-- interface. +timeoutMicro :: Int -> DzenConfig +timeoutMicro n (_, ss) = return (n, ss) + +-- | Add raw command-line arguments to the configuration. These will be +-- passed on verbatim to dzen2. The default includes no arguments. +addArgs :: [String] -> DzenConfig +addArgs ss (n, ss') = return (n, ss ++ ss') + +-- | Start dzen2 on a particular screen. Only works with versions of dzen +-- that support the "-xs" argument. +xScreen :: ScreenId -> DzenConfig +xScreen sc = addArgs ["-xs", show (fromIntegral sc + 1 :: Int)] + +-- | Take a screen-specific configuration and supply it with the screen ID +-- of the currently focused screen, according to xmonad. For example, show +-- a 100-pixel wide bar centered within the current screen, you could use +-- +-- > dzenConfig (onCurr (hCenter 100)) "foobar" +-- +-- Of course, you can still combine these with (>=>); for example, to center +-- the string @\"foobar\"@ both horizontally and vertically in a 100x14 box +-- using the lovely Terminus font, you could use +-- +-- > terminus = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*" +-- > dzenConfig (onCurr (center 100 14) >=> font terminus) "foobar" +onCurr :: (ScreenId -> DzenConfig) -> DzenConfig +onCurr f conf = gets (screen . current . windowset) >>= flip f conf + +-- | Put the top of the dzen bar at a particular pixel. +x :: Int -> DzenConfig +x n = addArgs ["-x", show n] +-- | Put the left of the dzen bar at a particular pixel. +y :: Int -> DzenConfig +y n = addArgs ["-y", show n] + +-- | Specify the font. Check out xfontsel to get the format of the String +-- right; if your dzen supports xft, then you can supply that here, too. +font :: String -> DzenConfig +font fn = addArgs ["-fn", fn] + +-- | @vCenter height sc@ sets the configuration to have the dzen bar appear +-- on screen @sc@ with height @height@, vertically centered with respect to +-- the actual size of that screen. +vCenter :: Int -> ScreenId -> DzenConfig +vCenter = center' rect_height "-h" "-y" + +-- | @hCenter width sc@ sets the configuration to have the dzen bar appear +-- on screen @sc@ with width @width@, horizontally centered with respect to +-- the actual size of that screen. +hCenter :: Int -> ScreenId -> DzenConfig +hCenter = center' rect_width "-w" "-x" + +-- | @center width height sc@ sets the configuration to have the dzen bar +-- appear on screen @sc@ with width @width@ and height @height@, centered +-- both horizontally and vertically with respect to the actual size of that +-- screen. +center :: Int -> Int -> ScreenId -> DzenConfig +center width height sc = hCenter width sc >=> vCenter height sc + +-- Center things along a single dimension on a particular screen. +center' :: (Rectangle -> Dimension) -> String -> String -> Int -> ScreenId -> DzenConfig +center' selector extentName positionName extent sc conf = do + rect <- gets (detailFromScreenId sc . windowset) + case rect of + Nothing -> return conf + Just r -> addArgs + [extentName , show extent, + positionName, show ((fromIntegral (selector r) - extent) `div` 2), + "-xs" , show (fromIntegral sc + 1 :: Int) + ] conf + +-- Get the rectangle outlining a particular screen. +detailFromScreenId :: ScreenId -> WindowSet -> Maybe Rectangle +detailFromScreenId sc ws = fmap screenRect maybeSD where + c = current ws + v = visible ws + mapping = map (\s -> (screen s, screenDetail s)) (c:v) + maybeSD = lookup sc mapping + -- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds. -- Example usage: -- -- > dzen "Hi, mom!" (5 `seconds`) dzen :: String -> Int -> X () -dzen str timeout = dzenWithArgs str [] timeout +dzen = flip (dzenConfig . timeoutMicro) -- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen. -- Example usage: -- -- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`) dzenWithArgs :: String -> [String] -> Int -> X () -dzenWithArgs str args timeout = runProcessWithInputAndWait "dzen2" args (unchomp str) timeout - -- dzen seems to require the input to terminate with exactly one newline. - where unchomp s@['\n'] = s - unchomp [] = ['\n'] - unchomp (c:cs) = c : unchomp cs +dzenWithArgs str args t = dzenConfig (timeoutMicro t >=> addArgs args) str -- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@. -- Requires dzen to be compiled with Xinerama support. -dzenScreen :: ScreenId -> String -> Int -> X() -dzenScreen sc str timeout = dzenWithArgs str ["-xs", screen] timeout - where screen = toXineramaArg sc - toXineramaArg n = show ( ((fromIntegral n)+1)::Int ) +dzenScreen :: ScreenId -> String -> Int -> X () +dzenScreen sc str t = dzenConfig (timeoutMicro t >=> xScreen sc) str -- cgit v1.2.3