-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Dzen
-- Description :  Handy wrapper for dzen.
-- Copyright   :  (c) glasser@mit.edu
-- License     :  BSD
--
-- Maintainer  :  glasser@mit.edu
-- Stability   :  stable
-- Portability :  unportable
--
-- Handy wrapper for dzen. Requires dzen >= 0.2.4.
--
-----------------------------------------------------------------------------

module XMonad.Util.Dzen (
    -- * Flexible interface
    dzenConfig, DzenConfig,
    timeout,
    font,
    xScreen,
    vCenter,
    hCenter,
    center,
    onCurr,
    x,
    y,
    addArgs,
    fgColor,
    bgColor,
    align,
    slaveAlign,
    lineCount,

    -- * Legacy interface
    dzen,
    dzenScreen,
    dzenWithArgs,

    -- * Miscellaneous
    seconds,
    chomp,
    (>=>),
  ) where

import XMonad.Prelude
import XMonad
import XMonad.StackSet
import XMonad.Util.Run (runProcessWithInputAndWait, seconds)
import XMonad.Util.Font (Align (..))

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 :: DzenConfig -> String -> X ()
dzenConfig DzenConfig
conf String
s = do
    (Int
t, [String]
args) <- DzenConfig
conf (Rational -> Int
seconds Rational
3, [])
    String -> [String] -> String -> Int -> X ()
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> Int -> m ()
runProcessWithInputAndWait String
"dzen2" [String]
args (String -> String
chomp String
s) Int
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 :: String -> String
chomp = (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

-- | Set the timeout, in seconds.  This defaults to 3 seconds if not
-- specified.
timeout :: Rational -> DzenConfig
timeout :: Rational -> DzenConfig
timeout = Int -> DzenConfig
timeoutMicro (Int -> DzenConfig) -> (Rational -> Int) -> Rational -> DzenConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Int
seconds

-- | Set the timeout, in microseconds.  Mostly here for the legacy
-- interface.
timeoutMicro :: Int -> DzenConfig
timeoutMicro :: Int -> DzenConfig
timeoutMicro Int
n (Int
_, [String]
ss) = DzenConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, [String]
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 :: [String] -> DzenConfig
addArgs [String]
ss (Int
n, [String]
ss') = DzenConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, [String]
ss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ss')

-- | Start dzen2 on a particular screen.  Only works with versions of dzen
-- that support the "-xs" argument.
xScreen :: ScreenId -> DzenConfig
xScreen :: ScreenId -> DzenConfig
xScreen ScreenId
sc = [String] -> DzenConfig
addArgs [String
"-xs", Int -> String
forall a. Show a => a -> String
show (ScreenId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ScreenId
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: (ScreenId -> DzenConfig) -> DzenConfig
onCurr ScreenId -> DzenConfig
f (Int, [String])
conf = (XState -> ScreenId) -> X ScreenId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
screen (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> ScreenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset) X ScreenId -> (ScreenId -> X (Int, [String])) -> X (Int, [String])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ScreenId -> DzenConfig)
-> (Int, [String]) -> ScreenId -> X (Int, [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ScreenId -> DzenConfig
f (Int, [String])
conf

-- | Put the top of the dzen bar at a particular pixel.
x :: Int -> DzenConfig
x :: Int -> DzenConfig
x Int
n = [String] -> DzenConfig
addArgs [String
"-x", Int -> String
forall a. Show a => a -> String
show Int
n]
-- | Put the left of the dzen bar at a particular pixel.
y :: Int -> DzenConfig
y :: Int -> DzenConfig
y Int
n = [String] -> DzenConfig
addArgs [String
"-y", Int -> String
forall a. Show a => a -> String
show Int
n]

-- | Set the foreground color.
--
-- Please be advised that @fgColor@ and @bgColor@ also exist in "XMonad.Prompt".
-- If you use both modules, you might have to tell the compiler which one you mean:
--
-- > import XMonad.Prompt as P
-- > import XMonad.Util.Dzen as D
-- >
-- > dzenConfig (D.fgColor "#f0f0f0") "foobar"
fgColor :: String -> DzenConfig
fgColor :: String -> DzenConfig
fgColor String
c = [String] -> DzenConfig
addArgs [String
"-fg", String
c]

-- | Set the background color.
bgColor :: String -> DzenConfig
bgColor :: String -> DzenConfig
bgColor String
c = [String] -> DzenConfig
addArgs [String
"-bg", String
c]

-- | Set the alignment of the title (main) window content.
-- Note that @AlignRightOffset@ is treated as equal to @AlignRight@.
--
-- > import XMonad.Util.Font (Align(..))
-- >
-- > dzenConfig (align AlignLeft) "foobar"
align :: Align -> DzenConfig
align :: Align -> DzenConfig
align = String -> Align -> DzenConfig
align' String
"-ta"

-- | Set the alignment of the slave window content.
-- Using this option only makes sense if you also use the @lineCount@ parameter.
slaveAlign :: Align -> DzenConfig
slaveAlign :: Align -> DzenConfig
slaveAlign = String -> Align -> DzenConfig
align' String
"-sa"

-- Set an alignment parameter
align' :: String -> Align -> DzenConfig
align' :: String -> Align -> DzenConfig
align' String
opt Align
a = [String] -> DzenConfig
addArgs [String
opt, String
s] where
  s :: String
s = case Align
a of
        Align
AlignCenter        -> String
"c"
        Align
AlignLeft          -> String
"l"
        Align
AlignRight         -> String
"r"
        AlignRightOffset Int
_ -> String
"r"

-- | 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 :: String -> DzenConfig
font String
fn = [String] -> DzenConfig
addArgs [String
"-fn", String
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 :: Int -> ScreenId -> DzenConfig
vCenter = (Rectangle -> Dimension)
-> String -> String -> Int -> ScreenId -> DzenConfig
center' Rectangle -> Dimension
rect_height String
"-h" String
"-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 :: Int -> ScreenId -> DzenConfig
hCenter = (Rectangle -> Dimension)
-> String -> String -> Int -> ScreenId -> DzenConfig
center' Rectangle -> Dimension
rect_width  String
"-w" String
"-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 :: Int -> Int -> ScreenId -> DzenConfig
center Int
width Int
height ScreenId
sc = Int -> ScreenId -> DzenConfig
hCenter Int
width ScreenId
sc DzenConfig -> DzenConfig -> DzenConfig
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Int -> ScreenId -> DzenConfig
vCenter Int
height ScreenId
sc

-- Center things along a single dimension on a particular screen.
center' :: (Rectangle -> Dimension) -> String -> String -> Int -> ScreenId -> DzenConfig
center' :: (Rectangle -> Dimension)
-> String -> String -> Int -> ScreenId -> DzenConfig
center' Rectangle -> Dimension
selector String
extentName String
positionName Int
extent ScreenId
sc (Int, [String])
conf = do
    Maybe Rectangle
rect <- (XState -> Maybe Rectangle) -> X (Maybe Rectangle)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (ScreenId
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Rectangle
detailFromScreenId ScreenId
sc (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe Rectangle)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
    case Maybe Rectangle
rect of
        Maybe Rectangle
Nothing -> DzenConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (Int, [String])
conf
        Just Rectangle
r  -> [String] -> DzenConfig
addArgs
            [String
extentName  , Int -> String
forall a. Show a => a -> String
show Int
extent,
             String
positionName, Int -> String
forall a. Show a => a -> String
show ((Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
selector Rectangle
r) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
extent) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2),
             String
"-xs"       , Int -> String
forall a. Show a => a -> String
show (ScreenId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ScreenId
sc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 :: Int)
            ] (Int, [String])
conf

-- Get the rectangle outlining a particular screen.
detailFromScreenId :: ScreenId -> WindowSet -> Maybe Rectangle
detailFromScreenId :: ScreenId
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Rectangle
detailFromScreenId ScreenId
sc StackSet String (Layout Window) Window ScreenId ScreenDetail
ws = (ScreenDetail -> Rectangle)
-> Maybe ScreenDetail -> Maybe Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScreenDetail -> Rectangle
screenRect Maybe ScreenDetail
maybeSD where
    c :: Screen String (Layout Window) Window ScreenId ScreenDetail
c       = StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
    v :: [Screen String (Layout Window) Window ScreenId ScreenDetail]
v       = StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
    mapping :: [(ScreenId, ScreenDetail)]
mapping = (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> (ScreenId, ScreenDetail))
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [(ScreenId, ScreenDetail)]
forall a b. (a -> b) -> [a] -> [b]
map (\Screen String (Layout Window) Window ScreenId ScreenDetail
s -> (Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
screen Screen String (Layout Window) Window ScreenId ScreenDetail
s, Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
screenDetail Screen String (Layout Window) Window ScreenId ScreenDetail
s)) (Screen String (Layout Window) Window ScreenId ScreenDetail
cScreen String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
:[Screen String (Layout Window) Window ScreenId ScreenDetail]
v)
    maybeSD :: Maybe ScreenDetail
maybeSD = ScreenId -> [(ScreenId, ScreenDetail)] -> Maybe ScreenDetail
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ScreenId
sc [(ScreenId, ScreenDetail)]
mapping

-- | Enable slave window and specify the number of lines.
--
-- Dzen can optionally draw a second window underneath the title window.
-- By default, this window is only displayed if the mouse enters the title window.
-- This option is only useful if the string you want to display contains more than one line.
lineCount :: Int -> DzenConfig
lineCount :: Int -> DzenConfig
lineCount Int
n = [String] -> DzenConfig
addArgs [String
"-l", Int -> String
forall a. Show a => a -> String
show Int
n]

-- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds.
-- Example usage:
--
-- > dzen "Hi, mom!" (5 `seconds`)
dzen :: String -> Int -> X ()
dzen :: String -> Int -> X ()
dzen = (Int -> String -> X ()) -> String -> Int -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DzenConfig -> String -> X ()
dzenConfig (DzenConfig -> String -> X ())
-> (Int -> DzenConfig) -> Int -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> 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 :: String -> [String] -> Int -> X ()
dzenWithArgs String
str [String]
args Int
t = DzenConfig -> String -> X ()
dzenConfig (Int -> DzenConfig
timeoutMicro Int
t DzenConfig -> DzenConfig -> DzenConfig
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [String] -> DzenConfig
addArgs [String]
args) String
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 :: ScreenId -> String -> Int -> X ()
dzenScreen ScreenId
sc String
str Int
t = DzenConfig -> String -> X ()
dzenConfig (Int -> DzenConfig
timeoutMicro Int
t DzenConfig -> DzenConfig -> DzenConfig
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ScreenId -> DzenConfig
xScreen ScreenId
sc) String
str