{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards         #-}
{-# LANGUAGE CPP                   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ShowWName
-- Description :  A layout modifier that will show the workspace name.
-- Copyright   :  (c) Andrea Rossato 2007
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a layout modifier that will show the workspace name
-----------------------------------------------------------------------------

module XMonad.Layout.ShowWName
    ( -- * Usage
      -- $usage
      showWName
    , showWName'
    , def
    , SWNConfig(..)
    , ShowWName
    ) where

import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier
import XMonad.Util.Font
import XMonad.Util.Timer
import XMonad.Util.XUtils

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Layout.ShowWName
-- > myLayout = layoutHook def
-- > main = xmonad def { layoutHook = showWName myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".

-- | A layout modifier to show the workspace name when switching
showWName :: l a -> ModifiedLayout ShowWName l a
showWName :: forall (l :: * -> *) a. l a -> ModifiedLayout ShowWName l a
showWName = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True forall a. Default a => a
def forall a. Maybe a
Nothing)

-- | A layout modifier to show the workspace name when switching. It
-- is possible to provide a custom configuration.
showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a
showWName' :: forall (l :: * -> *) a.
SWNConfig -> l a -> ModifiedLayout ShowWName l a
showWName' SWNConfig
c = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c forall a. Maybe a
Nothing)

type ShowWNState = Maybe (TimerId, Window)
data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (ReadPrec [ShowWName a]
ReadPrec (ShowWName a)
ReadS [ShowWName a]
forall a. ReadPrec [ShowWName a]
forall a. ReadPrec (ShowWName a)
forall a. Int -> ReadS (ShowWName a)
forall a. ReadS [ShowWName a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShowWName a]
$creadListPrec :: forall a. ReadPrec [ShowWName a]
readPrec :: ReadPrec (ShowWName a)
$creadPrec :: forall a. ReadPrec (ShowWName a)
readList :: ReadS [ShowWName a]
$creadList :: forall a. ReadS [ShowWName a]
readsPrec :: Int -> ReadS (ShowWName a)
$creadsPrec :: forall a. Int -> ReadS (ShowWName a)
Read, Int -> ShowWName a -> ShowS
forall a. Int -> ShowWName a -> ShowS
forall a. [ShowWName a] -> ShowS
forall a. ShowWName a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowWName a] -> ShowS
$cshowList :: forall a. [ShowWName a] -> ShowS
show :: ShowWName a -> String
$cshow :: forall a. ShowWName a -> String
showsPrec :: Int -> ShowWName a -> ShowS
$cshowsPrec :: forall a. Int -> ShowWName a -> ShowS
Show)

data SWNConfig =
    SWNC { SWNConfig -> String
swn_font    :: String   -- ^ Font name
         , SWNConfig -> String
swn_bgcolor :: String   -- ^ Background color
         , SWNConfig -> String
swn_color   :: String   -- ^ String color
         , SWNConfig -> Rational
swn_fade    :: Rational -- ^ Time in seconds of the name visibility
    } deriving (ReadPrec [SWNConfig]
ReadPrec SWNConfig
Int -> ReadS SWNConfig
ReadS [SWNConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SWNConfig]
$creadListPrec :: ReadPrec [SWNConfig]
readPrec :: ReadPrec SWNConfig
$creadPrec :: ReadPrec SWNConfig
readList :: ReadS [SWNConfig]
$creadList :: ReadS [SWNConfig]
readsPrec :: Int -> ReadS SWNConfig
$creadsPrec :: Int -> ReadS SWNConfig
Read, Int -> SWNConfig -> ShowS
[SWNConfig] -> ShowS
SWNConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SWNConfig] -> ShowS
$cshowList :: [SWNConfig] -> ShowS
show :: SWNConfig -> String
$cshow :: SWNConfig -> String
showsPrec :: Int -> SWNConfig -> ShowS
$cshowsPrec :: Int -> SWNConfig -> ShowS
Show)

instance Default SWNConfig where
  def :: SWNConfig
def =
#ifdef XFT
    SWNC { swn_font :: String
swn_font    = String
"xft:monospace-20"
#else
    SWNC { swn_font    = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
#endif
         , swn_bgcolor :: String
swn_bgcolor = String
"black"
         , swn_color :: String
swn_color   = String
"white"
         , swn_fade :: Rational
swn_fade    = Rational
1
         }

instance LayoutModifier ShowWName a where
    redoLayout :: ShowWName a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
redoLayout      ShowWName a
sn Rectangle
r Maybe (Stack a)
_ = forall a.
ShowWName a
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
doShow ShowWName a
sn Rectangle
r

    handleMess :: ShowWName a -> SomeMessage -> X (Maybe (ShowWName a))
handleMess (SWN Bool
_ SWNConfig
c (Just (Int
i,Window
w))) SomeMessage
m
        | Just Event
e    <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer Int
i Event
e (Window -> X ()
deleteWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
        | Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do Window -> X ()
deleteWindow Window
w
                                          forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c forall a. Maybe a
Nothing

    handleMess (SWN Bool
_ SWNConfig
c ShowWNState
s) SomeMessage
m
        | Just LayoutMessages
Hide <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
True SWNConfig
c ShowWNState
s
        | Bool
otherwise                  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
doShow :: forall a.
ShowWName a
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
doShow (SWN Bool
True  SWNConfig
c (Just (Int
_,Window
w))) Rectangle
r [(a, Rectangle)]
wrs = Window -> X ()
deleteWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a.
SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName SWNConfig
c Rectangle
r [(a, Rectangle)]
wrs
doShow (SWN Bool
True  SWNConfig
c  ShowWNState
Nothing    ) Rectangle
r [(a, Rectangle)]
wrs = forall a.
SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName SWNConfig
c Rectangle
r [(a, Rectangle)]
wrs
doShow (SWN Bool
False SWNConfig
_  ShowWNState
_          ) Rectangle
_ [(a, Rectangle)]
wrs = forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. Maybe a
Nothing)

flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName :: forall a.
SWNConfig
-> Rectangle
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (ShowWName a))
flashName SWNConfig
c (Rectangle Position
sx Position
sy Dimension
wh Dimension
ht) [(a, Rectangle)]
wrs = do
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  String
n <- forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
S.currentTag)
  XMonadFont
f <- String -> X XMonadFont
initXMF (SWNConfig -> String
swn_font SWNConfig
c)
  Int
width <- (\Int
w -> Int
w forall a. Num a => a -> a -> a
+ Int
w forall a. Integral a => a -> a -> a
`div` forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
d XMonadFont
f String
n
  (Position
as,Position
ds) <- forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF XMonadFont
f String
n
  let hight :: Position
hight = Position
as forall a. Num a => a -> a -> a
+ Position
ds
      y :: Position
y     = forall a b. (Integral a, Num b) => a -> b
fi Position
sy forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht forall a. Num a => a -> a -> a
- Position
hight forall a. Num a => a -> a -> a
+ Position
2) forall a. Integral a => a -> a -> a
`div` Position
2
      x :: Int
x     = forall a b. (Integral a, Num b) => a -> b
fi Position
sx forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fi Dimension
wh forall a. Num a => a -> a -> a
- Int
width forall a. Num a => a -> a -> a
+ Int
2) forall a. Integral a => a -> a -> a
`div` Int
2
  Window
w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (Integral a, Num b) => a -> b
fi Int
x) (forall a b. (Integral a, Num b) => a -> b
fi Position
y) (forall a b. (Integral a, Num b) => a -> b
fi Int
width) (forall a b. (Integral a, Num b) => a -> b
fi Position
hight)) forall a. Maybe a
Nothing String
"" Bool
True
  Window -> X ()
showWindow Window
w
  Window
-> XMonadFont
-> Dimension
-> Dimension
-> Dimension
-> String
-> String
-> String
-> String
-> [Align]
-> [String]
-> X ()
paintAndWrite Window
w XMonadFont
f (forall a b. (Integral a, Num b) => a -> b
fi Int
width) (forall a b. (Integral a, Num b) => a -> b
fi Position
hight) Dimension
0 (SWNConfig -> String
swn_bgcolor SWNConfig
c) String
"" (SWNConfig -> String
swn_color SWNConfig
c) (SWNConfig -> String
swn_bgcolor SWNConfig
c) [Align
AlignCenter] [String
n]
  XMonadFont -> X ()
releaseXMF XMonadFont
f
  Int
i <- Rational -> X Int
startTimer (SWNConfig -> Rational
swn_fade SWNConfig
c)
  forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Bool -> SWNConfig -> ShowWNState -> ShowWName a
SWN Bool
False SWNConfig
c forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int
i,Window
w))