{-# 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
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

-- | 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
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)

-- | 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
_ = 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

-- | 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 = forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
isCommandChecked (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 = 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

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

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

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

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

-- | Widget for CloseWindow command
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