{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module XMonad.Layout.DecorationEx.Widgets (
StandardCommand (..),
TextWidget (..),
GenericWidget (..),
StandardWidget,
isWidgetChecked,
titleW, toggleStickyW, minimizeW,
maximizeW, closeW, dwmpromoteW,
moveToNextGroupW,moveToPrevGroupW
) where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Actions.DwmPromote
import qualified XMonad.Actions.CopyWindow as CW
import qualified XMonad.Layout.Groups.Examples as Ex
import XMonad.Layout.Maximize
import XMonad.Actions.Minimize
import XMonad.Actions.WindowMenu
import XMonad.Layout.DecorationEx.Common
import XMonad.Layout.DecorationEx.Engine
data StandardCommand =
FocusWindow
| FocusUp
| FocusDown
| MoveToNextGroup
| MoveToPrevGroup
| DwmPromote
| ToggleSticky
| ToggleMaximize
| Minimize
| CloseWindow
|
deriving (StandardCommand -> StandardCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StandardCommand -> StandardCommand -> Bool
$c/= :: StandardCommand -> StandardCommand -> Bool
== :: StandardCommand -> StandardCommand -> Bool
$c== :: StandardCommand -> StandardCommand -> Bool
Eq, Int -> StandardCommand -> ShowS
[StandardCommand] -> ShowS
StandardCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StandardCommand] -> ShowS
$cshowList :: [StandardCommand] -> ShowS
show :: StandardCommand -> String
$cshow :: StandardCommand -> String
showsPrec :: Int -> StandardCommand -> ShowS
$cshowsPrec :: Int -> StandardCommand -> ShowS
Show, ReadPrec [StandardCommand]
ReadPrec StandardCommand
Int -> ReadS StandardCommand
ReadS [StandardCommand]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StandardCommand]
$creadListPrec :: ReadPrec [StandardCommand]
readPrec :: ReadPrec StandardCommand
$creadPrec :: ReadPrec StandardCommand
readList :: ReadS [StandardCommand]
$creadList :: ReadS [StandardCommand]
readsPrec :: Int -> ReadS StandardCommand
$creadsPrec :: Int -> ReadS StandardCommand
Read)
instance Default StandardCommand where
def :: StandardCommand
def = StandardCommand
FocusWindow
instance WindowCommand StandardCommand where
executeWindowCommand :: StandardCommand -> Window -> X Bool
executeWindowCommand StandardCommand
FocusWindow Window
w = do
Window -> X ()
focus Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
executeWindowCommand StandardCommand
FocusUp Window
_ = do
(WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp
(Window -> X ()) -> X ()
withFocused Window -> X ()
maximizeWindowAndFocus
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
FocusDown Window
_ = do
(WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown
(Window -> X ()) -> X ()
withFocused Window -> X ()
maximizeWindowAndFocus
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
MoveToNextGroup Window
w = do
Window -> X ()
focus Window
w
Bool -> X ()
Ex.moveToGroupDown Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
MoveToPrevGroup Window
w = do
Window -> X ()
focus Window
w
Bool -> X ()
Ex.moveToGroupUp Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
CloseWindow Window
w = do
Window -> X ()
killWindow Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
DwmPromote Window
w = do
Window -> X ()
focus Window
w
X ()
dwmpromote
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
ToggleSticky Window
w = do
Window -> X ()
focus Window
w
[String]
copies <- X [String]
CW.wsContainingCopies
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
copies
then (WindowSet -> WindowSet) -> X ()
windows forall s i a l sd.
(Eq s, Eq i, Eq a) =>
StackSet i l a s sd -> StackSet i l a s sd
CW.copyToAll
else X ()
CW.killAllOtherCopies
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
ToggleMaximize Window
w = do
forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Window -> MaximizeRestore
maximizeRestore Window
w
Window -> X ()
focus Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
Minimize Window
w = do
Window -> X ()
minimizeWindow Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
executeWindowCommand StandardCommand
GridWindowMenu Window
w = do
Window -> X ()
focus Window
w
X ()
windowMenu
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
isCommandChecked :: StandardCommand -> Window -> X Bool
isCommandChecked StandardCommand
FocusWindow Window
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isCommandChecked StandardCommand
DwmPromote Window
w = do
forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Window
w forall a. Eq a => a -> a -> Bool
== forall {i} {l} {a} {sid} {sd}. StackSet i l a sid sd -> Maybe a
master WindowSet
ws
where
master :: StackSet i l a sid sd -> Maybe a
master StackSet i l a sid sd
ws =
case forall a. Maybe (Stack a) -> [a]
W.integrate' forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current StackSet i l a sid sd
ws of
[] -> forall a. Maybe a
Nothing
(a
x:[a]
_) -> forall a. a -> Maybe a
Just a
x
isCommandChecked StandardCommand
ToggleSticky Window
w = do
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let copies :: [String]
copies = forall a i. Eq a => Maybe a -> [(i, [a])] -> [i]
CW.copiesOfOn (forall a. a -> Maybe a
Just Window
w) (forall i l a. [Workspace i l a] -> [(i, [a])]
CW.taggedWindows forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden WindowSet
ws)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
copies
isCommandChecked StandardCommand
_ Window
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
data GenericWidget cmd =
TitleWidget
| WindowIcon { forall cmd. GenericWidget cmd -> cmd
swCommand :: !cmd }
| GenericWidget {
forall cmd. GenericWidget cmd -> String
swCheckedText :: !String
, forall cmd. GenericWidget cmd -> String
swUncheckedText :: !String
, swCommand :: !cmd
}
deriving (Int -> GenericWidget cmd -> ShowS
forall cmd. Show cmd => Int -> GenericWidget cmd -> ShowS
forall cmd. Show cmd => [GenericWidget cmd] -> ShowS
forall cmd. Show cmd => GenericWidget cmd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericWidget cmd] -> ShowS
$cshowList :: forall cmd. Show cmd => [GenericWidget cmd] -> ShowS
show :: GenericWidget cmd -> String
$cshow :: forall cmd. Show cmd => GenericWidget cmd -> String
showsPrec :: Int -> GenericWidget cmd -> ShowS
$cshowsPrec :: forall cmd. Show cmd => Int -> GenericWidget cmd -> ShowS
Show, ReadPrec [GenericWidget cmd]
ReadPrec (GenericWidget cmd)
ReadS [GenericWidget cmd]
forall cmd. Read cmd => ReadPrec [GenericWidget cmd]
forall cmd. Read cmd => ReadPrec (GenericWidget cmd)
forall cmd. Read cmd => Int -> ReadS (GenericWidget cmd)
forall cmd. Read cmd => ReadS [GenericWidget cmd]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GenericWidget cmd]
$creadListPrec :: forall cmd. Read cmd => ReadPrec [GenericWidget cmd]
readPrec :: ReadPrec (GenericWidget cmd)
$creadPrec :: forall cmd. Read cmd => ReadPrec (GenericWidget cmd)
readList :: ReadS [GenericWidget cmd]
$creadList :: forall cmd. Read cmd => ReadS [GenericWidget cmd]
readsPrec :: Int -> ReadS (GenericWidget cmd)
$creadsPrec :: forall cmd. Read cmd => Int -> ReadS (GenericWidget cmd)
Read)
type StandardWidget = GenericWidget StandardCommand
instance (Default cmd, Read cmd, Show cmd, WindowCommand cmd) => DecorationWidget (GenericWidget cmd) where
type WidgetCommand (GenericWidget cmd) = cmd
widgetCommand :: GenericWidget cmd -> Int -> WidgetCommand (GenericWidget cmd)
widgetCommand GenericWidget cmd
TitleWidget Int
_ = forall a. Default a => a
def
widgetCommand GenericWidget cmd
w Int
1 = forall cmd. GenericWidget cmd -> cmd
swCommand GenericWidget cmd
w
widgetCommand GenericWidget cmd
_ Int
_ = forall a. Default a => a
def
isShrinkable :: GenericWidget cmd -> Bool
isShrinkable GenericWidget cmd
TitleWidget = Bool
True
isShrinkable GenericWidget cmd
_ = Bool
False
isWidgetChecked :: DecorationWidget widget => widget -> Window -> X Bool
isWidgetChecked :: forall widget.
DecorationWidget widget =>
widget -> Window -> X Bool
isWidgetChecked widget
wdt = forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
isCommandChecked (forall widget.
DecorationWidget widget =>
widget -> Int -> WidgetCommand widget
widgetCommand widget
wdt Int
1)
class DecorationWidget widget => TextWidget widget where
widgetString :: DrawData engine widget -> widget -> X String
instance TextWidget StandardWidget where
widgetString :: forall (engine :: * -> * -> *).
DrawData engine StandardWidget -> StandardWidget -> X String
widgetString DrawData engine StandardWidget
dd StandardWidget
TitleWidget = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (engine :: * -> * -> *) widget.
DrawData engine widget -> String
ddWindowTitle DrawData engine StandardWidget
dd
widgetString DrawData engine StandardWidget
_ (WindowIcon {}) = forall (m :: * -> *) a. Monad m => a -> m a
return String
"[*]"
widgetString DrawData engine StandardWidget
dd StandardWidget
w = do
Bool
checked <- forall widget.
DecorationWidget widget =>
widget -> Window -> X Bool
isWidgetChecked StandardWidget
w (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Window
ddOrigWindow DrawData engine StandardWidget
dd)
if Bool
checked
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall cmd. GenericWidget cmd -> String
swCheckedText StandardWidget
w
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall cmd. GenericWidget cmd -> String
swUncheckedText StandardWidget
w
titleW :: StandardWidget
titleW :: StandardWidget
titleW = forall cmd. GenericWidget cmd
TitleWidget
toggleStickyW :: StandardWidget
toggleStickyW :: StandardWidget
toggleStickyW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"[S]" String
"[s]" StandardCommand
ToggleSticky
minimizeW :: StandardWidget
minimizeW :: StandardWidget
minimizeW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[_]" StandardCommand
Minimize
maximizeW :: StandardWidget
maximizeW :: StandardWidget
maximizeW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[O]" StandardCommand
ToggleMaximize
closeW :: StandardWidget
closeW :: StandardWidget
closeW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[X]" StandardCommand
CloseWindow
dwmpromoteW :: StandardWidget
dwmpromoteW :: StandardWidget
dwmpromoteW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"[M]" String
"[m]" StandardCommand
DwmPromote
moveToNextGroupW :: StandardWidget
moveToNextGroupW :: StandardWidget
moveToNextGroupW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[>]" StandardCommand
MoveToNextGroup
moveToPrevGroupW :: StandardWidget
moveToPrevGroupW :: StandardWidget
moveToPrevGroupW = forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[<]" StandardCommand
MoveToPrevGroup