    {-# LANGUAGE DeriveDataTypeable #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.ShowText
    -- Copyright   :  (c) Mario Pastorelli (2012)
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  pastorelli.mario@gmail.com
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen"
    -- which offers more features (currently)
    -----------------------------------------------------------------------------

    module XMonad.Actions.ShowText
        ( -- * Usage
          -- $usage
          def
        , defaultSTConfig
        , handleTimerEvent
        , flashText
        , ShowTextConfig(..)
        ) where

    import Control.Monad (when)
    import Data.Map (Map,empty,insert,lookup)
    import Data.Monoid (mempty, All)
    import Prelude hiding (lookup)
    import XMonad
    import XMonad.StackSet (current,screen)
    import XMonad.Util.Font (Align(AlignCenter)
                           , initXMF
                           , releaseXMF
                           , textExtentsXMF
                           , textWidthXMF)
    import XMonad.Util.Timer (startTimer)
    import XMonad.Util.XUtils (createNewWindow
                             , deleteWindow
                             , fi
                             , showWindow
                             , paintAndWrite)
    import qualified XMonad.Util.ExtensibleState as ES

    -- $usage
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Actions.ShowText
    --
    -- Then add the event hook handler:
    --
    -- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }
    --
    -- You can then use flashText in your keybindings:
    --
    -- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS)
    --

    -- | ShowText contains the map with timers as keys and created windows as values
    newtype ShowText = ShowText (Map Atom Window)
        deriving (ReadPrec [ShowText]
    ReadPrec ShowText
    Int -> ReadS ShowText
    ReadS [ShowText]
    (Int -> ReadS ShowText)
    -> ReadS [ShowText]
    -> ReadPrec ShowText
    -> ReadPrec [ShowText]
    -> Read ShowText
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [ShowText]
    $creadListPrec :: ReadPrec [ShowText]
    readPrec :: ReadPrec ShowText
    $creadPrec :: ReadPrec ShowText
    readList :: ReadS [ShowText]
    $creadList :: ReadS [ShowText]
    readsPrec :: Int -> ReadS ShowText
    $creadsPrec :: Int -> ReadS ShowText
    Read,Int -> ShowText -> ShowS
    [ShowText] -> ShowS
    ShowText -> String
    (Int -> ShowText -> ShowS)
    -> (ShowText -> String) -> ([ShowText] -> ShowS) -> Show ShowText
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ShowText] -> ShowS
    $cshowList :: [ShowText] -> ShowS
    show :: ShowText -> String
    $cshow :: ShowText -> String
    showsPrec :: Int -> ShowText -> ShowS
    $cshowsPrec :: Int -> ShowText -> ShowS
    Show,Typeable)

    instance ExtensionClass ShowText where
        initialValue :: ShowText
    initialValue = Map Atom Atom -> ShowText
    ShowText Map Atom Atom
    forall k a. Map k a
    empty

    -- | Utility to modify a ShowText
    modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText
    modShowText :: (Map Atom Atom -> Map Atom Atom) -> ShowText -> ShowText
    modShowText f :: Map Atom Atom -> Map Atom Atom
    f (ShowText m :: Map Atom Atom
    m) = Map Atom Atom -> ShowText
    ShowText (Map Atom Atom -> ShowText) -> Map Atom Atom -> ShowText
    forall a b. (a -> b) -> a -> b
    $ Map Atom Atom -> Map Atom Atom
    f Map Atom Atom
    m

    data ShowTextConfig =
        STC { ShowTextConfig -> String
    st_font :: String -- ^ Font name
            , ShowTextConfig -> String
    st_bg   :: String -- ^ Background color
            , ShowTextConfig -> String
    st_fg   :: String -- ^ Foreground color
        }

    instance Default ShowTextConfig where
      def :: ShowTextConfig
    def =
        STC :: String -> String -> String -> ShowTextConfig
    STC { st_font :: String
    st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
            , st_bg :: String
    st_bg   = "black"
            , st_fg :: String
    st_fg   = "white"
        }

    {-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}
    defaultSTConfig :: ShowTextConfig
    defaultSTConfig :: ShowTextConfig
    defaultSTConfig = ShowTextConfig
    forall a. Default a => a
    def

    -- | Handles timer events that notify when a window should be removed
    handleTimerEvent :: Event -> X All
    handleTimerEvent :: Event -> X All
    handleTimerEvent (ClientMessageEvent _ _ _ dis :: Display
    dis _ mtyp :: Atom
    mtyp d :: [CInt]
    d) = do
        (ShowText m :: Map Atom Atom
    m) <- X ShowText
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    ES.get :: X ShowText
        Atom
    a <- IO Atom -> X Atom
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Atom -> X Atom) -> IO Atom -> X Atom
    forall a b. (a -> b) -> a -> b
    $ Display -> String -> Bool -> IO Atom
    internAtom Display
    dis "XMONAD_TIMER" Bool
    False
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Atom
    mtyp Atom -> Atom -> Bool
    forall a. Eq a => a -> a -> Bool
    == Atom
    a Bool -> Bool -> Bool
    && [CInt] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CInt]
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 1)
             (Maybe Atom -> (Atom -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (Atom -> Map Atom Atom -> Maybe Atom
    forall k a. Ord k => k -> Map k a -> Maybe a
    lookup (CInt -> Atom
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CInt -> Atom) -> CInt -> Atom
    forall a b. (a -> b) -> a -> b
    $ [CInt]
    d [CInt] -> Int -> CInt
    forall a. [a] -> Int -> a
    !! 0) Map Atom Atom
    m) Atom -> X ()
    deleteWindow)
        X All
    forall a. Monoid a => a
    mempty
    handleTimerEvent _ = X All
    forall a. Monoid a => a
    mempty

    -- | Shows a window in the center of the screen with the given text
    flashText :: ShowTextConfig
        -> Rational -- ^ number of seconds
        -> String -- ^ text to display
        -> X ()
    flashText :: ShowTextConfig -> Rational -> String -> X ()
    flashText c :: ShowTextConfig
    c i :: Rational
    i s :: String
    s = do
      XMonadFont
    f <- String -> X XMonadFont
    initXMF (ShowTextConfig -> String
    st_font ShowTextConfig
    c)
      Display
    d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      ScreenNumber
    sc <- (XState -> ScreenNumber) -> X ScreenNumber
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> ScreenNumber) -> X ScreenNumber)
    -> (XState -> ScreenNumber) -> X ScreenNumber
    forall a b. (a -> b) -> a -> b
    $ ScreenId -> ScreenNumber
    forall a b. (Integral a, Num b) => a -> b
    fi (ScreenId -> ScreenNumber)
    -> (XState -> ScreenId) -> XState -> ScreenNumber
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Atom) Atom ScreenId ScreenDetail -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    screen (Screen String (Layout Atom) Atom ScreenId ScreenDetail
     -> ScreenId)
    -> (XState
        -> Screen String (Layout Atom) Atom ScreenId ScreenDetail)
    -> XState
    -> ScreenId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout Atom) Atom ScreenId ScreenDetail
    -> Screen String (Layout Atom) Atom ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    current (StackSet String (Layout Atom) Atom ScreenId ScreenDetail
     -> Screen String (Layout Atom) Atom ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Atom) Atom ScreenId ScreenDetail)
    -> XState
    -> Screen String (Layout Atom) Atom ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> StackSet String (Layout Atom) Atom ScreenId ScreenDetail
    windowset
      Int
    width <- Display -> XMonadFont -> String -> X Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF Display
    d XMonadFont
    f String
    s
      (as :: Int32
    as,ds :: Int32
    ds) <- XMonadFont -> String -> X (Int32, Int32)
    forall (m :: * -> *).
    MonadIO m =>
    XMonadFont -> String -> m (Int32, Int32)
    textExtentsXMF XMonadFont
    f String
    s
      let hight :: Int32
    hight = Int32
    as Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    + Int32
    ds
          ht :: CInt
    ht    = Display -> ScreenNumber -> CInt
    displayHeight Display
    d ScreenNumber
    sc
          wh :: CInt
    wh    = Display -> ScreenNumber -> CInt
    displayWidth Display
    d ScreenNumber
    sc
          y :: Int32
    y     = (CInt -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ht Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    - Int32
    hight Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    + 2) Int32 -> Int32 -> Int32
    forall a. Integral a => a -> a -> a
    `div` 2
          x :: Int
    x     = (CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    wh Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 2
      Atom
    w <- Rectangle -> Maybe Atom -> String -> Bool -> X Atom
    createNewWindow (Int32 -> Int32 -> ScreenNumber -> ScreenNumber -> Rectangle
    Rectangle (Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    x) (Int32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fi Int32
    y) (Int -> ScreenNumber
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    width) (Int32 -> ScreenNumber
    forall a b. (Integral a, Num b) => a -> b
    fi Int32
    hight))
                          Maybe Atom
    forall a. Maybe a
    Nothing "" Bool
    True
      Atom -> X ()
    showWindow Atom
    w
      Atom
    -> XMonadFont
    -> ScreenNumber
    -> ScreenNumber
    -> ScreenNumber
    -> String
    -> String
    -> String
    -> String
    -> [Align]
    -> [String]
    -> X ()
    paintAndWrite Atom
    w XMonadFont
    f (Int -> ScreenNumber
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    width) (Int32 -> ScreenNumber
    forall a b. (Integral a, Num b) => a -> b
    fi Int32
    hight) 0 (ShowTextConfig -> String
    st_bg ShowTextConfig
    c) ""
                    (ShowTextConfig -> String
    st_fg ShowTextConfig
    c) (ShowTextConfig -> String
    st_bg ShowTextConfig
    c) [Align
    AlignCenter] [String
    s]
      XMonadFont -> X ()
    releaseXMF XMonadFont
    f
      IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Bool -> IO ()
    sync Display
    d Bool
    False
      Int
    t <- Rational -> X Int
    startTimer Rational
    i
      (ShowText -> ShowText) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    ES.modify ((ShowText -> ShowText) -> X ()) -> (ShowText -> ShowText) -> X ()
    forall a b. (a -> b) -> a -> b
    $ (Map Atom Atom -> Map Atom Atom) -> ShowText -> ShowText
    modShowText (Atom -> Atom -> Map Atom Atom -> Map Atom Atom
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    insert (Int -> Atom
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    t) Atom
    w)