{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
module XMonad.Config.Droundy {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib. If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( config, mytab ) where
import XMonad hiding (keys, config)
import qualified XMonad (keys)
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import System.Exit ( exitSuccess )
import XMonad.Layout.Tabbed ( tabbed,
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
import XMonad.Layout.Combo ( combineTwo )
import XMonad.Layout.Renamed ( Rename(Replace), renamed )
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Square ( Square(Square) )
import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),
windowNavigation )
import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring,
focusUp, focusDown )
import XMonad.Layout.NoBorders ( smartBorders )
import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir )
import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
import XMonad.Layout.ShowWName ( showWName )
import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )
import XMonad.Prompt ( font, height, XPConfig )
import XMonad.Prompt.Layout ( layoutPrompt )
import XMonad.Prompt.Shell ( shellPrompt )
import XMonad.Actions.CopyWindow ( kill1, copy )
import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
selectWorkspace, renameWorkspace, removeWorkspace )
import XMonad.Actions.CycleWS ( moveTo, hiddenWS, emptyWS,
Direction1D( Prev, Next), WSType ((:&:), Not) )
import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
import XMonad.Hooks.EwmhDesktops ( ewmh )
myXPConfig :: XPConfig
myXPConfig :: XPConfig
myXPConfig = forall a. Default a => a
def {font :: [Char]
font=[Char]
"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
,height :: Dimension
height=Dimension
22}
keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig Layout
x = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_c ), X ()
kill1)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_space ), forall a. Message a => a -> X ()
sendMessage ChangeLayout
NextLayout)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_L ), Layout KeySym -> X ()
setLayout forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l KeySym
layoutHook XConfig Layout
x)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Tab ), X ()
focusDown)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_j ), X ()
focusDown)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_k ), X ()
focusUp )
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_j ), (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapDown )
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_k ), (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapUp )
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_t ), (KeySym -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.sink)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Escape), forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a. IO a
exitSuccess)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x , KeySym
xK_Escape), [Char] -> Bool -> X ()
restart [Char]
"xmonad" Bool
True)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Right), Direction1D -> WSType -> X ()
moveTo Direction1D
Next forall a b. (a -> b) -> a -> b
$ WSType
hiddenWS WSType -> WSType -> WSType
:&: WSType -> WSType
Not WSType
emptyWS)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Left), Direction1D -> WSType -> X ()
moveTo Direction1D
Prev forall a b. (a -> b) -> a -> b
$ WSType
hiddenWS WSType -> WSType -> WSType
:&: WSType -> WSType
Not WSType
emptyWS)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Right), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
R)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Left), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
L)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Up), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
U)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Down), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
D)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Right), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
R)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Left), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
L)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Up), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
U)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Down), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
D)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Right), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
R)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Left), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
L)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Up), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
U)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Down), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
D)
, ((KeyMask
0, KeySym
xK_F2 ), forall (m :: * -> *). MonadIO m => [Char] -> m ()
spawn [Char]
"gnome-terminal")
, ((KeyMask
0, KeySym
xK_F3 ), XPConfig -> X ()
shellPrompt XPConfig
myXPConfig)
, ((KeyMask
0, KeySym
xK_F11 ), forall (m :: * -> *). MonadIO m => [Char] -> m ()
spawn [Char]
"ksnapshot")
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_b ), X ()
markBoring)
, ((KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_b ), X ()
clearBoring)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_x ), XPConfig -> X ()
changeDir XPConfig
myXPConfig)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_BackSpace), X ()
removeWorkspace)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_v ), XPConfig -> X ()
selectWorkspace XPConfig
myXPConfig)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_m ), XPConfig -> ([Char] -> X ()) -> X ()
withWorkspace XPConfig
myXPConfig ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift))
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_m ), XPConfig -> ([Char] -> X ()) -> X ()
withWorkspace XPConfig
myXPConfig ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i a l sd.
(Eq s, Eq i, Eq a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
copy))
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_r), XPConfig -> X ()
renameWorkspace XPConfig
myXPConfig)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_l ), XPConfig -> X ()
layoutPrompt XPConfig
myXPConfig)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_space), forall a. Message a => a -> X ()
sendMessage ToggleLayout
ToggleLayout)
, ((forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_space), forall a. Message a => a -> X ()
sendMessage MagnifyMsg
Toggle)
]
forall a. [a] -> [a] -> [a]
++
forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x,) [KeySym
xK_F1..KeySym
xK_F12]) (forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView) [Int
0..])
forall a. [a] -> [a] -> [a]
++
forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask,) [KeySym
xK_F1..KeySym
xK_F12]) (forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace forall s i a l sd.
(Eq s, Eq i, Eq a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
copy) [Int
0..])
config :: XConfig
(ModifiedLayout
ShowWName
(ModifiedLayout
WorkspaceDir
(ModifiedLayout
BoringWindows
(ModifiedLayout
SmartBorder
(ModifiedLayout
WindowNavigation
(ModifiedLayout
Magnifier
(ToggleLayouts
Full
(ModifiedLayout
AvoidStruts
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest))
(Choose
(ModifiedLayout
Rename
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(CombineTwo
(Square ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest))))
(Choose
(ModifiedLayout
Rename
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(CombineTwo
(Square ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink)
Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink)
Simplest)))))
(ModifiedLayout
Rename
(CombineTwo
(DragPane ())
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest))
(CombineTwo
(Square ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink)
Simplest)))))))))))))))
config = forall (a :: * -> *). XConfig a -> XConfig a
docks forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *). XConfig a -> XConfig a
ewmh forall a. Default a => a
def
{ borderWidth :: Dimension
borderWidth = Dimension
1
, workspaces :: [[Char]]
XMonad.workspaces = [[Char]
"mutt",[Char]
"iceweasel"]
, layoutHook :: ModifiedLayout
ShowWName
(ModifiedLayout
WorkspaceDir
(ModifiedLayout
BoringWindows
(ModifiedLayout
SmartBorder
(ModifiedLayout
WindowNavigation
(ModifiedLayout
Magnifier
(ToggleLayouts
Full
(ModifiedLayout
AvoidStruts
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest))
(Choose
(ModifiedLayout
Rename
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(CombineTwo
(Square ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest))))
(Choose
(ModifiedLayout
Rename
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(CombineTwo
(Square ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink)
Simplest)))))
(ModifiedLayout
Rename
(CombineTwo
(DragPane ())
(CombineTwo
(DragPane ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest))
(CombineTwo
(Square ())
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest)
(ModifiedLayout
(Decoration TabbedDecoration CustomShrink)
Simplest))))))))))))))
KeySym
layoutHook = forall (l :: * -> *) a. l a -> ModifiedLayout ShowWName l a
showWName forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
[Char] -> l a -> ModifiedLayout WorkspaceDir l a
workspaceDir [Char]
"~" forall a b. (a -> b) -> a -> b
$
forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
l a -> ModifiedLayout BoringWindows l a
boringWindows forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout SmartBorder l a
smartBorders forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout WindowNavigation l a
windowNavigation forall a b. (a -> b) -> a -> b
$
forall (l :: * -> *) a. l a -> ModifiedLayout Magnifier l a
maximizeVertical forall a b. (a -> b) -> a -> b
$ forall (lt :: * -> *) a (lf :: * -> *).
(LayoutClass lt a, LayoutClass lf a) =>
lt a -> lf a -> ToggleLayouts lt lf a
toggleLayouts forall a. Full a
Full forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts forall a b. (a -> b) -> a -> b
$
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. [Char] -> Rename a
Replace [Char]
"tabbed"] ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
|||
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. [Char] -> Rename a
Replace [Char]
"xclock"] (ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab forall a (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
****//* forall a (super :: * -> *) (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass super (), LayoutClass l1 a,
LayoutClass l2 a) =>
super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo forall a. Square a
Square ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab) forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
|||
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. [Char] -> Rename a
Replace [Char]
"three"] (ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab forall a (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
**//* ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab forall a (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
*//* forall a (super :: * -> *) (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass super (), LayoutClass l1 a,
LayoutClass l2 a) =>
super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo forall a. Square a
Square ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab) forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
|||
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. [Char] -> Rename a
Replace [Char]
"widescreen"] ((ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab forall a (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
*||* ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab)
forall a (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
****//* forall a (super :: * -> *) (l1 :: * -> *) (l2 :: * -> *).
(Read a, Eq a, LayoutClass super (), LayoutClass l1 a,
LayoutClass l2 a) =>
super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo forall a. Square a
Square ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab)
, terminal :: [Char]
terminal = [Char]
"xterm"
, normalBorderColor :: [Char]
normalBorderColor = [Char]
"#222222"
, focusedBorderColor :: [Char]
focusedBorderColor = [Char]
"#00ff00"
, modMask :: KeyMask
XMonad.modMask = KeyMask
mod1Mask
, keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
XMonad.keys = XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys
}
mytab :: ModifiedLayout
(Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab = forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed CustomShrink
CustomShrink forall a. Default a => a
def
instance Shrinker CustomShrink where
shrinkIt :: CustomShrink -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
" " [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
" " [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
"- Iceweasel" [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
"- KPDF" [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
"file://" [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
"http://" [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
shrinkIt CustomShrink
_ [Char]
s | Int
n forall a. Ord a => a -> a -> Bool
> Int
9 = [Char]
s forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
cut [Int
2..(Int
halfnforall a. Num a => a -> a -> a
-Int
3)] forall a. [a] -> [a] -> [a]
++ forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt DefaultShrinker
shrinkText [Char]
s
where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s
halfn :: Int
halfn = Int
n forall a. Integral a => a -> a -> a
`div` Int
2
rs :: [Char]
rs = forall a. [a] -> [a]
reverse [Char]
s
cut :: Int -> [Char]
cut Int
x = forall a. Int -> [a] -> [a]
take (Int
halfn forall a. Num a => a -> a -> a
- Int
x) [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"..." forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take (Int
halfnforall a. Num a => a -> a -> a
-Int
x) [Char]
rs)
shrinkIt CustomShrink
_ [Char]
s = forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt DefaultShrinker
shrinkText [Char]
s
dropFromTail :: String -> String -> Maybe String
dropFromTail :: [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
"" [Char]
_ = forall a. Maybe a
Nothing
dropFromTail [Char]
t [Char]
s | forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
t) [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
t = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
t) [Char]
s
| Bool
otherwise = forall a. Maybe a
Nothing
dropFromHead :: String -> String -> Maybe String
dropFromHead :: [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
"" [Char]
_ = forall a. Maybe a
Nothing
dropFromHead [Char]
h [Char]
s | forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
h = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) [Char]
s
| Bool
otherwise = forall a. Maybe a
Nothing