{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.DecorationEx.Widgets
-- Description :  Definitions for decoration widgets (window buttons etc)
-- Copyright   :  2023 Ilya Portnov
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  portnov84@rambler.ru
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module contains data types and utilities to deal with decoration
-- widgets. A widget is anything that is displayed on window decoration,
-- and, optionally, can react on clicks. Examples of widgets are usual
-- window buttons (minimize, maximize, close), window icon and window title.
-----------------------------------------------------------------------------

module XMonad.Layout.DecorationEx.Widgets (
    -- * Data types
    StandardCommand (..),
    TextWidget (..),
    GenericWidget (..),
    StandardWidget,
    -- * Utility functions
    isWidgetChecked,
    -- * Presets for standard widgets
    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

-- | Standard window commands.
--
-- One can extend this list by simply doing
--
-- > data MyWindowCommand =
-- >     Std StandardCommand
-- >   | SomeFancyCommand
--
-- > instance WindowCommand MyWindowCommand where ...
--
-- > type MyWidget = GenericWidget MyWindowCommand
--
data StandardCommand =
      FocusWindow      -- ^ Focus the window
    | FocusUp          -- ^ Move focus to previous window
    | FocusDown        -- ^ Move focus to following window
    | MoveToNextGroup  -- ^ Move the window to the next group (see "XMonad.Layout.Groups")
    | MoveToPrevGroup  -- ^ Move the window to the previous group
    | DwmPromote       -- ^ Execute @dwmpromote@ (see "XMonad.Actions.DwmPromote")
    | ToggleSticky     -- ^ Make window sticky or unstick it (see "XMonad.Actions.CopyWindow")
    | ToggleMaximize   -- ^ Maximize or restore window (see "XMonad.Layout.Maximize")
    | Minimize         -- ^ Minimize window (see "XMonad.Actions.Minimize")
    | CloseWindow      -- ^ Close the window
    | GridWindowMenu   -- ^ Show window menu via "XMonad.Actions.GridSelect" (see "XMonad.Actions.WindowMenu")
  deriving (StandardCommand -> StandardCommand -> Bool
(StandardCommand -> StandardCommand -> Bool)
-> (StandardCommand -> StandardCommand -> Bool)
-> Eq StandardCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StandardCommand -> StandardCommand -> Bool
== :: StandardCommand -> StandardCommand -> Bool
$c/= :: StandardCommand -> StandardCommand -> Bool
/= :: StandardCommand -> StandardCommand -> Bool
Eq, Int -> StandardCommand -> ShowS
[StandardCommand] -> ShowS
StandardCommand -> String
(Int -> StandardCommand -> ShowS)
-> (StandardCommand -> String)
-> ([StandardCommand] -> ShowS)
-> Show StandardCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StandardCommand -> ShowS
showsPrec :: Int -> StandardCommand -> ShowS
$cshow :: StandardCommand -> String
show :: StandardCommand -> String
$cshowList :: [StandardCommand] -> ShowS
showList :: [StandardCommand] -> ShowS
Show, ReadPrec [StandardCommand]
ReadPrec StandardCommand
Int -> ReadS StandardCommand
ReadS [StandardCommand]
(Int -> ReadS StandardCommand)
-> ReadS [StandardCommand]
-> ReadPrec StandardCommand
-> ReadPrec [StandardCommand]
-> Read StandardCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StandardCommand
readsPrec :: Int -> ReadS StandardCommand
$creadList :: ReadS [StandardCommand]
readList :: ReadS [StandardCommand]
$creadPrec :: ReadPrec StandardCommand
readPrec :: ReadPrec StandardCommand
$creadListPrec :: ReadPrec [StandardCommand]
readListPrec :: ReadPrec [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
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  executeWindowCommand StandardCommand
FocusUp Window
_ = do
    (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
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
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  executeWindowCommand StandardCommand
FocusDown Window
_ = do
    (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
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
    Bool -> X Bool
forall a. a -> X a
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
    Bool -> X Bool
forall a. a -> X a
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
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  executeWindowCommand StandardCommand
CloseWindow Window
w = do
    Window -> X ()
killWindow Window
w
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  executeWindowCommand StandardCommand
DwmPromote Window
w = do
    Window -> X ()
focus Window
w
    X ()
dwmpromote
    Bool -> X Bool
forall a. a -> X a
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 [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
copies
      then (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
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
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  executeWindowCommand StandardCommand
ToggleMaximize Window
w = do
    MaximizeRestore -> X ()
forall a. Message a => a -> X ()
sendMessage (MaximizeRestore -> X ()) -> MaximizeRestore -> X ()
forall a b. (a -> b) -> a -> b
$ Window -> MaximizeRestore
maximizeRestore Window
w
    Window -> X ()
focus Window
w
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  executeWindowCommand StandardCommand
Minimize Window
w = do
    Window -> X ()
minimizeWindow Window
w
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  executeWindowCommand StandardCommand
GridWindowMenu Window
w = do
    Window -> X ()
focus Window
w
    X ()
windowMenu
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  isCommandChecked :: StandardCommand -> Window -> X Bool
isCommandChecked StandardCommand
FocusWindow Window
_ = Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  isCommandChecked StandardCommand
DwmPromote Window
w = do
      (WindowSet -> X Bool) -> X Bool
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X Bool) -> X Bool)
-> (WindowSet -> X Bool) -> X Bool
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSet -> Maybe Window
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 Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack a) -> [a]) -> Maybe (Stack a) -> [a]
forall a b. (a -> b) -> a -> b
$ Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace i l a -> Maybe (Stack a))
-> Workspace i l a -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen i l a sid sd -> Workspace i l a)
-> Screen i l a sid sd -> Workspace i l a
forall a b. (a -> b) -> a -> b
$ StackSet i l a sid sd -> Screen i l a sid sd
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
          [] -> Maybe a
forall a. Maybe a
Nothing
          (a
x:[a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  isCommandChecked StandardCommand
ToggleSticky Window
w = do
    WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    let copies :: [String]
copies = Maybe Window -> [(String, [Window])] -> [String]
forall a i. Eq a => Maybe a -> [(i, [a])] -> [i]
CW.copiesOfOn (Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w) ([Workspace String (Layout Window) Window] -> [(String, [Window])]
forall i l a. [Workspace i l a] -> [(i, [a])]
CW.taggedWindows ([Workspace String (Layout Window) Window] -> [(String, [Window])])
-> [Workspace String (Layout Window) Window]
-> [(String, [Window])]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Workspace String (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden WindowSet
ws)
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
copies
  isCommandChecked StandardCommand
_ Window
_ = Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Generic data type for decoration widgets.
data GenericWidget cmd =
      TitleWidget                      -- ^ Window title (just text label)
    | WindowIcon { forall cmd. GenericWidget cmd -> cmd
swCommand :: !cmd } -- ^ Window icon with some associated command
    -- | Other widgets
    | GenericWidget {
        forall cmd. GenericWidget cmd -> String
swCheckedText :: !String       -- ^ Text for checked widget state
      , forall cmd. GenericWidget cmd -> String
swUncheckedText :: !String     -- ^ Text for unchecked widget state
      , swCommand :: !cmd              -- ^ Window command
    }
    deriving (Int -> GenericWidget cmd -> ShowS
[GenericWidget cmd] -> ShowS
GenericWidget cmd -> String
(Int -> GenericWidget cmd -> ShowS)
-> (GenericWidget cmd -> String)
-> ([GenericWidget cmd] -> ShowS)
-> Show (GenericWidget cmd)
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
$cshowsPrec :: forall cmd. Show cmd => Int -> GenericWidget cmd -> ShowS
showsPrec :: Int -> GenericWidget cmd -> ShowS
$cshow :: forall cmd. Show cmd => GenericWidget cmd -> String
show :: GenericWidget cmd -> String
$cshowList :: forall cmd. Show cmd => [GenericWidget cmd] -> ShowS
showList :: [GenericWidget cmd] -> ShowS
Show, ReadPrec [GenericWidget cmd]
ReadPrec (GenericWidget cmd)
Int -> ReadS (GenericWidget cmd)
ReadS [GenericWidget cmd]
(Int -> ReadS (GenericWidget cmd))
-> ReadS [GenericWidget cmd]
-> ReadPrec (GenericWidget cmd)
-> ReadPrec [GenericWidget cmd]
-> Read (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
$creadsPrec :: forall cmd. Read cmd => Int -> ReadS (GenericWidget cmd)
readsPrec :: Int -> ReadS (GenericWidget cmd)
$creadList :: forall cmd. Read cmd => ReadS [GenericWidget cmd]
readList :: ReadS [GenericWidget cmd]
$creadPrec :: forall cmd. Read cmd => ReadPrec (GenericWidget cmd)
readPrec :: ReadPrec (GenericWidget cmd)
$creadListPrec :: forall cmd. Read cmd => ReadPrec [GenericWidget cmd]
readListPrec :: ReadPrec [GenericWidget cmd]
Read)

-- | Generic widget type specialized for 'StandardCommand'
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
_ = cmd
WidgetCommand (GenericWidget cmd)
forall a. Default a => a
def
  widgetCommand GenericWidget cmd
w Int
1 = GenericWidget cmd -> cmd
forall cmd. GenericWidget cmd -> cmd
swCommand GenericWidget cmd
w
  widgetCommand GenericWidget cmd
_ Int
_ = cmd
WidgetCommand (GenericWidget cmd)
forall a. Default a => a
def

  isShrinkable :: GenericWidget cmd -> Bool
isShrinkable GenericWidget cmd
TitleWidget = Bool
True
  isShrinkable GenericWidget cmd
_ = Bool
False

-- | Check if the widget should be displayed in `checked' state.
isWidgetChecked :: DecorationWidget widget => widget -> Window -> X Bool
isWidgetChecked :: forall widget.
DecorationWidget widget =>
widget -> Window -> X Bool
isWidgetChecked widget
wdt = WidgetCommand widget -> Window -> X Bool
forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
isCommandChecked (widget -> Int -> WidgetCommand widget
forall widget.
DecorationWidget widget =>
widget -> Int -> WidgetCommand widget
widgetCommand widget
wdt Int
1)

-- | Type class for widgets that can be displayed as
-- text fragments by 'TextDecoration' engine.
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 = String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ DrawData engine StandardWidget -> String
forall (engine :: * -> * -> *) widget.
DrawData engine widget -> String
ddWindowTitle DrawData engine StandardWidget
dd
    widgetString DrawData engine StandardWidget
_ (WindowIcon {}) = String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"[*]"
    widgetString DrawData engine StandardWidget
dd StandardWidget
w = do
      Bool
checked <- StandardWidget -> Window -> X Bool
forall widget.
DecorationWidget widget =>
widget -> Window -> X Bool
isWidgetChecked StandardWidget
w (DrawData engine StandardWidget -> Window
forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Window
ddOrigWindow DrawData engine StandardWidget
dd)
      if Bool
checked
        then String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ StandardWidget -> String
forall cmd. GenericWidget cmd -> String
swCheckedText StandardWidget
w
        else String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ StandardWidget -> String
forall cmd. GenericWidget cmd -> String
swUncheckedText StandardWidget
w

-- | Widget for window title
titleW :: StandardWidget
titleW :: StandardWidget
titleW = StandardWidget
forall cmd. GenericWidget cmd
TitleWidget

-- | Widget for ToggleSticky command.
toggleStickyW :: StandardWidget
toggleStickyW :: StandardWidget
toggleStickyW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"[S]" String
"[s]" StandardCommand
ToggleSticky

-- | Widget for Minimize command
minimizeW :: StandardWidget
minimizeW :: StandardWidget
minimizeW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[_]" StandardCommand
Minimize

-- | Widget for ToggleMaximize command
maximizeW :: StandardWidget
maximizeW :: StandardWidget
maximizeW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[O]" StandardCommand
ToggleMaximize

-- | Widget for CloseWindow command
closeW :: StandardWidget
closeW :: StandardWidget
closeW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[X]" StandardCommand
CloseWindow

dwmpromoteW :: StandardWidget
dwmpromoteW :: StandardWidget
dwmpromoteW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"[M]" String
"[m]" StandardCommand
DwmPromote

moveToNextGroupW :: StandardWidget
moveToNextGroupW :: StandardWidget
moveToNextGroupW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[>]" StandardCommand
MoveToNextGroup

moveToPrevGroupW :: StandardWidget
moveToPrevGroupW :: StandardWidget
moveToPrevGroupW = String -> String -> StandardCommand -> StandardWidget
forall cmd. String -> String -> cmd -> GenericWidget cmd
GenericWidget String
"" String
"[<]" StandardCommand
MoveToPrevGroup