mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-18 19:10:21 -07:00
Apply hlint hints
All hints are applied in one single commit, as a commit per hint would result in 80+ separate commits—tihs is really just too much noise. Related: https://github.com/xmonad/xmonad-contrib/issues/537
This commit is contained in:
parent
b96899afb6
commit
bd5b969d9b
@ -42,7 +42,7 @@ import System.Exit
|
||||
|
||||
workspaceCommands :: Int -> X [(String, X ())]
|
||||
workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
|
||||
[(("greedyView" ++ show i),
|
||||
[( "greedyView" ++ show i,
|
||||
activateScreen sid >> windows (W.greedyView i))
|
||||
| i <- spaces ]
|
||||
|
||||
@ -65,7 +65,7 @@ masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
|
||||
]
|
||||
|
||||
quitCommands :: [(String, X ())]
|
||||
quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
|
||||
quitCommands = [ ("quit bluetile", io exitSuccess)
|
||||
, ("quit bluetile and start metacity", restart "metacity" False)
|
||||
]
|
||||
|
||||
|
@ -61,18 +61,18 @@ import XMonad.Prelude
|
||||
-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
|
||||
-- list of pairs.
|
||||
commandMap :: [(String, X ())] -> M.Map String (X ())
|
||||
commandMap c = M.fromList c
|
||||
commandMap = M.fromList
|
||||
|
||||
-- | Generate a list of commands to switch to\/send windows to workspaces.
|
||||
workspaceCommands :: X [(String, X ())]
|
||||
workspaceCommands = asks (workspaces . config) >>= \spaces -> return
|
||||
[((m ++ show i), windows $ f i)
|
||||
[( m ++ show i, windows $ f i)
|
||||
| i <- spaces
|
||||
, (f, m) <- [(view, "view"), (shift, "shift")] ]
|
||||
|
||||
-- | Generate a list of commands dealing with multiple screens.
|
||||
screenCommands :: [(String, X ())]
|
||||
screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
|
||||
screenCommands = [( m ++ show sc, screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
|
||||
| sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
|
||||
, (f, m) <- [(view, "screen"), (shift, "screen-to-")]
|
||||
]
|
||||
@ -100,7 +100,7 @@ defaultCommands = do
|
||||
, ("swap-down" , windows swapDown )
|
||||
, ("swap-master" , windows swapMaster )
|
||||
, ("sink" , withFocused $ windows . sink )
|
||||
, ("quit-wm" , io $ exitWith ExitSuccess )
|
||||
, ("quit-wm" , io exitSuccess )
|
||||
]
|
||||
|
||||
-- | Given a list of command\/action pairs, prompt the user to choose a
|
||||
|
@ -96,7 +96,7 @@ copy n s | Just w <- W.peek s = copyWindow w n s
|
||||
|
||||
-- | Copy the focused window to all workspaces.
|
||||
copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||
copyToAll s = foldr copy s $ map W.tag (W.workspaces s)
|
||||
copyToAll s = foldr (copy . W.tag) s (W.workspaces s)
|
||||
|
||||
-- | Copy an arbitrary window to a workspace.
|
||||
copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||
@ -142,9 +142,9 @@ killAllOtherCopies = do ss <- gets windowset
|
||||
W.view (W.currentTag ss) .
|
||||
delFromAllButCurrent w
|
||||
where
|
||||
delFromAllButCurrent w ss = foldr ($) ss $
|
||||
map (delWinFromWorkspace w . W.tag) $
|
||||
W.hidden ss ++ map W.workspace (W.visible ss)
|
||||
delFromAllButCurrent w ss = foldr (delWinFromWorkspace w . W.tag)
|
||||
ss
|
||||
(W.hidden ss ++ map W.workspace (W.visible ss))
|
||||
delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
|
||||
|
||||
viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
|
||||
|
@ -18,7 +18,7 @@ module XMonad.Actions.CycleSelectedLayouts (
|
||||
cycleThroughLayouts) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude (findIndex, fromMaybe)
|
||||
import XMonad.Prelude (elemIndex, fromMaybe)
|
||||
import qualified XMonad.StackSet as S
|
||||
|
||||
-- $usage
|
||||
@ -32,7 +32,7 @@ import qualified XMonad.StackSet as S
|
||||
cycleToNext :: (Eq a) => [a] -> a -> Maybe a
|
||||
cycleToNext lst a = do
|
||||
-- not beautiful but simple and readable
|
||||
ind <- findIndex (a==) lst
|
||||
ind <- elemIndex a lst
|
||||
return $ lst !! if ind == length lst - 1 then 0 else ind+1
|
||||
|
||||
-- | If the current layout is in the list, cycle to the next layout. Otherwise,
|
||||
|
@ -199,8 +199,7 @@ skipTags wss ids = filter ((`notElem` ids) . tag) wss
|
||||
lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
|
||||
lastViewedHiddenExcept skips = do
|
||||
hs <- gets $ map tag . flip skipTags skips . hidden . windowset
|
||||
vs <- WH.workspaceHistory
|
||||
return $ choose hs (find (`elem` hs) vs)
|
||||
choose hs . find (`elem` hs) <$> WH.workspaceHistory
|
||||
where choose [] _ = Nothing
|
||||
choose (h:_) Nothing = Just h
|
||||
choose _ vh@(Just _) = vh
|
||||
@ -211,7 +210,7 @@ switchWorkspace d = wsBy d >>= windows . greedyView
|
||||
shiftBy :: Int -> X ()
|
||||
shiftBy d = wsBy d >>= windows . shift
|
||||
|
||||
wsBy :: Int -> X (WorkspaceId)
|
||||
wsBy :: Int -> X WorkspaceId
|
||||
wsBy = findWorkspace getSortByIndex Next AnyWS
|
||||
|
||||
{- $taketwo
|
||||
@ -260,7 +259,7 @@ wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
|
||||
hi <- wsTypeToPred HiddenWS
|
||||
return (\w -> hi w && ne w)
|
||||
wsTypeToPred AnyWS = return (const True)
|
||||
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset
|
||||
wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset
|
||||
return $ (cur ==).groupName
|
||||
where groupName = takeWhile (/=sep).tag
|
||||
wsTypeToPred (WSIs p) = p
|
||||
@ -297,7 +296,7 @@ findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceI
|
||||
findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
|
||||
where
|
||||
maybeNegate Next d = d
|
||||
maybeNegate Prev d = (-d)
|
||||
maybeNegate Prev d = -d
|
||||
|
||||
findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
|
||||
findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
|
||||
@ -307,7 +306,7 @@ findWorkspaceGen sortX wsPredX d = do
|
||||
ws <- gets windowset
|
||||
let cur = workspace (current ws)
|
||||
sorted = sort (workspaces ws)
|
||||
pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
|
||||
pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a
|
||||
ws' = filter wsPred pivoted
|
||||
mCurIx = findWsIndex cur ws'
|
||||
d' = if d > 0 then d - 1 else d
|
||||
@ -319,7 +318,7 @@ findWorkspaceGen sortX wsPredX d = do
|
||||
return $ tag next
|
||||
|
||||
findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
|
||||
findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
|
||||
findWsIndex ws = findIndex ((== tag ws) . tag)
|
||||
|
||||
-- | View next screen
|
||||
nextScreen :: X ()
|
||||
@ -347,7 +346,7 @@ the default screen keybindings:
|
||||
> , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||
|
||||
-}
|
||||
screenBy :: Int -> X (ScreenId)
|
||||
screenBy :: Int -> X ScreenId
|
||||
screenBy d = do ws <- gets windowset
|
||||
--let ss = sortBy screen (screens ws)
|
||||
let now = screen (current ws)
|
||||
|
@ -116,7 +116,7 @@ cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking t
|
||||
-- If it's the same as the first key, it is effectively ignored.
|
||||
-> X ()
|
||||
cycleRecentWindows = cycleStacks' stacks where
|
||||
stacks s = map (shiftToFocus' `flip` s) (wins s)
|
||||
stacks s = map (`shiftToFocus'` s) (wins s)
|
||||
wins (W.Stack t l r) = t : r ++ reverse l
|
||||
|
||||
|
||||
@ -205,7 +205,7 @@ rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
|
||||
rotFocused' _ s@(W.Stack _ [] []) = s
|
||||
rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
|
||||
where (t':rs') = f (t:rs)
|
||||
rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s -- otherwise
|
||||
rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise
|
||||
|
||||
|
||||
-- $unfocused
|
||||
|
@ -49,7 +49,7 @@ repeatableAction mods pressHandler = do
|
||||
return (t, s)
|
||||
handleEvent (t, s)
|
||||
| t == keyRelease && s `elem` mods = return ()
|
||||
| otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent
|
||||
| otherwise = pressHandler t s >> getNextEvent >>= handleEvent
|
||||
|
||||
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
|
||||
getNextEvent >>= handleEvent
|
||||
@ -81,9 +81,9 @@ cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransacti
|
||||
current <- readIORef currentWSIndex
|
||||
modifyIORef
|
||||
currentWSIndex
|
||||
((`mod` (length cycleWorkspaces)) . (+ increment))
|
||||
((`mod` length cycleWorkspaces) . (+ increment))
|
||||
return $ cycleWorkspaces !! current
|
||||
focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)
|
||||
focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView)
|
||||
|
||||
focusIncrement 1 -- Do the first workspace cycle
|
||||
repeatableAction mods $
|
||||
|
@ -44,7 +44,7 @@ import Control.Arrow ((&&&))
|
||||
import qualified Data.Map as M
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude (find)
|
||||
import XMonad.Prelude (find, for_)
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import XMonad.Prompt
|
||||
@ -68,14 +68,14 @@ type WSGroup = [(ScreenId,WorkspaceId)]
|
||||
|
||||
type WSGroupId = String
|
||||
|
||||
data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
|
||||
newtype WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
|
||||
deriving (Typeable, Read, Show)
|
||||
|
||||
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
|
||||
withWSG f = WSG . f . unWSG
|
||||
|
||||
instance ExtensionClass WSGroupStorage where
|
||||
initialValue = WSG $ M.empty
|
||||
initialValue = WSG M.empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
-- | Add a new workspace group of the given name, mapping to an
|
||||
@ -90,9 +90,7 @@ addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
|
||||
addWSGroup name wids = withWindowSet $ \w -> do
|
||||
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
|
||||
wmap = mapM (strength . (flip lookup wss &&& id)) wids
|
||||
case wmap of
|
||||
Just ps -> addRawWSGroup name ps
|
||||
Nothing -> return ()
|
||||
for_ wmap (addRawWSGroup name)
|
||||
where strength (ma, b) = ma >>= \a -> return (a,b)
|
||||
|
||||
-- | Give a name to the current workspace group.
|
||||
@ -114,9 +112,8 @@ viewWSGroup = viewGroup (windows . W.greedyView)
|
||||
viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()
|
||||
viewGroup fview name = do
|
||||
WSG m <- XS.get
|
||||
case M.lookup name m of
|
||||
Just grp -> mapM_ (uncurry (viewWS fview)) grp
|
||||
Nothing -> return ()
|
||||
for_ (M.lookup name m) $
|
||||
mapM_ (uncurry (viewWS fview))
|
||||
|
||||
-- | View the given workspace on the given screen, using the provided function.
|
||||
viewWS :: (WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
|
||||
@ -133,7 +130,7 @@ findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
|
||||
findScreenWS sid = withWindowSet $
|
||||
return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
|
||||
|
||||
data WSGPrompt = WSGPrompt String
|
||||
newtype WSGPrompt = WSGPrompt String
|
||||
|
||||
instance XPrompt WSGPrompt where
|
||||
showXPrompt (WSGPrompt s) = s
|
||||
|
@ -89,7 +89,7 @@ import Data.Ord (comparing)
|
||||
-- tweak as desired.
|
||||
|
||||
-- | Extensible state storage for the workspace order.
|
||||
data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
|
||||
newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
|
||||
deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass WSOrderStorage where
|
||||
|
@ -86,7 +86,7 @@ type WorkspaceIndex = Int
|
||||
|
||||
-- | Internal dynamic project state that stores a mapping between
|
||||
-- workspace indexes and workspace tags.
|
||||
data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
|
||||
newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
|
||||
deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass DynamicWorkspaceState where
|
||||
@ -239,14 +239,14 @@ isEmpty t = do wsl <- gets $ workspaces . windowset
|
||||
return $ maybe True (isNothing . stack) mws
|
||||
|
||||
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||
addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
|
||||
addHiddenWorkspace' add newtag l s@StackSet{ hidden = ws } = s { hidden = add (Workspace newtag l Nothing) ws }
|
||||
|
||||
-- | Remove the hidden workspace with the given tag from the StackSet, if
|
||||
-- it exists. All the windows in that workspace are moved to the current
|
||||
-- workspace.
|
||||
removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
|
||||
, hidden = hs })
|
||||
removeWorkspace' torem s@StackSet{ current = scr@Screen { workspace = wc }
|
||||
, hidden = hs }
|
||||
= let (xs, ys) = break ((== torem) . tag) hs
|
||||
in removeWorkspace'' xs ys
|
||||
where meld Nothing Nothing = Nothing
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -23,8 +23,9 @@ module XMonad.Actions.FlexibleManipulate (
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude ((<&>))
|
||||
import qualified Prelude as P
|
||||
import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
|
||||
import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.))
|
||||
|
||||
-- $usage
|
||||
-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
|
||||
@ -79,9 +80,9 @@ position = const 0.5
|
||||
-- manipulation action.
|
||||
mouseWindow :: (Double -> Double) -> Window -> X ()
|
||||
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
[wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
|
||||
[wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs
|
||||
sh <- io $ getWMNormalHints d w
|
||||
pointer <- io $ queryPointer d w >>= return . pointerPos
|
||||
pointer <- io $ queryPointer d w <&> pointerPos
|
||||
|
||||
let uv = (pointer - wpos) / wsize
|
||||
fc = mapP f uv
|
||||
@ -112,7 +113,7 @@ type Pnt = (Double, Double)
|
||||
pairUp :: [a] -> [(a,a)]
|
||||
pairUp [] = []
|
||||
pairUp [_] = []
|
||||
pairUp (x:y:xs) = (x, y) : (pairUp xs)
|
||||
pairUp (x:y:xs) = (x, y) : pairUp xs
|
||||
|
||||
mapP :: (a -> b) -> (a, a) -> (b, b)
|
||||
mapP f (x, y) = (f x, f y)
|
||||
@ -131,4 +132,3 @@ infixl 7 *, /
|
||||
(*) = zipP (P.*)
|
||||
(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
|
||||
(/) = zipP (P./)
|
||||
|
||||
|
@ -66,12 +66,12 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
(float w)
|
||||
where
|
||||
findPos :: CInt -> Position -> Maybe Bool
|
||||
findPos m s = if p < 0.5 - edge/2
|
||||
then Just True
|
||||
else if p < 0.5 + edge/2
|
||||
then Nothing
|
||||
else Just False
|
||||
where p = fi m / fi s
|
||||
findPos m s
|
||||
| p < 0.5 - edge/2 = Just True
|
||||
| p < 0.5 + edge/2 = Nothing
|
||||
| otherwise = Just False
|
||||
where
|
||||
p = fi m / fi s
|
||||
mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
|
||||
mkSel b k p = case b of
|
||||
Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
|
||||
|
@ -27,7 +27,7 @@ module XMonad.Actions.FloatSnap (
|
||||
ifClick') where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort)
|
||||
import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when)
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified Data.Set as S
|
||||
|
||||
@ -94,14 +94,14 @@ snapMagicMouseResize
|
||||
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
wa <- io $ getWindowAttributes d w
|
||||
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
|
||||
let x = (fromIntegral px - wx wa)/(ww wa)
|
||||
y = (fromIntegral py - wy wa)/(wh wa)
|
||||
ml = if x <= (0.5 - middle/2) then [L] else []
|
||||
mr = if x > (0.5 + middle/2) then [R] else []
|
||||
mu = if y <= (0.5 - middle/2) then [U] else []
|
||||
md = if y > (0.5 + middle/2) then [D] else []
|
||||
let x = (fromIntegral px - wx wa)/ww wa
|
||||
y = (fromIntegral py - wy wa)/wh wa
|
||||
ml = [L | x <= (0.5 - middle/2)]
|
||||
mr = [R | x > (0.5 + middle/2)]
|
||||
mu = [U | y <= (0.5 - middle/2)]
|
||||
md = [D | y > (0.5 + middle/2)]
|
||||
mdir = ml++mr++mu++md
|
||||
dir = if mdir == []
|
||||
dir = if null mdir
|
||||
then [L,R,U,D]
|
||||
else mdir
|
||||
snapMagicResize dir collidedist snapdist w
|
||||
@ -124,12 +124,12 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $
|
||||
(xbegin,xend) <- handleAxis True d wa
|
||||
(ybegin,yend) <- handleAxis False d wa
|
||||
|
||||
let xbegin' = if L `elem` dir then xbegin else (wx wa)
|
||||
xend' = if R `elem` dir then xend else (wx wa + ww wa)
|
||||
ybegin' = if U `elem` dir then ybegin else (wy wa)
|
||||
yend' = if D `elem` dir then yend else (wy wa + wh wa)
|
||||
let xbegin' = if L `elem` dir then xbegin else wx wa
|
||||
xend' = if R `elem` dir then xend else wx wa + ww wa
|
||||
ybegin' = if U `elem` dir then ybegin else wy wa
|
||||
yend' = if D `elem` dir then yend else wy wa + wh wa
|
||||
|
||||
io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
|
||||
io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin')
|
||||
io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
|
||||
float w
|
||||
where
|
||||
@ -149,13 +149,13 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $
|
||||
(Nothing,Nothing) -> wpos wa
|
||||
end = if fs
|
||||
then wpos wa + wdim wa
|
||||
else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
|
||||
else case (if mfl==Just begin then Nothing else mfl,mfr) of
|
||||
(Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
|
||||
(Just fl,Nothing) -> fl
|
||||
(Nothing,Just fr) -> fr
|
||||
(Nothing,Nothing) -> wpos wa + wdim wa
|
||||
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
|
||||
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
|
||||
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else wpos wa
|
||||
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else wpos wa + wdim wa
|
||||
return (begin',end')
|
||||
where
|
||||
(wpos, wdim, _, _) = constructors horiz
|
||||
@ -190,8 +190,8 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
|
||||
(Just fl,Nothing) -> fl
|
||||
(Nothing,Just fr) -> fr
|
||||
(Nothing,Nothing) -> wpos wa
|
||||
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
|
||||
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
|
||||
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else f - wdim wa
|
||||
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa
|
||||
where
|
||||
(wpos, wdim, _, _) = constructors horiz
|
||||
|
||||
@ -268,9 +268,8 @@ snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
|
||||
case mr of
|
||||
Nothing -> return ()
|
||||
Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
|
||||
Just (nx,ny,nw,nh) -> when (nw>0 && nh>0) $ do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
|
||||
io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
|
||||
else return ()
|
||||
float w
|
||||
where
|
||||
wx = fromIntegral.wa_x
|
||||
@ -286,7 +285,7 @@ getSnap horiz collidedist d w = do
|
||||
let sr = screenRect $ W.screenDetail screen
|
||||
wl = W.integrate' . W.stack $ W.workspace screen
|
||||
gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound])
|
||||
wla <- filter (collides wa) <$> (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
|
||||
wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl)
|
||||
|
||||
return ( neighbours (back wa sr gr wla) (wpos wa)
|
||||
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
|
||||
@ -300,8 +299,8 @@ getSnap horiz collidedist d w = do
|
||||
|
||||
back wa sr gr wla = dropWhile (< rpos sr) $
|
||||
takeWhile (< rpos sr + rdim sr) $
|
||||
sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
|
||||
foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
|
||||
sort $ rpos sr:rpos gr:(rpos gr + rdim gr):
|
||||
foldr (\a as -> wpos a:(wpos a + wdim a + wborder a + wborder wa):as) [] wla
|
||||
|
||||
front wa sr gr wla = dropWhile (<= rpos sr) $
|
||||
takeWhile (<= rpos sr + rdim sr) $
|
||||
@ -315,8 +314,8 @@ getSnap horiz collidedist d w = do
|
||||
|
||||
collides wa oa = case collidedist of
|
||||
Nothing -> True
|
||||
Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
|
||||
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
|
||||
Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
|
||||
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa
|
||||
|
||||
|
||||
constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
|
||||
|
@ -39,7 +39,7 @@ focusNth :: Int -> X ()
|
||||
focusNth = windows . modify' . focusNth'
|
||||
|
||||
focusNth' :: Int -> Stack a -> Stack a
|
||||
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
|
||||
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s
|
||||
| otherwise = listToStack n (integrate s)
|
||||
|
||||
-- | Swap current window with nth. Focus stays in the same position
|
||||
@ -52,7 +52,6 @@ swapNth' n s@(Stack c l r)
|
||||
| n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
|
||||
| otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
|
||||
|
||||
|
||||
listToStack :: Int -> [a] -> Stack a
|
||||
listToStack n l = Stack t ls rs
|
||||
where
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.GridSelect
|
||||
@ -222,7 +222,7 @@ instance HasColorizer String where
|
||||
instance {-# OVERLAPPABLE #-} HasColorizer a where
|
||||
defaultColorizer _ isFg =
|
||||
let getColor = if isFg then focusedBorderColor else normalBorderColor
|
||||
in asks $ flip (,) "black" . getColor . config
|
||||
in asks $ (, "black") . getColor . config
|
||||
|
||||
instance HasColorizer a => Default (GSConfig a) where
|
||||
def = buildDefaultGSConfig defaultColorizer
|
||||
@ -257,7 +257,7 @@ generateElementmap s = do
|
||||
-- Sorts the elementmap
|
||||
sortedElements = orderElementmap searchString filteredElements
|
||||
-- Case Insensitive version of isInfixOf
|
||||
needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
|
||||
needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack
|
||||
upper = map toUpper
|
||||
|
||||
|
||||
@ -301,8 +301,8 @@ diamondLayer n =
|
||||
-- tr = top right
|
||||
-- r = ur ++ 90 degree clock-wise rotation of ur
|
||||
let tr = [ (x,n-x) | x <- [0..n-1] ]
|
||||
r = tr ++ (map (\(x,y) -> (y,-x)) tr)
|
||||
in r ++ (map (negate *** negate) r)
|
||||
r = tr ++ map (\(x,y) -> (y,-x)) tr
|
||||
in r ++ map (negate *** negate) r
|
||||
|
||||
diamond :: (Enum a, Num a, Eq a) => [(a, a)]
|
||||
diamond = concatMap diamondLayer [0..]
|
||||
@ -332,7 +332,7 @@ drawWinBox win font (fg,bg) bc ch cw text x y cp =
|
||||
drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
|
||||
stext <- shrinkWhile (shrinkIt shrinkText)
|
||||
(\n -> do size <- liftIO $ textWidthXMF dpy font n
|
||||
return $ size > (fromInteger (cw-(2*cp))))
|
||||
return $ size > fromInteger (cw-(2*cp)))
|
||||
text
|
||||
-- calculate the offset to vertically centre the text based on the ascender and descender
|
||||
(asc,desc) <- liftIO $ textExtentsXMF font stext
|
||||
@ -385,7 +385,7 @@ updateElementsWithColorizer colorizer elementmap = do
|
||||
mapM_ updateElement elementmap
|
||||
|
||||
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
|
||||
stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
|
||||
stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
|
||||
| t == buttonRelease = do
|
||||
s@TwoDState { td_paneX = px, td_paneY = py,
|
||||
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
|
||||
@ -396,7 +396,7 @@ stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
|
||||
Nothing -> contEventloop
|
||||
| otherwise = contEventloop
|
||||
|
||||
stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
|
||||
stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
|
||||
|
||||
stdHandle _ contEventloop = contEventloop
|
||||
|
||||
@ -443,7 +443,7 @@ setPos newPos = do
|
||||
oldPos = td_curpos s
|
||||
when (isJust newSelectedEl && newPos /= oldPos) $ do
|
||||
put s { td_curpos = newPos }
|
||||
updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
|
||||
updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl])
|
||||
|
||||
-- | Moves the cursor by the offsets specified
|
||||
move :: (Integer, Integer) -> TwoD a ()
|
||||
@ -543,7 +543,7 @@ navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDef
|
||||
,((0,xK_Up) , move (0,-1) >> navNSearch)
|
||||
,((0,xK_Tab) , moveNext >> navNSearch)
|
||||
,((shiftMask,xK_Tab), movePrev >> navNSearch)
|
||||
,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
|
||||
,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> navNSearch)
|
||||
]
|
||||
-- The navigation handler ignores unknown key symbols, therefore we const
|
||||
navNSearchDefaultHandler (_,s,_) = do
|
||||
@ -557,7 +557,7 @@ substringSearch returnNavigation = fix $ \me ->
|
||||
let searchKeyMap = M.fromList [
|
||||
((0,xK_Escape) , transformSearchString (const "") >> returnNavigation)
|
||||
,((0,xK_Return) , returnNavigation)
|
||||
,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
|
||||
,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> me)
|
||||
]
|
||||
searchDefaultHandler (_,s,_) = do
|
||||
transformSearchString (++ s)
|
||||
@ -569,8 +569,8 @@ substringSearch returnNavigation = fix $ \me ->
|
||||
-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
|
||||
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
|
||||
hsv2rgb (h,s,v) =
|
||||
let hi = (div h 60) `mod` 6 :: Integer
|
||||
f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
|
||||
let hi = div h 60 `mod` 6 :: Integer
|
||||
f = ((fromInteger h/60) - fromInteger hi) :: Fractional a => a
|
||||
q = v * (1-f)
|
||||
p = v * (1-s)
|
||||
t = v * (1-(1-f)*s)
|
||||
@ -587,19 +587,19 @@ hsv2rgb (h,s,v) =
|
||||
stringColorizer :: String -> Bool -> X (String, String)
|
||||
stringColorizer s active =
|
||||
let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
|
||||
(r,g,b) = hsv2rgb ((seed 83) `mod` 360,
|
||||
(fromInteger ((seed 191) `mod` 1000))/2500+0.4,
|
||||
(fromInteger ((seed 121) `mod` 1000))/2500+0.4)
|
||||
(r,g,b) = hsv2rgb (seed 83 `mod` 360,
|
||||
fromInteger (seed 191 `mod` 1000)/2500+0.4,
|
||||
fromInteger (seed 121 `mod` 1000)/2500+0.4)
|
||||
in if active
|
||||
then return ("#faff69", "black")
|
||||
else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
|
||||
else return ("#" ++ concatMap (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b], "white")
|
||||
|
||||
-- | Colorize a window depending on it's className.
|
||||
fromClassName :: Window -> Bool -> X (String, String)
|
||||
fromClassName w active = runQuery className w >>= flip defaultColorizer active
|
||||
|
||||
twodigitHex :: Word8 -> String
|
||||
twodigitHex a = printf "%02x" a
|
||||
twodigitHex = printf "%02x"
|
||||
|
||||
-- | A colorizer that picks a color inside a range,
|
||||
-- and depending on the window's class.
|
||||
@ -655,14 +655,14 @@ gridselect gsconfig elements =
|
||||
font <- initXMF (gs_font gsconfig)
|
||||
let screenWidth = toInteger $ rect_width scr
|
||||
screenHeight = toInteger $ rect_height scr
|
||||
selectedElement <- if (status == grabSuccess) then do
|
||||
selectedElement <- if status == grabSuccess then do
|
||||
let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
|
||||
restrictX = floor $ restriction screenWidth gs_cellwidth
|
||||
restrictY = floor $ restriction screenHeight gs_cellheight
|
||||
originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
|
||||
originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
|
||||
originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX
|
||||
originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY
|
||||
coords = diamondRestrict restrictX restrictY originPosX originPosY
|
||||
s = TwoDState { td_curpos = (head coords),
|
||||
s = TwoDState { td_curpos = head coords,
|
||||
td_availSlots = coords,
|
||||
td_elements = elements,
|
||||
td_gsconfig = gsconfig,
|
||||
@ -673,7 +673,7 @@ gridselect gsconfig elements =
|
||||
td_searchString = "",
|
||||
td_elementmap = [] }
|
||||
m <- generateElementmap s
|
||||
evalTwoD (updateAllElements >> (gs_navigate gsconfig))
|
||||
evalTwoD (updateAllElements >> gs_navigate gsconfig)
|
||||
(s { td_elementmap = m })
|
||||
else
|
||||
return Nothing
|
||||
@ -695,16 +695,13 @@ gridselectWindow gsconf = windowMap >>= gridselect gsconf
|
||||
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
|
||||
withSelectedWindow callback conf = do
|
||||
mbWindow <- gridselectWindow conf
|
||||
case mbWindow of
|
||||
Just w -> callback w
|
||||
Nothing -> return ()
|
||||
for_ mbWindow callback
|
||||
|
||||
windowMap :: X [(String,Window)]
|
||||
windowMap = do
|
||||
ws <- gets windowset
|
||||
wins <- mapM keyValuePair (W.allWindows ws)
|
||||
return wins
|
||||
where keyValuePair w = flip (,) w <$> decorateName' w
|
||||
mapM keyValuePair (W.allWindows ws)
|
||||
where keyValuePair w = (, w) <$> decorateName' w
|
||||
|
||||
decorateName' :: Window -> X String
|
||||
decorateName' w = do
|
||||
@ -782,7 +779,7 @@ noRearranger _ = return
|
||||
-- already present).
|
||||
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
|
||||
searchStringRearrangerGenerator f =
|
||||
let r "" xs = return $ xs
|
||||
r s xs | s `elem` map fst xs = return $ xs
|
||||
let r "" xs = return xs
|
||||
r s xs | s `elem` map fst xs = return xs
|
||||
| otherwise = return $ xs ++ [(s, f s)]
|
||||
in r
|
||||
|
@ -224,5 +224,5 @@ isOnAnyVisibleWS = do
|
||||
ws <- liftX $ gets windowset
|
||||
let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws
|
||||
visibleWs = w `elem` allVisible
|
||||
unfocused = maybe True (w /=) $ SS.peek ws
|
||||
unfocused = Just w /= SS.peek ws
|
||||
return $ visibleWs && unfocused
|
||||
|
@ -33,7 +33,7 @@ import XMonad.Util.Paste
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
|
||||
data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
|
||||
newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
|
||||
|
||||
instance ExtensionClass KeymapTable where
|
||||
initialValue = KeymapTable []
|
||||
@ -124,8 +124,8 @@ extractKeyMapping (KeymapTable table) mask sym =
|
||||
buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
|
||||
buildKeyRemapBindings keyremaps =
|
||||
[((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
|
||||
where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
|
||||
bindings = nub (map (\binding -> fst binding) mappings)
|
||||
where mappings = concatMap (\(KeymapTable table) -> table) keyremaps
|
||||
bindings = nub (map fst mappings)
|
||||
|
||||
|
||||
-- Here come the Keymappings
|
||||
@ -137,7 +137,7 @@ emptyKeyRemap = KeymapTable []
|
||||
dvorakProgrammerKeyRemap :: KeymapTable
|
||||
dvorakProgrammerKeyRemap =
|
||||
KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
|
||||
(maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
|
||||
(maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey]
|
||||
where
|
||||
|
||||
layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym]
|
||||
|
@ -61,7 +61,7 @@ type ExtensionActions = M.Map String (String -> X())
|
||||
instance XPrompt CalculatorMode where
|
||||
showXPrompt CalcMode = "calc %s> "
|
||||
commandToComplete CalcMode = id --send the whole string to `calc`
|
||||
completionFunction CalcMode = \s -> if (length s == 0) then return [] else
|
||||
completionFunction CalcMode = \s -> if null s then return [] else
|
||||
lines <$> runProcessWithInput "calc" [s] ""
|
||||
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
|
||||
|
||||
|
@ -27,6 +27,7 @@ module XMonad.Actions.LinkWorkspaces (
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude (for_)
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Layout.IndependentScreens(countScreens)
|
||||
import qualified XMonad.Util.ExtensibleState as XS (get, put)
|
||||
@ -59,7 +60,7 @@ import qualified Data.Map as M
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
|
||||
data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
|
||||
, foreground :: [Char]
|
||||
, alertedForeground :: [Char]
|
||||
, background :: [Char]
|
||||
@ -75,7 +76,7 @@ noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
|
||||
noMessageFn _ _ _ _ = return () :: X ()
|
||||
|
||||
-- | Stuff for linking workspaces
|
||||
data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
|
||||
newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
|
||||
instance ExtensionClass WorkspaceMap
|
||||
where initialValue = WorkspaceMap M.empty
|
||||
extensionType = PersistentExtension
|
||||
@ -85,12 +86,12 @@ switchWS f m ws = switchWS' f m ws Nothing
|
||||
|
||||
-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
|
||||
-- | we already did switching on
|
||||
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X ()
|
||||
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X ()
|
||||
switchWS' switchFn message workspace stopAtScreen = do
|
||||
ws <- gets windowset
|
||||
nScreens <- countScreens
|
||||
let now = W.screen (W.current ws)
|
||||
let next = ((now + 1) `mod` nScreens)
|
||||
let next = (now + 1) `mod` nScreens
|
||||
switchFn workspace
|
||||
case stopAtScreen of
|
||||
Nothing -> sTM now next (Just now)
|
||||
@ -99,11 +100,11 @@ switchWS' switchFn message workspace stopAtScreen = do
|
||||
|
||||
-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
|
||||
-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
|
||||
switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
|
||||
-> ScreenId -> (Maybe ScreenId) -> X ()
|
||||
switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
|
||||
-> ScreenId -> Maybe ScreenId -> X ()
|
||||
switchToMatching f message t now next stopAtScreen = do
|
||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||
case (M.lookup t matchings) of
|
||||
case M.lookup t matchings of
|
||||
Nothing -> return () :: X()
|
||||
Just newWorkspace -> do
|
||||
onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
|
||||
@ -113,7 +114,7 @@ switchToMatching f message t now next stopAtScreen = do
|
||||
toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
|
||||
toggleMatching message t1 t2 = do
|
||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||
case (M.lookup t1 matchings) of
|
||||
case M.lookup t1 matchings of
|
||||
Nothing -> setMatching message t1 t2 matchings
|
||||
Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
|
||||
return ()
|
||||
@ -142,7 +143,7 @@ removeAllMatchings :: MessageConfig -> X ()
|
||||
removeAllMatchings message = do
|
||||
ws <- gets windowset
|
||||
let now = W.screen (W.current ws)
|
||||
XS.put $ WorkspaceMap $ M.empty
|
||||
XS.put $ WorkspaceMap M.empty
|
||||
messageFunction message now (alertedForeground message) (background message) "All links removed!"
|
||||
|
||||
-- | remove all matching regarding a given workspace
|
||||
@ -163,7 +164,6 @@ toggleLinkWorkspaces' first message = do
|
||||
let now = W.screen (W.current ws)
|
||||
let next = (now + 1) `mod` nScreens
|
||||
if next == first then return () else do -- this is also the case if there is only one screen
|
||||
case (W.lookupWorkspace next ws) of
|
||||
Nothing -> return ()
|
||||
Just name -> toggleMatching message (W.currentTag ws) (name)
|
||||
for_ (W.lookupWorkspace next ws)
|
||||
(toggleMatching message (W.currentTag ws))
|
||||
onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
|
||||
|
@ -106,7 +106,7 @@ import Control.Monad.State ( gets )
|
||||
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
|
||||
sendSomeMessageB :: SomeMessage -> X Bool
|
||||
sendSomeMessageB m = windowBracket id $ do
|
||||
w <- workspace . current <$> gets windowset
|
||||
w <- gets ((workspace . current) . windowset)
|
||||
ml <- handleMessage (layout w) m `catchX` return Nothing
|
||||
whenJust ml $ \l ->
|
||||
modifyWindowSet $ \ws -> ws { current = (current ws)
|
||||
@ -138,7 +138,7 @@ sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
|
||||
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
|
||||
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
|
||||
sendSomeMessageWithNoRefreshToCurrentB m
|
||||
= (gets $ workspace . current . windowset)
|
||||
= gets (workspace . current . windowset)
|
||||
>>= sendSomeMessageWithNoRefreshB m
|
||||
|
||||
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
|
||||
|
@ -118,7 +118,7 @@ maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
|
||||
-- | Perform an action with first minimized window on current workspace
|
||||
-- or do nothing if there is no minimized windows on current workspace
|
||||
withFirstMinimized :: (Window -> X ()) -> X ()
|
||||
withFirstMinimized action = withFirstMinimized' (flip whenJust action)
|
||||
withFirstMinimized action = withFirstMinimized' (`whenJust` action)
|
||||
|
||||
-- | Like withFirstMinimized but the provided action is always invoked with a
|
||||
-- 'Maybe Window', that will be nothing if there is no first minimized window.
|
||||
@ -128,7 +128,7 @@ withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
|
||||
-- | Perform an action with last minimized window on current workspace
|
||||
-- or do nothing if there is no minimized windows on current workspace
|
||||
withLastMinimized :: (Window -> X ()) -> X ()
|
||||
withLastMinimized action = withLastMinimized' (flip whenJust action)
|
||||
withLastMinimized action = withLastMinimized' (`whenJust` action)
|
||||
|
||||
-- | Like withLastMinimized but the provided action is always invoked with a
|
||||
-- 'Maybe Window', that will be nothing if there is no last minimized window.
|
||||
|
@ -110,7 +110,7 @@ mouseGestureH moveHook endHook = do
|
||||
mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
|
||||
mouseGesture tbl win = do
|
||||
(mov, end) <- mkCollect
|
||||
mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
|
||||
mouseGestureH (void . mov) $ end >>= \gest ->
|
||||
case M.lookup gest tbl of
|
||||
Nothing -> return ()
|
||||
Just f -> f win
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -56,7 +56,7 @@ import XMonad.Util.XUtils
|
||||
mouseResize :: l a -> ModifiedLayout MouseResize l a
|
||||
mouseResize = ModifiedLayout (MR [])
|
||||
|
||||
data MouseResize a = MR [((a,Rectangle),Maybe a)]
|
||||
newtype MouseResize a = MR [((a,Rectangle),Maybe a)]
|
||||
instance Show (MouseResize a) where show _ = ""
|
||||
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
|
||||
|
||||
@ -68,7 +68,7 @@ instance LayoutModifier MouseResize Window where
|
||||
where
|
||||
wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs
|
||||
initState = mapM createInputWindow wrs'
|
||||
processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
|
||||
processState = mapM_ (deleteInputWin . snd) st >> mapM createInputWindow wrs'
|
||||
|
||||
inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
|
||||
|
||||
|
@ -59,7 +59,7 @@ module XMonad.Actions.Navigation2D ( -- * Usage
|
||||
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as M
|
||||
import Data.Ord (comparing)
|
||||
import Control.Arrow (second)
|
||||
import XMonad.Prelude
|
||||
import XMonad hiding (Screen)
|
||||
import qualified XMonad.StackSet as W
|
||||
@ -476,7 +476,7 @@ switchLayer = actOnLayer otherLayer
|
||||
-- navigation should wrap around (e.g., from the left edge of the leftmost
|
||||
-- screen to the right edge of the rightmost screen).
|
||||
windowGo :: Direction2D -> Bool -> X ()
|
||||
windowGo dir wrap = actOnLayer thisLayer
|
||||
windowGo dir = actOnLayer thisLayer
|
||||
( \ conf cur wins -> windows
|
||||
$ doTiledNavigation conf dir W.focusWindow cur wins
|
||||
)
|
||||
@ -486,7 +486,6 @@ windowGo dir wrap = actOnLayer thisLayer
|
||||
( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.view cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Swaps the current window with the next window in the given direction and in
|
||||
-- the same layer as the current window. (In the floating layer, all that
|
||||
@ -495,7 +494,7 @@ windowGo dir wrap = actOnLayer thisLayer
|
||||
-- window's screen but retains its position and size relative to the screen.)
|
||||
-- The second argument indicates wrapping (see 'windowGo').
|
||||
windowSwap :: Direction2D -> Bool -> X ()
|
||||
windowSwap dir wrap = actOnLayer thisLayer
|
||||
windowSwap dir = actOnLayer thisLayer
|
||||
( \ conf cur wins -> windows
|
||||
$ doTiledNavigation conf dir swap cur wins
|
||||
)
|
||||
@ -503,32 +502,28 @@ windowSwap dir wrap = actOnLayer thisLayer
|
||||
$ doFloatNavigation conf dir swap cur wins
|
||||
)
|
||||
( \ _ _ _ -> return () )
|
||||
wrap
|
||||
|
||||
-- | Moves the current window to the next screen in the given direction. The
|
||||
-- second argument indicates wrapping (see 'windowGo').
|
||||
windowToScreen :: Direction2D -> Bool -> X ()
|
||||
windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||
windowToScreen dir = actOnScreens ( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.shift cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Moves the focus to the next screen in the given direction. The second
|
||||
-- argument indicates wrapping (see 'windowGo').
|
||||
screenGo :: Direction2D -> Bool -> X ()
|
||||
screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||
screenGo dir = actOnScreens ( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.view cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Swaps the workspace on the current screen with the workspace on the screen
|
||||
-- in the given direction. The second argument indicates wrapping (see
|
||||
-- 'windowGo').
|
||||
screenSwap :: Direction2D -> Bool -> X ()
|
||||
screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||
screenSwap dir = actOnScreens ( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.greedyView cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Maps each window to a fullscreen rect. This may not be the same rectangle the
|
||||
-- window maps to under the Full layout or a similar layout if the layout
|
||||
@ -648,7 +643,7 @@ doFocusClosestWindow (cur, rect) winrects
|
||||
where
|
||||
ctr = centerOf rect
|
||||
winctrs = filter ((cur /=) . fst)
|
||||
$ map (\(w, r) -> (w, centerOf r)) winrects
|
||||
$ map (second centerOf) winrects
|
||||
closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
|
||||
| otherwise = wc1
|
||||
|
||||
@ -668,8 +663,7 @@ doTiledNavigation conf dir act cur winrects winset
|
||||
nav = maximum
|
||||
$ map ( fromMaybe (defaultTiledNavigation conf)
|
||||
. flip L.lookup (layoutNavigation conf)
|
||||
)
|
||||
$ layouts
|
||||
) layouts
|
||||
|
||||
-- | Implements navigation for the float layer
|
||||
doFloatNavigation :: Navigation2DConfig
|
||||
@ -714,7 +708,7 @@ doLineNavigation dir (cur, rect) winrects
|
||||
|
||||
-- The list of windows that are candidates to receive focus.
|
||||
winrects' = filter dirFilter
|
||||
$ filter ((cur /=) . fst)
|
||||
. filter ((cur /=) . fst)
|
||||
$ winrects
|
||||
|
||||
-- Decides whether a given window matches the criteria to be a candidate to
|
||||
@ -755,9 +749,8 @@ doCenterNavigation dir (cur, rect) winrects
|
||||
-- center rotated so the right cone becomes the relevant cone.
|
||||
-- The windows are ordered in the order they should be preferred
|
||||
-- when they are otherwise tied.
|
||||
winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
|
||||
$ stackTransform
|
||||
$ winrects
|
||||
winctrs = map (second (dirTransform . centerOf))
|
||||
$ stackTransform winrects
|
||||
|
||||
-- Give preference to windows later in the stack for going left or up and to
|
||||
-- windows earlier in the stack for going right or down. (The stack order
|
||||
@ -815,7 +808,7 @@ doSideNavigationWithBias ::
|
||||
Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
|
||||
doSideNavigationWithBias bias dir (cur, rect)
|
||||
= fmap fst . listToMaybe
|
||||
. L.sortBy (comparing dist) . foldr acClosest []
|
||||
. L.sortOn dist . foldr acClosest []
|
||||
. filter (`toRightOf` (cur, transform rect))
|
||||
. map (fmap transform)
|
||||
where
|
||||
@ -843,7 +836,7 @@ doSideNavigationWithBias bias dir (cur, rect)
|
||||
-- Greedily accumulate the windows tied for the leftmost left side.
|
||||
acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
|
||||
| x1 r > x1 r' = l
|
||||
acClosest (w, r) _ = (w, r) : []
|
||||
acClosest (w, r) _ = [(w, r)]
|
||||
|
||||
-- Given a (_, SideRect), calculate how far it is from the y=bias line.
|
||||
dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
|
||||
@ -864,7 +857,7 @@ swap win winset = W.focusWindow cur
|
||||
visws = map W.workspace scrs
|
||||
|
||||
-- The focused windows of the visible workspaces
|
||||
focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
|
||||
focused = mapMaybe (fmap W.focus . W.stack) visws
|
||||
|
||||
-- The window lists of the visible workspaces
|
||||
wins = map (W.integrate' . W.stack) visws
|
||||
@ -891,8 +884,8 @@ centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r
|
||||
|
||||
-- | Functions to choose the subset of windows to operate on
|
||||
thisLayer, otherLayer :: a -> a -> a
|
||||
thisLayer = curry fst
|
||||
otherLayer = curry snd
|
||||
thisLayer = const
|
||||
otherLayer _ x = x
|
||||
|
||||
-- | Returns the list of visible workspaces and their screen rects
|
||||
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
|
||||
@ -929,8 +922,8 @@ wrapOffsets winset = (max_x - min_x, max_y - min_y)
|
||||
where
|
||||
min_x = fi $ minimum $ map rect_x rects
|
||||
min_y = fi $ minimum $ map rect_y rects
|
||||
max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width r)) rects
|
||||
max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
|
||||
max_x = fi $ maximum $ map (\r -> rect_x r + fi (rect_width r)) rects
|
||||
max_y = fi $ maximum $ map (\r -> rect_y r + fi (rect_height r)) rects
|
||||
rects = map snd $ visibleWorkspaces winset False
|
||||
|
||||
|
||||
|
@ -30,7 +30,7 @@ module XMonad.Actions.PhysicalScreens (
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude (findIndex, on, sortBy)
|
||||
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
{- $usage
|
||||
@ -70,7 +70,7 @@ For detailed instructions on editing your key bindings, see
|
||||
-- | The type of the index of a screen by location
|
||||
newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
|
||||
|
||||
getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)
|
||||
getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
|
||||
getScreenIdAndRectangle screen = (W.screen screen, rect) where
|
||||
rect = screenRect $ W.screenDetail screen
|
||||
|
||||
@ -129,7 +129,7 @@ getNeighbour :: ScreenComparator -> Int -> X ScreenId
|
||||
getNeighbour (ScreenComparator cmpScreen) d =
|
||||
do w <- gets windowset
|
||||
let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
|
||||
curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
|
||||
curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss
|
||||
pos = (curPos + d) `mod` length ss
|
||||
return $ ss !! pos
|
||||
|
||||
|
@ -140,7 +140,7 @@ usePrefixArgument prefix conf = conf {
|
||||
useDefaultPrefixArgument :: LayoutClass l Window
|
||||
=> XConfig l
|
||||
-> XConfig l
|
||||
useDefaultPrefixArgument = usePrefixArgument (\_ -> (controlMask, xK_u))
|
||||
useDefaultPrefixArgument = usePrefixArgument (const (controlMask, xK_u))
|
||||
|
||||
handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
|
||||
handlePrefixArg events = do
|
||||
|
@ -40,8 +40,8 @@ import XMonad
|
||||
-- | Rotate the windows in the current stack, excluding the first one
|
||||
-- (master).
|
||||
rotSlavesUp,rotSlavesDown :: X ()
|
||||
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
|
||||
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
|
||||
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> tail l++[head l]))
|
||||
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l))
|
||||
|
||||
-- | The actual rotation, as a pure function on the window stack.
|
||||
rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
|
||||
@ -49,12 +49,12 @@ rotSlaves' _ s@(Stack _ [] []) = s
|
||||
rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus
|
||||
rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise
|
||||
where (master:ws) = integrate s
|
||||
(revls',t':rs') = splitAt (length ls) (master:(f ws))
|
||||
(revls',t':rs') = splitAt (length ls) (master:f ws)
|
||||
|
||||
-- | Rotate all the windows in the current stack.
|
||||
rotAllUp,rotAllDown :: X ()
|
||||
rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))
|
||||
rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))
|
||||
rotAllUp = windows $ modify' (rotAll' (\l -> tail l++[head l]))
|
||||
rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l))
|
||||
|
||||
-- | The actual rotation, as a pure function on the window stack.
|
||||
rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
|
||||
|
@ -152,8 +152,7 @@ rotateSome p (Stack t ls rs) =
|
||||
. span ((< 0) . fst)
|
||||
. sortOn fst
|
||||
. (++) anchors
|
||||
. map (fst *** snd)
|
||||
$ zip movables (rotate movables)
|
||||
$ zipWith (curry (fst *** snd)) movables (rotate movables)
|
||||
in
|
||||
Stack t' (reverse ls') rs'
|
||||
|
||||
|
@ -213,7 +213,7 @@ engine.
|
||||
Happy searching! -}
|
||||
|
||||
-- | A customized prompt indicating we are searching, and the name of the site.
|
||||
data Search = Search Name
|
||||
newtype Search = Search Name
|
||||
instance XPrompt Search where
|
||||
showXPrompt (Search name)= "Search [" ++ name ++ "]: "
|
||||
nextCompletion _ = getNextCompletion
|
||||
@ -260,7 +260,7 @@ search browser site query = safeSpawn browser [site query]
|
||||
Generally, examining the resultant URL of a search will allow you to reverse-engineer
|
||||
it if you can't find the necessary URL already described in other projects such as Surfraw. -}
|
||||
searchEngine :: Name -> String -> SearchEngine
|
||||
searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
|
||||
searchEngine name site = searchEngineF name (\s -> site ++ escape s)
|
||||
|
||||
{- | If your search engine is more complex than this (you may want to identify
|
||||
the kind of input and make the search URL dependent on the input or put the query
|
||||
@ -316,7 +316,7 @@ vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q
|
||||
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
|
||||
|
||||
multi :: SearchEngine
|
||||
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
|
||||
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google]
|
||||
|
||||
{- | This function wraps up a search engine and creates a new one, which works
|
||||
like the argument, but goes directly to a URL if one is given rather than
|
||||
@ -326,7 +326,7 @@ multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbt
|
||||
|
||||
Now if you search for http:\/\/xmonad.org it will directly open in your browser-}
|
||||
intelligent :: SearchEngine -> SearchEngine
|
||||
intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))
|
||||
intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s)
|
||||
|
||||
-- | > removeColonPrefix "foo://bar" ~> "//bar"
|
||||
-- > removeColonPrefix "foo//bar" ~> "foo//bar"
|
||||
|
@ -87,8 +87,8 @@ handleTimerEvent :: Event -> X All
|
||||
handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
|
||||
(ShowText m) <- ES.get :: X ShowText
|
||||
a <- io $ internAtom dis "XMONAD_TIMER" False
|
||||
when (mtyp == a && length d >= 1)
|
||||
(whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
|
||||
when (mtyp == a && not (null d))
|
||||
(whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
|
||||
mempty
|
||||
handleTimerEvent _ = mempty
|
||||
|
||||
|
@ -124,7 +124,7 @@ manageSpawnWithGC garbageCollect = do
|
||||
|
||||
mkPrompt :: (String -> X ()) -> XPConfig -> X ()
|
||||
mkPrompt cb c = do
|
||||
cmds <- io $ getCommands
|
||||
cmds <- io getCommands
|
||||
mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
|
||||
|
||||
-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
|
||||
@ -145,13 +145,13 @@ spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
|
||||
-- | Replacement for 'spawn' which launches
|
||||
-- application on given workspace.
|
||||
spawnOn :: WorkspaceId -> String -> X ()
|
||||
spawnOn ws cmd = spawnAndDo (doShift ws) cmd
|
||||
spawnOn ws = spawnAndDo (doShift ws)
|
||||
|
||||
-- | Spawn an application and apply the manage hook when it opens.
|
||||
spawnAndDo :: ManageHook -> String -> X ()
|
||||
spawnAndDo mh cmd = do
|
||||
p <- spawnPID $ mangle cmd
|
||||
modifySpawner $ ((p,mh) :)
|
||||
modifySpawner ((p,mh) :)
|
||||
where
|
||||
-- TODO this is silly, search for a better solution
|
||||
mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
|
||||
|
@ -338,7 +338,7 @@ split' p i l =
|
||||
then (c+1,e:ys,ns)
|
||||
else (c+1,ys,e:ns)
|
||||
(c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
|
||||
in (c',ys',snd . unzip $ ns')
|
||||
in (c',ys',map snd ns')
|
||||
|
||||
-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
|
||||
-- unindexed list with elements from the leftover indexed list appended.
|
||||
|
@ -59,6 +59,7 @@ swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurr
|
||||
-- one with the two corresponding workspaces' tags swapped.
|
||||
swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
swapWorkspaces t1 t2 = mapWorkspace swap
|
||||
where swap w = if tag w == t1 then w { tag = t2 }
|
||||
else if tag w == t2 then w { tag = t1 }
|
||||
else w
|
||||
where swap w
|
||||
| tag w == t1 = w { tag = t2 }
|
||||
| tag w == t2 = w { tag = t1 }
|
||||
| otherwise = w
|
||||
|
@ -82,8 +82,7 @@ getTags w = withDisplay $ \d ->
|
||||
io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
|
||||
getTextProperty d w >>=
|
||||
wcTextPropertyToTextList d)
|
||||
(econst [[]])
|
||||
>>= return . words . unwords
|
||||
(econst [[]]) <&> (words . unwords)
|
||||
|
||||
-- | check a window for the given tag
|
||||
hasTag :: String -> Window -> X Bool
|
||||
@ -93,7 +92,7 @@ hasTag s w = (s `elem`) <$> getTags w
|
||||
addTag :: String -> Window -> X ()
|
||||
addTag s w = do
|
||||
tags <- getTags w
|
||||
if (s `notElem` tags) then setTags (s:tags) w else return ()
|
||||
when (s `notElem` tags) $ setTags (s:tags) w
|
||||
|
||||
-- | remove a tag from a window, if it exists
|
||||
delTag :: String -> Window -> X ()
|
||||
@ -156,7 +155,7 @@ withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
|
||||
|
||||
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
|
||||
withTaggedGlobal' t m = gets windowset >>=
|
||||
filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
|
||||
filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m
|
||||
|
||||
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
|
||||
withFocusedP f = withFocused $ windows . f
|
||||
@ -165,7 +164,7 @@ shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s
|
||||
shiftHere w s = shiftWin (currentTag s) w s
|
||||
|
||||
shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
|
||||
shiftToScreen sid w s = case filter (\m -> sid /= screen m) (current s:visible s) of
|
||||
[] -> s
|
||||
(t:_) -> shiftWin (tag . workspace $ t) w s
|
||||
|
||||
@ -181,17 +180,16 @@ tagPrompt c f = do
|
||||
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
|
||||
|
||||
tagComplList :: X [String]
|
||||
tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
|
||||
mapM getTags >>=
|
||||
return . nub . concat
|
||||
tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset)
|
||||
>>= mapM getTags
|
||||
<&> nub . concat
|
||||
|
||||
|
||||
tagDelPrompt :: XPConfig -> X ()
|
||||
tagDelPrompt c = do
|
||||
sc <- tagDelComplList
|
||||
if (sc /= [])
|
||||
then mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (\s -> withFocused (delTag s))
|
||||
else return ()
|
||||
when (sc /= []) $
|
||||
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag)
|
||||
|
||||
tagDelComplList :: X [String]
|
||||
tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
|
||||
|
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.TreeSelect
|
||||
@ -65,7 +66,7 @@ module XMonad.Actions.TreeSelect
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Data.Tree
|
||||
import Foreign
|
||||
import Foreign (shiftL, shiftR, (.&.))
|
||||
import System.IO
|
||||
import System.Posix.Process (forkProcess, executeFile)
|
||||
import XMonad hiding (liftX)
|
||||
@ -451,8 +452,8 @@ splitPath i = case break (== '.') i of
|
||||
-- > ]
|
||||
-- > ]
|
||||
treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
|
||||
treeselectAction c xs = treeselect c xs >>= \x -> case x of
|
||||
Just a -> a >> return ()
|
||||
treeselectAction c xs = treeselect c xs >>= \case
|
||||
Just a -> void a
|
||||
Nothing -> return ()
|
||||
|
||||
forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
|
||||
@ -464,7 +465,7 @@ mapMTree f (Node x xs) = Node <$> f x <*> mapM (mapMTree f) xs
|
||||
|
||||
-- | Quit returning the currently selected node
|
||||
select :: TreeSelect a (Maybe a)
|
||||
select = Just <$> gets (tsn_value . cursor . tss_tree)
|
||||
select = gets (Just . (tsn_value . cursor . tss_tree))
|
||||
|
||||
-- | Quit without returning anything
|
||||
cancel :: TreeSelect a (Maybe a)
|
||||
|
@ -39,7 +39,7 @@ import qualified XMonad.StackSet as W
|
||||
|
||||
-- | Changes the focus if the mouse is moved within an unfocused window.
|
||||
focusOnMouseMove :: Event -> X All
|
||||
focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
|
||||
focusOnMouseMove MotionEvent{ ev_x = x, ev_y = y, ev_window = root } = do
|
||||
-- check only every 15 px to avoid excessive calls to translateCoordinates
|
||||
when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
|
||||
dpy <- asks display
|
||||
|
@ -104,5 +104,7 @@ lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r
|
||||
lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
|
||||
|
||||
clip :: Ord a => (a, a) -> a -> a
|
||||
clip (lower, upper) x = if x < lower then lower
|
||||
else if x > upper then upper else x
|
||||
clip (lower, upper) x
|
||||
| x < lower = lower
|
||||
| x > upper = upper
|
||||
| otherwise = x
|
||||
|
@ -101,7 +101,7 @@ warpToWindow h v =
|
||||
warpToScreen :: ScreenId -> Rational -> Rational -> X ()
|
||||
warpToScreen n h v = do
|
||||
root <- asks theRoot
|
||||
(StackSet {current = x, visible = xs}) <- gets windowset
|
||||
StackSet{current = x, visible = xs} <- gets windowset
|
||||
whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)
|
||||
$ \r ->
|
||||
warp root (rect_x r + fraction h (rect_width r))
|
||||
|
@ -146,7 +146,7 @@ windowMap' titler = do
|
||||
ws <- gets X.windowset
|
||||
M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
|
||||
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
|
||||
keyValuePair ws w = flip (,) w <$> titler ws w
|
||||
keyValuePair ws w = (, w) <$> titler ws w
|
||||
|
||||
-- | Returns the window name as will be listed in dmenu.
|
||||
-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user
|
||||
|
@ -68,7 +68,7 @@ windowMenu = withFocused $ \w -> do
|
||||
| tag <- tags ]
|
||||
runSelectedAction gsConfig actions
|
||||
|
||||
getSize :: Window -> X (Rectangle)
|
||||
getSize :: Window -> X Rectangle
|
||||
getSize w = do
|
||||
d <- asks display
|
||||
wa <- io $ getWindowAttributes d w
|
||||
|
@ -40,7 +40,7 @@ module XMonad.Actions.WindowNavigation (
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortBy)
|
||||
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
|
||||
import XMonad.Util.Types (Direction2D(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
@ -48,7 +48,6 @@ import Control.Arrow (second)
|
||||
import Data.IORef
|
||||
import Data.Map (Map())
|
||||
import qualified Data.Map as M
|
||||
import Data.Ord (comparing)
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- $usage
|
||||
@ -123,9 +122,12 @@ swap = withTargetWindow swapWithFocused
|
||||
mapWindows (swapWin currentWin targetWin) winSet
|
||||
Nothing -> winSet
|
||||
mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
|
||||
mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
|
||||
mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s }
|
||||
mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
|
||||
swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
|
||||
swapWin win1 win2 win
|
||||
| win == win1 = win2
|
||||
| win == win2 = win1
|
||||
| otherwise = win
|
||||
|
||||
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
|
||||
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
|
||||
@ -191,7 +193,7 @@ windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
|
||||
windowRect :: Window -> X (Maybe (Window, Rectangle))
|
||||
windowRect win = withDisplay $ \dpy -> do
|
||||
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
|
||||
return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
|
||||
return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
|
||||
`catchX` return Nothing
|
||||
|
||||
-- Modified from droundy's implementation of WindowNavigation:
|
||||
@ -207,7 +209,7 @@ inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w
|
||||
py >= ry && py < ry + fromIntegral h
|
||||
|
||||
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
|
||||
sortby D = sortBy $ comparing (rect_y . snd)
|
||||
sortby R = sortBy $ comparing (rect_x . snd)
|
||||
sortby D = sortOn (rect_y . snd)
|
||||
sortby R = sortOn (rect_x . snd)
|
||||
sortby U = reverse . sortby D
|
||||
sortby L = reverse . sortby R
|
||||
|
@ -67,14 +67,14 @@ instance ExtensionClass WorkscreenStorage where
|
||||
|
||||
-- | Helper to group workspaces. Multiply workspace by screens number.
|
||||
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
|
||||
expandWorkspace nscr ws = concat $ map expandId ws
|
||||
expandWorkspace nscr = concatMap expandId
|
||||
where expandId wsId = let t = wsId ++ "_"
|
||||
in map ((++) t . show ) [1..nscr]
|
||||
|
||||
-- | Create workscreen list from workspace list. Group workspaces to
|
||||
-- packets of screens number size.
|
||||
fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
|
||||
fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)
|
||||
fromWorkspace n ws = zipWith Workscreen [0..] (fromWorkspace' n ws)
|
||||
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
|
||||
fromWorkspace' _ [] = []
|
||||
fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
|
||||
|
@ -49,10 +49,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
|
||||
import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
|
||||
fromMessage, sendMessage, windows, gets)
|
||||
import XMonad.Util.Stack (reverseS)
|
||||
import Control.Applicative (liftA2)
|
||||
import Control.Monad((<=<), guard, when)
|
||||
import Data.Foldable(toList)
|
||||
import Data.Maybe(fromJust, listToMaybe)
|
||||
import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<))
|
||||
|
||||
-- $usage
|
||||
--
|
||||
@ -143,7 +140,7 @@ getFocus (End x) = x
|
||||
|
||||
-- This could be made more efficient, if the fact that the suffixes are grouped
|
||||
focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t)
|
||||
focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True)
|
||||
focusTo x = find ((x==) . getFocus) . changeFocus (const True)
|
||||
|
||||
-- | non-wrapping version of 'W.focusUp''
|
||||
noWrapUp :: W.Stack t -> W.Stack t
|
||||
@ -192,7 +189,7 @@ modifyLayer' f depth = modifyCursors (descend f depth)
|
||||
modifyCursors :: (Cursors String -> X (Cursors String)) -> X ()
|
||||
modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<)
|
||||
|
||||
data WorkspaceCursors a = WorkspaceCursors (Cursors String)
|
||||
newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)
|
||||
deriving (Typeable,Read,Show)
|
||||
|
||||
-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
|
||||
@ -201,7 +198,7 @@ data WorkspaceCursors a = WorkspaceCursors (Cursors String)
|
||||
workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
|
||||
workspaceCursors = ModifiedLayout . WorkspaceCursors
|
||||
|
||||
data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
|
||||
newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
|
||||
deriving (Typeable)
|
||||
|
||||
instance Message ChangeCursors
|
||||
|
@ -161,7 +161,7 @@ swapNames w1 w2 = do
|
||||
WorkspaceNames m <- XS.get
|
||||
let getname w = fromMaybe "" $ M.lookup w m
|
||||
set w name m' = if null name then M.delete w m' else M.insert w name m'
|
||||
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
|
||||
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) m
|
||||
|
||||
-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
|
||||
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
|
||||
|
@ -46,7 +46,7 @@ azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
|
||||
|
||||
belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
|
||||
|
||||
azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $
|
||||
azertyKeysTop topRow conf@XConfig{modMask = modm} = M.fromList $
|
||||
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||
++
|
||||
[((m .|. modm, k), windows $ f i)
|
||||
|
@ -39,9 +39,8 @@ import qualified Data.Map as M
|
||||
|
||||
bepoConfig = def { keys = bepoKeys <+> keys def }
|
||||
|
||||
bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $
|
||||
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||
++
|
||||
[((m .|. modm, k), windows $ f i)
|
||||
bepoKeys conf@XConfig { modMask = modm } = M.fromList $
|
||||
((modm, xK_semicolon), sendMessage (IncMasterN (-1)))
|
||||
: [((m .|. modm, k), windows $ f i)
|
||||
| (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
|
||||
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
||||
|
@ -80,7 +80,7 @@ bluetileWorkspaces :: [String]
|
||||
bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]
|
||||
|
||||
bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||
bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
|
||||
bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
|
||||
-- launching and killing programs
|
||||
[ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
|
||||
, ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog
|
||||
@ -111,14 +111,14 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
|
||||
|
||||
-- floating layer support
|
||||
, ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
|
||||
, ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window
|
||||
, ((modMask' .|. shiftMask, xK_t ), withFocused float ) -- %! Float window
|
||||
|
||||
-- increase or decrease number of windows in the master area
|
||||
, ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
|
||||
, ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
|
||||
|
||||
-- quit, or restart
|
||||
, ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit
|
||||
, ((modMask' .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit
|
||||
, ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart
|
||||
|
||||
-- Metacity-like workspace switching
|
||||
@ -158,19 +158,19 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
|
||||
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||
|
||||
bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
||||
bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $
|
||||
bluetileMouseBindings XConfig{XMonad.modMask = modMask'} = M.fromList
|
||||
-- mod-button1 %! Move a floated window by dragging
|
||||
[ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $
|
||||
focus w >> mouseMoveWindow w >> windows W.shiftMaster))
|
||||
[ ((modMask', button1), \w -> isFloating w >>= \isF -> when isF $
|
||||
focus w >> mouseMoveWindow w >> windows W.shiftMaster)
|
||||
-- mod-button2 %! Switch to next and first layout
|
||||
, ((modMask', button2), (\_ -> sendMessage NextLayout))
|
||||
, ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))
|
||||
, ((modMask', button2), \_ -> sendMessage NextLayout)
|
||||
, ((modMask' .|. shiftMask, button2), \_ -> sendMessage $ JumpToLayout "Floating")
|
||||
-- mod-button3 %! Resize a floated window by dragging
|
||||
, ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $
|
||||
focus w >> mouseResizeWindow w >> windows W.shiftMaster))
|
||||
, ((modMask', button3), \w -> isFloating w >>= \isF -> when isF $
|
||||
focus w >> mouseResizeWindow w >> windows W.shiftMaster)
|
||||
]
|
||||
|
||||
isFloating :: Window -> X (Bool)
|
||||
isFloating :: Window -> X Bool
|
||||
isFloating w = do
|
||||
ws <- gets windowset
|
||||
return $ M.member w (W.floating ws)
|
||||
@ -181,16 +181,15 @@ bluetileManageHook = composeAll
|
||||
, className =? "MPlayer" --> doFloat
|
||||
, isFullscreen --> doFullFloat]
|
||||
|
||||
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
|
||||
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $
|
||||
named "Floating" floating |||
|
||||
named "Tiled1" tiled1 |||
|
||||
named "Tiled2" tiled2 |||
|
||||
named "Fullscreen" fullscreen
|
||||
)
|
||||
where
|
||||
floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat
|
||||
tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored
|
||||
tiled2 = tilingDeco $ maximize $ mouseResizableTile
|
||||
floating = floatingDeco $ maximize $ borderResize positionStoreFloat
|
||||
tiled1 = tilingDeco $ maximize mouseResizableTileMirrored
|
||||
tiled2 = tilingDeco $ maximize mouseResizableTile
|
||||
fullscreen = tilingDeco $ maximize $ smartBorders Full
|
||||
|
||||
tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)
|
||||
|
@ -171,10 +171,10 @@ desktopConfig = docks $ ewmh def
|
||||
, logHook = desktopLogHook <+> logHook def
|
||||
, keys = desktopKeys <+> keys def }
|
||||
|
||||
desktopKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
desktopKeys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_b), sendMessage ToggleStruts) ]
|
||||
|
||||
desktopLayoutModifiers layout = avoidStruts layout
|
||||
desktopLayoutModifiers = avoidStruts
|
||||
|
||||
-- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to
|
||||
-- activated window.
|
||||
|
@ -232,7 +232,7 @@ keyBindings conf = let m = modMask conf in fromList . anyMask $ [
|
||||
((m .|. shiftMask , xK_p ), spawnHere termLauncher),
|
||||
((m .|. shiftMask , xK_c ), kill),
|
||||
((m , xK_q ), restart "xmonad" True),
|
||||
((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)),
|
||||
((m .|. shiftMask , xK_q ), io exitSuccess),
|
||||
((m , xK_grave ), sendMessage NextLayout),
|
||||
((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf),
|
||||
((m , xK_o ), sendMessage Toggle),
|
||||
|
@ -14,7 +14,7 @@ import qualified XMonad (keys)
|
||||
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified Data.Map as M
|
||||
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
|
||||
import System.Exit ( exitSuccess )
|
||||
|
||||
import XMonad.Layout.Tabbed ( tabbed,
|
||||
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
|
||||
@ -77,7 +77,7 @@ keys x = M.fromList $
|
||||
, ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
|
||||
|
||||
-- quit, or restart
|
||||
, ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad
|
||||
, ((modMask x .|. shiftMask, xK_Escape), io exitSuccess) -- %! Quit xmonad
|
||||
, ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
|
||||
|
||||
, ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)
|
||||
|
@ -29,7 +29,7 @@ main = do
|
||||
xmonad $ desktopConfig
|
||||
{ modMask = mod4Mask -- Use the "Win" key for the mod key
|
||||
, manageHook = myManageHook <+> manageHook desktopConfig
|
||||
, layoutHook = desktopLayoutModifiers $ myLayouts
|
||||
, layoutHook = desktopLayoutModifiers myLayouts
|
||||
, logHook = (dynamicLogString def >>= xmonadPropLog)
|
||||
<+> logHook desktopConfig
|
||||
}
|
||||
|
@ -45,7 +45,7 @@ gnomeConfig = desktopConfig
|
||||
, keys = gnomeKeys <+> keys desktopConfig
|
||||
, startupHook = gnomeRegister >> startupHook desktopConfig }
|
||||
|
||||
gnomeKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
gnomeKeys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_p), gnomeRun)
|
||||
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ]
|
||||
|
||||
|
@ -47,12 +47,12 @@ kde4Config = desktopConfig
|
||||
{ terminal = "konsole"
|
||||
, keys = kde4Keys <+> keys desktopConfig }
|
||||
|
||||
kdeKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
kdeKeys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand")
|
||||
, ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
|
||||
]
|
||||
|
||||
kde4Keys (XConfig {modMask = modm}) = M.fromList $
|
||||
kde4Keys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_p), spawn "krunner")
|
||||
, ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")
|
||||
]
|
||||
|
@ -39,7 +39,7 @@ lxqtConfig = desktopConfig
|
||||
{ terminal = "qterminal"
|
||||
, keys = lxqtKeys <+> keys desktopConfig }
|
||||
|
||||
lxqtKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
lxqtKeys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_p), spawn "lxqt-runner")
|
||||
, ((modm .|. shiftMask, xK_q), spawn "lxqt-leave")
|
||||
]
|
||||
|
@ -52,7 +52,7 @@ mateConfig = desktopConfig
|
||||
, keys = mateKeys <+> keys desktopConfig
|
||||
, startupHook = mateRegister >> startupHook desktopConfig }
|
||||
|
||||
mateKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
mateKeys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_p), mateRun)
|
||||
, ((modm, xK_d), unGrab >> matePanel "MAIN_MENU")
|
||||
, ((modm .|. shiftMask, xK_q), mateLogout) ]
|
||||
|
@ -45,5 +45,5 @@ add r x = tell (mkW (r ^: mappend x))
|
||||
--
|
||||
example :: Config ()
|
||||
example = do
|
||||
add layout $ LL [Layout $ Full] -- make this better
|
||||
add layout $ LL [Layout Full] -- make this better
|
||||
set terminal "urxvt"
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -478,7 +478,7 @@ wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++)
|
||||
-- > wsSetName 1 "mail"
|
||||
-- > wsSetName 2 "web"
|
||||
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
|
||||
wsSetName index newName = wsNames =. (map maybeSet . zip [0..])
|
||||
wsSetName index newName = wsNames =. zipWith (curry maybeSet) [0..]
|
||||
where maybeSet (i, oldName) | i == (index - 1) = newName
|
||||
| otherwise = oldName
|
||||
|
||||
@ -497,8 +497,8 @@ withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
|
||||
withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf
|
||||
where sprime :: ScreenConfig -> Prime l l
|
||||
sprime sconf =
|
||||
(keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
|
||||
(mod, action) <- sActions_ sconf])
|
||||
keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
|
||||
(mod, action) <- sActions_ sconf]
|
||||
|
||||
data ScreenConfig = ScreenConfig {
|
||||
sKeys_ :: [String],
|
||||
|
@ -58,7 +58,7 @@ myStartupHook = do
|
||||
spawnOnOnce "emacs" "emacs"
|
||||
spawnNOnOnce 4 "xterms" "xterm"
|
||||
|
||||
myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
|
||||
myLayoutHook = smartBorders $ avoidStruts standardLayouts
|
||||
where standardLayouts = tiled ||| mosaic 2 [3,2] ||| Mirror tiled ||| Full
|
||||
tiled = ResizableTall nmaster delta ratio []
|
||||
nmaster = 1
|
||||
@ -68,7 +68,7 @@ myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
|
||||
myLogHook p = do
|
||||
copies <- wsContainingCopies
|
||||
let check ws | ws == "NSP" = "" -- Hide the scratchpad workspace
|
||||
| ws `elem` copies = xmobarColor "red" "black" $ ws -- Workspaces with copied windows are red on black
|
||||
| ws `elem` copies = xmobarColor "red" "black" ws -- Workspaces with copied windows are red on black
|
||||
| otherwise = ws
|
||||
dynamicLogWithPP $ xmobarPP { ppHidden = check
|
||||
, ppOutput = hPutStrLn p
|
||||
|
@ -24,10 +24,10 @@ sjanssenConfig =
|
||||
docks $ ewmh $ def
|
||||
{ terminal = "exec urxvt"
|
||||
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
|
||||
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
|
||||
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
|
||||
, ((modm, button2), (\w -> focus w >> windows W.swapMaster))
|
||||
, ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
|
||||
, mouseBindings = \XConfig {modMask = modm} -> M.fromList
|
||||
[ ((modm, button1), \w -> focus w >> mouseMoveWindow w)
|
||||
, ((modm, button2), \w -> focus w >> windows W.swapMaster)
|
||||
, ((modm.|. shiftMask, button1), \w -> focus w >> mouseResizeWindow w) ]
|
||||
, keys = \c -> mykeys c `M.union` keys def c
|
||||
, logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
|
||||
, layoutHook = modifiers layouts
|
||||
@ -50,12 +50,12 @@ sjanssenConfig =
|
||||
, "trayer --transparent true --expand true --align right "
|
||||
++ "--edge bottom --widthtype request" ]
|
||||
|
||||
mykeys (XConfig {modMask = modm}) = M.fromList $
|
||||
mykeys XConfig{modMask = modm} = M.fromList
|
||||
[((modm, xK_p ), shellPromptHere myPromptConfig)
|
||||
,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))
|
||||
,((modm .|. shiftMask, xK_c ), kill1)
|
||||
,((modm .|. shiftMask .|. controlMask, xK_c ), kill)
|
||||
,((modm .|. shiftMask, xK_0 ), windows $ copyToAll)
|
||||
,((modm .|. shiftMask, xK_0 ), windows copyToAll)
|
||||
,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5)
|
||||
,((modm .|. shiftMask, xK_z ), rescreen)
|
||||
, ((modm , xK_b ), sendMessage ToggleStruts)
|
||||
|
@ -39,7 +39,7 @@ xfceConfig = desktopConfig
|
||||
{ terminal = "xfce4-terminal"
|
||||
, keys = xfceKeys <+> keys desktopConfig }
|
||||
|
||||
xfceKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
xfceKeys XConfig{modMask = modm} = M.fromList
|
||||
[ ((modm, xK_p), spawn "xfrun4")
|
||||
, ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")
|
||||
, ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")
|
||||
|
@ -25,7 +25,7 @@ module XMonad.Hooks.CurrentWorkspaceOnTop (
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as S
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Prelude(when)
|
||||
import XMonad.Prelude (unless, when)
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- $usage
|
||||
@ -40,7 +40,7 @@ import qualified Data.Map as M
|
||||
-- > }
|
||||
--
|
||||
|
||||
data CWOTState = CWOTS String deriving Typeable
|
||||
newtype CWOTState = CWOTS String deriving Typeable
|
||||
|
||||
instance ExtensionClass CWOTState where
|
||||
initialValue = CWOTS ""
|
||||
@ -55,15 +55,15 @@ currentWorkspaceOnTop = withDisplay $ \d -> do
|
||||
let s = S.current ws
|
||||
wsp = S.workspace s
|
||||
viewrect = screenRect $ S.screenDetail s
|
||||
tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)
|
||||
tmpStack = S.stack wsp >>= S.filter (`M.notMember` S.floating ws)
|
||||
(rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect
|
||||
updateLayout curTag ml'
|
||||
let this = S.view curTag ws
|
||||
fltWins = filter (flip M.member (S.floating ws)) $ S.index this
|
||||
wins = fltWins ++ (map fst rs) -- order: first all floating windows, then the order the layout returned
|
||||
fltWins = filter (`M.member` S.floating ws) $ S.index this
|
||||
wins = fltWins ++ map fst rs -- order: first all floating windows, then the order the layout returned
|
||||
-- end of reimplementation
|
||||
|
||||
when (not . null $ wins) $ do
|
||||
unless (null wins) $ do
|
||||
io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top,
|
||||
io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow
|
||||
XS.put(CWOTS curTag)
|
||||
|
@ -51,7 +51,7 @@ debugEventsHook e = debugEventsHook' e >> return (All True)
|
||||
-- | Dump an X11 event. Can't be used directly as a 'handleEventHook'.
|
||||
debugEventsHook' :: Event -> X ()
|
||||
|
||||
debugEventsHook' (ConfigureRequestEvent {ev_window = w
|
||||
debugEventsHook' ConfigureRequestEvent{ev_window = w
|
||||
,ev_parent = p
|
||||
,ev_x = x
|
||||
,ev_y = y
|
||||
@ -61,7 +61,7 @@ debugEventsHook' (ConfigureRequestEvent {ev_window = w
|
||||
,ev_above = above
|
||||
,ev_detail = place
|
||||
,ev_value_mask = msk
|
||||
}) = do
|
||||
} = do
|
||||
windowEvent "ConfigureRequest" w
|
||||
windowEvent " parent" p
|
||||
-- mask <- quickFormat msk $ dumpBits wmCRMask
|
||||
@ -84,45 +84,45 @@ debugEventsHook' (ConfigureRequestEvent {ev_window = w
|
||||
]
|
||||
say " requested" s
|
||||
|
||||
debugEventsHook' (ConfigureEvent {ev_window = w
|
||||
debugEventsHook' ConfigureEvent {ev_window = w
|
||||
,ev_above = above
|
||||
}) = do
|
||||
} = do
|
||||
windowEvent "Configure" w
|
||||
-- most of the content is covered by debugWindow
|
||||
when (above /= none) $ debugWindow above >>= say " above"
|
||||
|
||||
debugEventsHook' (MapRequestEvent {ev_window = w
|
||||
debugEventsHook' MapRequestEvent {ev_window = w
|
||||
,ev_parent = p
|
||||
}) =
|
||||
} =
|
||||
windowEvent "MapRequest" w >>
|
||||
windowEvent " parent" p
|
||||
|
||||
debugEventsHook' e@(KeyEvent {ev_event_type = t})
|
||||
debugEventsHook' e@KeyEvent {ev_event_type = t}
|
||||
| t == keyPress =
|
||||
io (hPutStr stderr "KeyPress ") >>
|
||||
debugKeyEvents e >>
|
||||
return ()
|
||||
|
||||
debugEventsHook' (ButtonEvent {ev_window = w
|
||||
debugEventsHook' ButtonEvent {ev_window = w
|
||||
,ev_state = s
|
||||
,ev_button = b
|
||||
}) = do
|
||||
} = do
|
||||
windowEvent "Button" w
|
||||
nl <- gets numberlockMask
|
||||
let msk | s == 0 = ""
|
||||
| otherwise = "modifiers " ++ vmask nl s
|
||||
say " button" $ show b ++ msk
|
||||
|
||||
debugEventsHook' (DestroyWindowEvent {ev_window = w
|
||||
}) =
|
||||
debugEventsHook' DestroyWindowEvent {ev_window = w
|
||||
} =
|
||||
windowEvent "DestroyWindow" w
|
||||
|
||||
debugEventsHook' (UnmapEvent {ev_window = w
|
||||
}) =
|
||||
debugEventsHook' UnmapEvent {ev_window = w
|
||||
} =
|
||||
windowEvent "Unmap" w
|
||||
|
||||
debugEventsHook' (MapNotifyEvent {ev_window = w
|
||||
}) =
|
||||
debugEventsHook' MapNotifyEvent {ev_window = w
|
||||
} =
|
||||
windowEvent "MapNotify" w
|
||||
|
||||
{- way too much output; suppressed.
|
||||
@ -133,26 +133,24 @@ debugEventsHook' (CrossingEvent {ev_window = w
|
||||
windowEvent "Crossing" w >>
|
||||
windowEvent " subwindow" s
|
||||
-}
|
||||
debugEventsHook' (CrossingEvent {}) =
|
||||
debugEventsHook' CrossingEvent {} =
|
||||
return ()
|
||||
|
||||
debugEventsHook' (SelectionRequest {ev_requestor = rw
|
||||
debugEventsHook' SelectionRequest {ev_requestor = rw
|
||||
,ev_owner = ow
|
||||
,ev_selection = a
|
||||
}) =
|
||||
} =
|
||||
windowEvent "SelectionRequest" rw >>
|
||||
windowEvent " owner" ow >>
|
||||
atomEvent " atom" a
|
||||
|
||||
debugEventsHook' (PropertyEvent {ev_window = w
|
||||
debugEventsHook' PropertyEvent {ev_window = w
|
||||
,ev_atom = a
|
||||
,ev_propstate = s
|
||||
}) = do
|
||||
} = do
|
||||
a' <- atomName a
|
||||
-- too many of these, and they're not real useful
|
||||
if a' `elem` ["_NET_WM_USER_TIME"
|
||||
-- ,"_NET_WM_WINDOW_OPACITY"
|
||||
] then return () else do
|
||||
if a' == "_NET_WM_USER_TIME" then return () else do
|
||||
windowEvent "Property on" w
|
||||
s' <- case s of
|
||||
1 -> return "deleted"
|
||||
@ -160,11 +158,11 @@ debugEventsHook' (PropertyEvent {ev_window = w
|
||||
_ -> error "Illegal propState; Xlib corrupted?"
|
||||
say " atom" $ a' ++ s'
|
||||
|
||||
debugEventsHook' (ExposeEvent {ev_window = w
|
||||
}) =
|
||||
debugEventsHook' ExposeEvent {ev_window = w
|
||||
} =
|
||||
windowEvent "Expose" w
|
||||
|
||||
debugEventsHook' (ClientMessageEvent {ev_window = w
|
||||
debugEventsHook' ClientMessageEvent {ev_window = w
|
||||
,ev_message_type = a
|
||||
-- @@@ they did it again! no ev_format,
|
||||
-- and ev_data is [CInt]
|
||||
@ -172,7 +170,7 @@ debugEventsHook' (ClientMessageEvent {ev_window = w
|
||||
-- that is setClientMessageEvent!
|
||||
-- ,ev_format = b
|
||||
,ev_data = vs'
|
||||
}) = do
|
||||
} = do
|
||||
windowEvent "ClientMessage on" w
|
||||
n <- atomName a
|
||||
-- this is a sort of custom property
|
||||
@ -219,12 +217,6 @@ clientMessages = [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1))
|
||||
,("WM_SAVE_YOURSELF" ,("STRING" , 8,0))
|
||||
]
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 707
|
||||
finiteBitSize :: Bits a => a -> Int
|
||||
finiteBitSize x = bitSize x
|
||||
#endif
|
||||
|
||||
|
||||
-- | Convert a modifier mask into a useful string
|
||||
vmask :: KeyMask -> KeyMask -> String
|
||||
vmask numLockMask msk = unwords $
|
||||
@ -604,7 +596,7 @@ dumpArray item = do
|
||||
dumpArray' :: Decoder Bool -> String -> Decoder Bool
|
||||
dumpArray' item pfx = do
|
||||
vs <- gets value
|
||||
if vs == []
|
||||
if null vs
|
||||
then append "]"
|
||||
else append pfx >> whenD item (dumpArray' item ",")
|
||||
|
||||
@ -713,7 +705,7 @@ dumpString = do
|
||||
go [] _ = append "]"
|
||||
in append "[" >> go ss' ""
|
||||
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
|
||||
| otherwise -> (inX $ atomName fmt) >>=
|
||||
| otherwise -> inX (atomName fmt) >>=
|
||||
failure . ("unrecognized string type " ++)
|
||||
|
||||
-- show who owns a selection
|
||||
@ -744,7 +736,7 @@ dumpXKlInds = guardType iNTEGER $ do
|
||||
| n .&. bt /= 0 = dumpInds (n .&. complement bt)
|
||||
(bt `shiftL` 1)
|
||||
(c + 1)
|
||||
((show c):bs)
|
||||
(show c:bs)
|
||||
| otherwise = dumpInds n
|
||||
(bt `shiftL` 1)
|
||||
(c + 1)
|
||||
@ -1189,7 +1181,7 @@ inhale b = error $ "inhale " ++ show b
|
||||
|
||||
eat :: Int -> Decoder Raw
|
||||
eat n = do
|
||||
(bs,rest) <- splitAt n <$> gets value
|
||||
(bs,rest) <- gets (splitAt n . value)
|
||||
modify (\r -> r {value = rest})
|
||||
return bs
|
||||
|
||||
|
@ -56,13 +56,13 @@ import System.IO (hPutStrLn
|
||||
|
||||
-- | Print key events to stderr for debugging
|
||||
debugKeyEvents :: Event -> X All
|
||||
debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
|
||||
debugKeyEvents KeyEvent{ev_event_type = t, ev_state = m, ev_keycode = code}
|
||||
| t == keyPress =
|
||||
withDisplay $ \dpy -> do
|
||||
sym <- io $ keycodeToKeysym dpy code 0
|
||||
msk <- cleanMask m
|
||||
nl <- gets numberlockMask
|
||||
io $ hPutStrLn stderr $ intercalate " " ["keycode"
|
||||
io $ hPutStrLn stderr $ unwords ["keycode"
|
||||
,show code
|
||||
,"sym"
|
||||
,show sym
|
||||
@ -86,7 +86,7 @@ hex v = "0x" ++ showHex v ""
|
||||
|
||||
-- | Convert a modifier mask into a useful string
|
||||
vmask :: KeyMask -> KeyMask -> String
|
||||
vmask numLockMask msk = intercalate " " $
|
||||
vmask numLockMask msk = unwords $
|
||||
reverse $
|
||||
fst $
|
||||
foldr vmask' ([],msk) masks
|
||||
|
@ -79,7 +79,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
-- is called when the number of screens changes and on startup.
|
||||
--
|
||||
|
||||
data DynStatusBarInfo = DynStatusBarInfo
|
||||
newtype DynStatusBarInfo = DynStatusBarInfo
|
||||
{ dsbInfo :: [(ScreenId, Handle)]
|
||||
} deriving (Typeable)
|
||||
|
||||
@ -113,12 +113,12 @@ dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup ->
|
||||
dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup)
|
||||
|
||||
dynStatusBarRun :: X () -> Event -> X All
|
||||
dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True)
|
||||
dynStatusBarRun action RRScreenChangeNotifyEvent{} = action >> return (All True)
|
||||
dynStatusBarRun _ _ = return (All True)
|
||||
|
||||
updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
|
||||
updateStatusBars sb cleanup = do
|
||||
(dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
|
||||
(dsbInfoScreens, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo
|
||||
screens <- getScreens
|
||||
when (screens /= dsbInfoScreens) $ do
|
||||
newHandles <- liftIO $ do
|
||||
@ -129,14 +129,14 @@ updateStatusBars sb cleanup = do
|
||||
|
||||
updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
|
||||
updateStatusBars' sb cleanup = do
|
||||
(dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
|
||||
(dsbInfoScreens, dsbInfoHandles) <- XS.get <&> (unzip . dsbInfo)
|
||||
screens <- getScreens
|
||||
when (screens /= dsbInfoScreens) $ do
|
||||
let oldInfo = zip dsbInfoScreens dsbInfoHandles
|
||||
let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
|
||||
newInfo <- liftIO $ do
|
||||
mapM_ hClose $ map snd infoToClose
|
||||
mapM_ cleanup $ map fst infoToClose
|
||||
mapM_ (hClose . snd) infoToClose
|
||||
mapM_ (cleanup . fst) infoToClose
|
||||
let newScreens = screens \\ dsbInfoScreens
|
||||
newHandles <- mapM sb newScreens
|
||||
return $ zip newScreens newHandles
|
||||
@ -153,7 +153,7 @@ multiPP = multiPPFormat dynamicLogString
|
||||
|
||||
multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
|
||||
multiPPFormat dynlStr focusPP unfocusPP = do
|
||||
(_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
|
||||
(_, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo
|
||||
multiPP' dynlStr focusPP unfocusPP dsbInfoHandles
|
||||
|
||||
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
|
||||
|
@ -59,16 +59,16 @@ instance ExtensionClass DynamicHooks where
|
||||
-- doFloat and doIgnore are idempotent.
|
||||
-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
|
||||
dynamicMasterHook :: ManageHook
|
||||
dynamicMasterHook = (ask >>= \w -> liftX (do
|
||||
dynamicMasterHook = ask >>= \w -> liftX $ do
|
||||
dh <- XS.get
|
||||
(Endo f) <- runQuery (permanent dh) w
|
||||
ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)
|
||||
let (ts',nts) = partition fst ts
|
||||
gs <- mapM (flip runQuery w . snd . snd) ts'
|
||||
let (Endo g) = maybe (Endo id) id $ listToMaybe gs
|
||||
let (Endo g) = fromMaybe (Endo id) $ listToMaybe gs
|
||||
XS.put $ dh { transients = map snd nts }
|
||||
return $ Endo $ f . g
|
||||
))
|
||||
|
||||
-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
|
||||
addDynamicHook :: ManageHook -> X ()
|
||||
addDynamicHook m = updateDynamicHook (<+> m)
|
||||
@ -87,4 +87,4 @@ updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) }
|
||||
-- > oneShotHook dynHooksRef (className =? "example) doFloat
|
||||
--
|
||||
oneShotHook :: Query Bool -> ManageHook -> X ()
|
||||
oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }
|
||||
oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):transients dh }
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.DynamicIcons
|
||||
|
@ -178,7 +178,7 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do
|
||||
|
||||
-- Remap the current workspace to handle any renames that f might be doing.
|
||||
let maybeCurrent' = W.tag <$> listToMaybe (t [W.workspace $ W.current s])
|
||||
current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
|
||||
current = flip elemIndex (map W.tag ws) =<< maybeCurrent'
|
||||
whenChanged (CurrentDesktop $ fromMaybe 0 current) $
|
||||
mapM_ setCurrentDesktop current
|
||||
|
||||
@ -392,7 +392,7 @@ addSupported props = withDisplay $ \dpy -> do
|
||||
a <- getAtom "_NET_SUPPORTED"
|
||||
newSupportedList <- mapM (fmap fromIntegral . getAtom) props
|
||||
io $ do
|
||||
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy a r
|
||||
supportedList <- join . maybeToList <$> getWindowProperty32 dpy a r
|
||||
changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList)
|
||||
|
||||
setFullscreenSupported :: X ()
|
||||
|
@ -91,7 +91,7 @@ fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS
|
||||
|
||||
-- | Returns True if the window doesn't have the focus.
|
||||
isUnfocused :: Query Bool
|
||||
isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset
|
||||
isUnfocused = ask >>= \w -> liftX . gets $ (Just w /=) . W.peek . windowset
|
||||
|
||||
-- | Returns True if the window doesn't have the focus, and the window is on the
|
||||
-- current workspace. This is specifically handy in a multi monitor setup
|
||||
@ -103,7 +103,7 @@ isUnfocusedOnCurrentWS = do
|
||||
w <- ask
|
||||
ws <- liftX $ gets windowset
|
||||
let thisWS = w `elem` W.index ws
|
||||
unfocused = maybe True (w /=) $ W.peek ws
|
||||
unfocused = Just w /= W.peek ws
|
||||
return $ thisWS && unfocused
|
||||
|
||||
-- | Fades out every window by the amount returned by the query.
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.FadeWindows
|
||||
@ -220,7 +220,7 @@ fadeWindowsLogHook h = withWindowSet $ \s -> do
|
||||
-- "XMonad.Layout.Full" or "XMonad.Layout.Tabbed". This hook may
|
||||
-- also be useful with "XMonad.Hooks.FadeInactive".
|
||||
fadeWindowsEventHook :: Event -> X All
|
||||
fadeWindowsEventHook (MapNotifyEvent {}) =
|
||||
fadeWindowsEventHook MapNotifyEvent{} =
|
||||
-- we need to run the fadeWindowsLogHook. only one way...
|
||||
asks config >>= logHook >> return (All True)
|
||||
fadeWindowsEventHook _ = return (All True)
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.FloatNext
|
||||
|
@ -441,7 +441,7 @@ focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m
|
||||
|
||||
-- | Does new window appear at particular workspace?
|
||||
newOn :: WorkspaceId -> FocusQuery Bool
|
||||
newOn i = (i ==) <$> asks newWorkspace
|
||||
newOn i = asks ((i ==) . newWorkspace)
|
||||
-- | Does new window appear at current workspace?
|
||||
newOnCur :: FocusQuery Bool
|
||||
newOnCur = asks currentWorkspace >>= newOn
|
||||
|
@ -38,5 +38,5 @@ takeFocusX _w = return ()
|
||||
takeTopFocus ::
|
||||
X ()
|
||||
takeTopFocus =
|
||||
(withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"
|
||||
withWindowSet (maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"
|
||||
|
||||
|
@ -21,7 +21,7 @@ module XMonad.Hooks.InsertPosition (
|
||||
) where
|
||||
|
||||
import XMonad(ManageHook, MonadReader(ask))
|
||||
import XMonad.Prelude (Endo (Endo), find, fromMaybe)
|
||||
import XMonad.Prelude (Endo (Endo), find)
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
-- $usage
|
||||
@ -44,7 +44,7 @@ insertPosition :: Position -> Focus -> ManageHook
|
||||
insertPosition pos foc = Endo . g <$> ask
|
||||
where
|
||||
g w = viewingWs w (updateFocus w . ins w . W.delete' w)
|
||||
ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $
|
||||
ins w = (\f ws -> maybe id W.focusWindow (W.peek ws) $ f ws) $
|
||||
case pos of
|
||||
Master -> W.insertUp w . W.focusMaster
|
||||
End -> insertDown w . W.modify' focusLast'
|
||||
|
@ -36,7 +36,7 @@ import XMonad.Util.EZConfig
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
-- persistent state for manageHook debugging to trigger logHook debugging
|
||||
data ManageStackDebug = MSD (Bool,Bool) deriving Typeable
|
||||
newtype ManageStackDebug = MSD (Bool,Bool) deriving Typeable
|
||||
instance ExtensionClass ManageStackDebug where
|
||||
initialValue = MSD (False,False)
|
||||
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ManageDocks
|
||||
@ -152,30 +151,30 @@ checkDock = ask >>= \w -> liftX $ do
|
||||
desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
|
||||
mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
|
||||
case mbr of
|
||||
Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)
|
||||
Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs
|
||||
_ -> return False
|
||||
|
||||
-- | Whenever a new dock appears, refresh the layout immediately to avoid the
|
||||
-- new dock.
|
||||
docksEventHook :: Event -> X All
|
||||
docksEventHook (MapNotifyEvent { ev_window = w }) = do
|
||||
docksEventHook MapNotifyEvent{ ev_window = w } = do
|
||||
whenX (runQuery checkDock w <&&> (not <$> isClient w)) $
|
||||
whenX (updateStrutCache w) refreshDocks
|
||||
return (All True)
|
||||
docksEventHook (PropertyEvent { ev_window = w
|
||||
, ev_atom = a }) = do
|
||||
docksEventHook PropertyEvent{ ev_window = w
|
||||
, ev_atom = a } = do
|
||||
nws <- getAtom "_NET_WM_STRUT"
|
||||
nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
|
||||
when (a == nws || a == nwsp) $
|
||||
whenX (updateStrutCache w) refreshDocks
|
||||
return (All True)
|
||||
docksEventHook (DestroyWindowEvent {ev_window = w}) = do
|
||||
docksEventHook DestroyWindowEvent{ ev_window = w } = do
|
||||
whenX (deleteFromStrutCache w) refreshDocks
|
||||
return (All True)
|
||||
docksEventHook _ = return (All True)
|
||||
|
||||
docksStartupHook :: X ()
|
||||
docksStartupHook = void $ getStrutCache
|
||||
docksStartupHook = void getStrutCache
|
||||
|
||||
-- | Gets the STRUT config, if present, in xmonad gap order
|
||||
getStrut :: Window -> X [Strut]
|
||||
@ -222,7 +221,7 @@ avoidStrutsOn :: LayoutClass l a =>
|
||||
-> ModifiedLayout AvoidStruts l a
|
||||
avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss)
|
||||
|
||||
data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
|
||||
newtype AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
|
||||
|
||||
-- | Message type which can be sent to an 'AvoidStruts' layout
|
||||
-- modifier to alter its behavior.
|
||||
|
@ -85,9 +85,7 @@ composeOne = foldr try (return mempty)
|
||||
where
|
||||
try q z = do
|
||||
x <- q
|
||||
case x of
|
||||
Just h -> return h
|
||||
Nothing -> z
|
||||
maybe z return x
|
||||
|
||||
infixr 0 -?>, -->>, -?>>
|
||||
|
||||
@ -119,7 +117,7 @@ p -?> f = do
|
||||
(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b
|
||||
p -->> f = do
|
||||
Match b m <- p
|
||||
if b then (f m) else return mempty
|
||||
if b then f m else return mempty
|
||||
|
||||
-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
|
||||
(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b)
|
||||
@ -166,7 +164,7 @@ isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
|
||||
--
|
||||
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm45623487788432>.
|
||||
pid :: Query (Maybe ProcessID)
|
||||
pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w >>= pure . \case
|
||||
pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w <&> \case
|
||||
Just [x] -> Just (fromIntegral x)
|
||||
_ -> Nothing
|
||||
|
||||
@ -196,7 +194,7 @@ transience' = maybeToDefinite transience
|
||||
--
|
||||
-- See <https://tronche.com/gui/x/icccm/sec-5.html>.
|
||||
clientLeader :: Query (Maybe Window)
|
||||
clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w >>= pure . \case
|
||||
clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w <&> \case
|
||||
Just [x] -> Just (fromIntegral x)
|
||||
_ -> Nothing
|
||||
|
||||
@ -256,12 +254,14 @@ doSideFloat :: Side -> ManageHook
|
||||
doSideFloat side = doFloatDep move
|
||||
where
|
||||
move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h
|
||||
where cx = if side `elem` [SC,C ,NC] then (1-w)/2
|
||||
else if side `elem` [SW,CW,NW] then 0
|
||||
else {- side `elem` [SE,CE,NE] -} 1-w
|
||||
cy = if side `elem` [CE,C ,CW] then (1-h)/2
|
||||
else if side `elem` [NE,NC,NW] then 0
|
||||
else {- side `elem` [SE,SC,SW] -} 1-h
|
||||
where cx
|
||||
| side `elem` [SC,C ,NC] = (1-w)/2
|
||||
| side `elem` [SW,CW,NW] = 0
|
||||
| otherwise = {- side `elem` [SE,CE,NE] -} 1-w
|
||||
cy
|
||||
| side `elem` [CE,C ,CW] = (1-h)/2
|
||||
| side `elem` [NE,NC,NW] = 0
|
||||
| otherwise = {- side `elem` [SE,SC,SW] -} 1-h
|
||||
|
||||
-- | Floats a new window with its original size, but centered.
|
||||
doCenterFloat :: ManageHook
|
||||
|
@ -35,9 +35,9 @@ import XMonad.Prelude
|
||||
-- > , handleEventHook = myHandleEventHook }
|
||||
|
||||
minimizeEventHook :: Event -> X All
|
||||
minimizeEventHook (ClientMessageEvent {ev_window = w,
|
||||
minimizeEventHook ClientMessageEvent{ev_window = w,
|
||||
ev_message_type = mt,
|
||||
ev_data = dt}) = do
|
||||
ev_data = dt} = do
|
||||
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
|
||||
a_cs <- getAtom "WM_CHANGE_STATE"
|
||||
|
||||
|
@ -162,16 +162,16 @@ placeFocused p = withFocused $ \window -> do
|
||||
|
||||
-- use X.A.FloatKeys if the window is floating, send
|
||||
-- a WindowArranger message otherwise.
|
||||
case elem window floats of
|
||||
True -> keysMoveWindowTo (x', y') (0, 0) window
|
||||
False -> sendMessage $ SetGeometry r'
|
||||
if window `elem` floats
|
||||
then keysMoveWindowTo (x', y') (0, 0) window
|
||||
else sendMessage $ SetGeometry r'
|
||||
|
||||
|
||||
-- | Hook to automatically place windows when they are created.
|
||||
placeHook :: Placement -> ManageHook
|
||||
placeHook p = do window <- ask
|
||||
r <- Query $ lift $ getWindowRectangle window
|
||||
allRs <- Query $ lift $ getAllRectangles
|
||||
allRs <- Query $ lift getAllRectangles
|
||||
pointer <- Query $ lift $ getPointer window
|
||||
|
||||
return $ Endo $ \theWS -> fromMaybe theWS $
|
||||
@ -186,13 +186,13 @@ placeHook p = do window <- ask
|
||||
-- workspace's screen.
|
||||
let infos = filter ((window `elem`) . stackContents . S.stack . fst)
|
||||
$ [screenInfo $ S.current theWS]
|
||||
++ (map screenInfo $ S.visible theWS)
|
||||
++ map screenInfo (S.visible theWS)
|
||||
++ zip (S.hidden theWS) (repeat currentRect)
|
||||
|
||||
guard(not $ null infos)
|
||||
|
||||
let (workspace, screen) = head infos
|
||||
rs = catMaybes $ map (flip M.lookup allRs)
|
||||
rs = mapMaybe (`M.lookup` allRs)
|
||||
$ organizeClients workspace window floats
|
||||
r' = purePlaceWindow p screen rs pointer r
|
||||
newRect = r2rr screen r'
|
||||
@ -221,7 +221,7 @@ purePlaceWindow :: Placement -- ^ The placement strategy
|
||||
-> Rectangle -- ^ The window to be placed
|
||||
-> Rectangle
|
||||
purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w
|
||||
= let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b))
|
||||
= let s' = Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)
|
||||
in checkBounds s' $ purePlaceWindow p' s' rs p w
|
||||
|
||||
purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w
|
||||
@ -275,7 +275,7 @@ stackContents :: Maybe (S.Stack w) -> [w]
|
||||
stackContents = maybe [] S.integrate
|
||||
|
||||
screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)
|
||||
screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s)
|
||||
screenInfo S.Screen{ S.workspace = ws, S.screenDetail = (SD s)} = (ws, s)
|
||||
|
||||
getWindowRectangle :: Window -> X Rectangle
|
||||
getWindowRectangle window
|
||||
@ -325,8 +325,7 @@ getNecessaryData :: Window
|
||||
getNecessaryData window ws floats
|
||||
= do r <- getWindowRectangle window
|
||||
|
||||
rs <- return (organizeClients ws window floats)
|
||||
>>= mapM getWindowRectangle
|
||||
rs <- mapM getWindowRectangle (organizeClients ws window floats)
|
||||
|
||||
pointer <- getPointer window
|
||||
|
||||
|
@ -92,12 +92,12 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do
|
||||
(Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)
|
||||
(fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )
|
||||
where
|
||||
randomIntOffset :: X (Int)
|
||||
randomIntOffset :: X Int
|
||||
randomIntOffset = io $ randomRIO (42, 242)
|
||||
|
||||
positionStoreEventHook :: Event -> X All
|
||||
positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do
|
||||
positionStoreEventHook DestroyWindowEvent{ev_window = w, ev_event_type = et} = do
|
||||
when (et == destroyNotify) $
|
||||
modifyPosStore (\ps -> posStoreRemove ps w)
|
||||
modifyPosStore (`posStoreRemove` w)
|
||||
return (All True)
|
||||
positionStoreEventHook _ = return (All True)
|
||||
|
@ -281,8 +281,9 @@ getRecentsMap = XS.get >>= \(RecentsMap m) -> return m
|
||||
-- | Perform an X action dependent on successful lookup of the RecentWins for
|
||||
-- the specified workspace, or return a default value.
|
||||
withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a
|
||||
withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap
|
||||
>>= maybe (return dflt) (\(Recent lw cw) -> f lw cw)
|
||||
withRecentsIn tag dflt f = maybe (return dflt) (\(Recent lw cw) -> f lw cw)
|
||||
. M.lookup tag
|
||||
=<< getRecentsMap
|
||||
|
||||
-- | The above specialised to the current workspace and unit.
|
||||
withRecents :: (Window -> Window -> X ()) -> X ()
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ScreenCorners
|
||||
@ -63,13 +63,13 @@ addScreenCorner corner xF = do
|
||||
(win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
|
||||
|
||||
Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
|
||||
Nothing -> flip (,) xF <$> createWindowAt corner
|
||||
Nothing -> (, xF) <$> createWindowAt corner
|
||||
|
||||
XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
|
||||
|
||||
-- | Add a list of @(ScreenCorner, X ())@ tuples
|
||||
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
|
||||
addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)
|
||||
addScreenCorners = mapM_ (uncurry addScreenCorner)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -55,12 +55,12 @@ serverModeEventHook = serverModeEventHook' defaultCommands
|
||||
-- | serverModeEventHook' additionally takes an action to generate the list of
|
||||
-- commands.
|
||||
serverModeEventHook' :: X [(String,X ())] -> Event -> X All
|
||||
serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
|
||||
serverModeEventHook' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words)
|
||||
where helper cmd = do cl <- cmdAction
|
||||
case lookup cmd (zip (map show [1 :: Integer ..]) cl) of
|
||||
Just (_,action) -> action
|
||||
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
|
||||
listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl
|
||||
listOfCommands cl = zipWith (++) (map show [1 :: Int ..]) (map ((++) " - " . fst) cl)
|
||||
|
||||
|
||||
-- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
|
||||
@ -75,7 +75,7 @@ serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands
|
||||
|
||||
-- | Additionally takes an action to generate the list of commands
|
||||
serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
|
||||
serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
|
||||
serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words)
|
||||
where helper cmd = do cl <- cmdAction
|
||||
fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl)
|
||||
|
||||
@ -87,7 +87,7 @@ serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (se
|
||||
-- > xmonadctl -a XMONAD_PRINT "hello world"
|
||||
--
|
||||
serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
|
||||
serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
|
||||
serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do
|
||||
d <- asks display
|
||||
atm <- io $ internAtom d key False
|
||||
when (mt == atm && dt /= []) $ do
|
||||
@ -95,6 +95,6 @@ serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data
|
||||
cmd <- io $ getAtomName d atom
|
||||
case cmd of
|
||||
Just command -> func command
|
||||
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))
|
||||
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)
|
||||
return (All True)
|
||||
serverModeEventHookF _ _ _ = return (All True)
|
||||
|
@ -62,7 +62,7 @@ _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
|
||||
|
||||
{- The current state is kept here -}
|
||||
|
||||
data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
|
||||
newtype HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass HookState where
|
||||
initialValue = HookState empty
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,
|
||||
FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -196,7 +195,7 @@ import Foreign.C.Types (CLong)
|
||||
-- instead.
|
||||
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
|
||||
h -> XConfig l -> XConfig l
|
||||
withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
|
||||
withUrgencyHook hook = withUrgencyHookC hook urgencyConfig
|
||||
|
||||
-- | This lets you modify the defaults set in 'urgencyConfig'. An example:
|
||||
--
|
||||
@ -211,7 +210,7 @@ withUrgencyHookC hook urgConf conf = conf {
|
||||
startupHook = cleanupStaleUrgents >> startupHook conf
|
||||
}
|
||||
|
||||
data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
|
||||
newtype Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
|
||||
|
||||
onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents
|
||||
onUrgents f = Urgents . f . fromUrgents
|
||||
@ -283,7 +282,7 @@ withUrgents f = readUrgents >>= f
|
||||
cleanupStaleUrgents :: X ()
|
||||
cleanupStaleUrgents = withWindowSet $ \ws -> do
|
||||
adjustUrgents (filter (`W.member` ws))
|
||||
adjustReminders (filter $ ((`W.member` ws) . window))
|
||||
adjustReminders (filter ((`W.member` ws) . window))
|
||||
|
||||
adjustUrgents :: ([Window] -> [Window]) -> X ()
|
||||
adjustUrgents = XS.modify . onUrgents
|
||||
@ -324,7 +323,7 @@ changeNetWMState dpy w f = do
|
||||
|
||||
-- | Add an atom to the _NET_WM_STATE property.
|
||||
addNetWMState :: Display -> Window -> Atom -> X ()
|
||||
addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):)
|
||||
addNetWMState dpy w atom = changeNetWMState dpy w (fromIntegral atom :)
|
||||
|
||||
-- | Remove an atom from the _NET_WM_STATE property.
|
||||
removeNetWMState :: Display -> Window -> Atom -> X ()
|
||||
@ -356,7 +355,7 @@ handleEvent wuh event =
|
||||
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } ->
|
||||
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
|
||||
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
|
||||
if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w
|
||||
if testBit flags urgencyHintBit then markUrgent w else markNotUrgent w
|
||||
-- Window destroyed
|
||||
DestroyWindowEvent {ev_window = w} ->
|
||||
markNotUrgent w
|
||||
@ -380,7 +379,7 @@ handleEvent wuh event =
|
||||
mapM_ handleReminder =<< readReminders
|
||||
where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
|
||||
markUrgent w = do
|
||||
adjustUrgents (\ws -> if elem w ws then ws else w : ws)
|
||||
adjustUrgents (\ws -> if w `elem` ws then ws else w : ws)
|
||||
callUrgencyHook wuh w
|
||||
userCodeDef () =<< asks (logHook . config)
|
||||
markNotUrgent w = do
|
||||
@ -423,9 +422,9 @@ cleanupUrgents sw = clearUrgents' =<< suppressibleWindows sw
|
||||
clearUrgents' :: [Window] -> X ()
|
||||
clearUrgents' ws = do
|
||||
a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
|
||||
dpy <- withDisplay (\dpy -> return dpy)
|
||||
dpy <- withDisplay return
|
||||
mapM_ (\w -> removeNetWMState dpy w a_da) ws
|
||||
adjustUrgents (\\ ws) >> adjustReminders (filter $ ((`notElem` ws) . window))
|
||||
adjustUrgents (\\ ws) >> adjustReminders (filter ((`notElem` ws) . window))
|
||||
|
||||
suppressibleWindows :: SuppressWhen -> X [Window]
|
||||
suppressibleWindows Visible = gets $ S.toList . mapped
|
||||
@ -491,7 +490,7 @@ instance UrgencyHook FocusHook where
|
||||
|
||||
borderUrgencyHook :: String -> Window -> X ()
|
||||
borderUrgencyHook = urgencyHook . BorderUrgencyHook
|
||||
data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
|
||||
newtype BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: String }
|
||||
deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook BorderUrgencyHook where
|
||||
|
@ -35,7 +35,6 @@ import System.FilePath ((</>))
|
||||
import System.Random (randomRIO)
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Ord (comparing)
|
||||
|
||||
-- $usage
|
||||
-- This module requires imagemagick and feh to be installed, as these are utilized
|
||||
@ -176,7 +175,7 @@ completeWPConf (WallpaperConf dir (WallpaperList ws)) = do
|
||||
getVisibleWorkspaces :: X [WorkspaceId]
|
||||
getVisibleWorkspaces = do
|
||||
winset <- gets windowset
|
||||
return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset
|
||||
return $ map (S.tag . S.workspace) . sortOn S.screen $ S.current winset : S.visible winset
|
||||
|
||||
getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)]
|
||||
getPicPathsAndWSRects wpconf = do
|
||||
@ -185,7 +184,7 @@ getPicPathsAndWSRects wpconf = do
|
||||
visws <- getVisibleWorkspaces
|
||||
let visscr = S.current winset : S.visible winset
|
||||
visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr
|
||||
hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp)
|
||||
hasPicAndIsVisible (n, mp) = n `elem` visws && isJust mp
|
||||
getRect tag = screenRect $ fromJust $ M.lookup tag visrects
|
||||
foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths
|
||||
return foundpaths
|
||||
@ -224,4 +223,4 @@ layerCommand (rect, path) = do
|
||||
Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in
|
||||
" \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
|
||||
++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)"
|
||||
++ " -geometry +" ++ (show $rect_x rect) ++ "+" ++ (show $rect_y rect) ++ " -composite "
|
||||
++ " -geometry +" ++ show (rect_x rect) ++ "+" ++ show (rect_y rect) ++ " -composite "
|
||||
|
@ -56,7 +56,7 @@ import XMonad.Prelude (Endo (..), chr)
|
||||
-- should work fine. Others might not work.
|
||||
--
|
||||
|
||||
type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet)))
|
||||
type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet))
|
||||
|
||||
pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
|
||||
pmX f w = f w >> return id
|
||||
@ -71,10 +71,10 @@ xPropManageHook tms = mconcat $ map propToHook tms
|
||||
mkQuery (a, tf) = fmap tf (getQuery a)
|
||||
mkHook func = ask >>= Query . lift . fmap Endo . func
|
||||
|
||||
getProp :: Display -> Window -> Atom -> X ([String])
|
||||
getProp :: Display -> Window -> Atom -> X [String]
|
||||
getProp d w p = do
|
||||
prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
|
||||
let filt q | q == wM_COMMAND = concat . map splitAtNull
|
||||
let filt q | q == wM_COMMAND = concatMap splitAtNull
|
||||
| otherwise = id
|
||||
return (filt p prop)
|
||||
|
||||
@ -82,7 +82,7 @@ getQuery :: Atom -> Query [String]
|
||||
getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p
|
||||
|
||||
splitAtNull :: String -> [String]
|
||||
splitAtNull s = case dropWhile (== (chr 0)) s of
|
||||
splitAtNull s = case dropWhile (== chr 0) s of
|
||||
"" -> []
|
||||
s' -> w : splitAtNull s''
|
||||
where (w, s'') = break (== (chr 0)) s'
|
||||
where (w, s'') = break (== chr 0) s'
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.AutoMaster
|
||||
@ -20,11 +20,13 @@ module XMonad.Layout.AutoMaster (
|
||||
-- $usage
|
||||
autoMaster, AutoMaster
|
||||
) where
|
||||
import XMonad.Prelude
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Prelude
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Control.Arrow (first)
|
||||
|
||||
|
||||
-- $usage
|
||||
-- This module defines layout modifier named autoMaster. It separates
|
||||
@ -57,7 +59,7 @@ autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
|
||||
autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m),
|
||||
fmap incmastern (fromMessage m)]
|
||||
where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta
|
||||
resize Expand = AutoMaster k (min ( 0.4) $ bias+delta) delta
|
||||
resize Expand = AutoMaster k (min 0.4 $ bias+delta) delta
|
||||
resize Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta
|
||||
|
||||
-- | Main layout function
|
||||
@ -74,32 +76,32 @@ autoLayout k bias wksp rect = do
|
||||
if null ws then
|
||||
runLayout wksp rect
|
||||
else
|
||||
if (n<=k) then
|
||||
return ((divideRow rect ws),Nothing)
|
||||
if n<=k then
|
||||
return (divideRow rect ws,Nothing)
|
||||
else do
|
||||
let master = take k ws
|
||||
let filtStack = stack >>= W.filter (\w -> not (w `elem` master))
|
||||
let filtStack = stack >>= W.filter (`notElem` master)
|
||||
wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias)
|
||||
return ((divideRow (masterRect rect n bias) master) ++ (fst wrs),
|
||||
snd wrs)
|
||||
return $ first (divideRow (masterRect rect n bias) master ++)
|
||||
wrs
|
||||
|
||||
-- | Calculates height of master area, depending on number of windows.
|
||||
masterHeight :: Int -> Float -> Float
|
||||
masterHeight n bias = (calcHeight n) + bias
|
||||
masterHeight n bias = calcHeight n + bias
|
||||
where calcHeight :: Int -> Float
|
||||
calcHeight 1 = 1.0
|
||||
calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3)
|
||||
calcHeight m = if m<9 then (43/45) - fromIntegral m*(7/90) else 1/3
|
||||
|
||||
-- | Rectangle for master area
|
||||
masterRect :: Rectangle -> Int -> Float -> Rectangle
|
||||
masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h
|
||||
where h = round $ (fromIntegral sh)*(masterHeight n bias)
|
||||
where h = round $ fromIntegral sh*masterHeight n bias
|
||||
|
||||
-- | Rectangle for slave area
|
||||
slaveRect :: Rectangle -> Int -> Float -> Rectangle
|
||||
slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h
|
||||
where mh = round $ (fromIntegral sh)*(masterHeight n bias)
|
||||
h = round $ (fromIntegral sh)*(1-masterHeight n bias)
|
||||
where mh = round $ fromIntegral sh*masterHeight n bias
|
||||
h = round $ fromIntegral sh*(1-masterHeight n bias)
|
||||
|
||||
-- | Divide rectangle between windows
|
||||
divideRow :: Rectangle -> [a] -> [(a, Rectangle)]
|
||||
@ -120,4 +122,3 @@ autoMaster :: LayoutClass l a =>
|
||||
l a ->
|
||||
ModifiedLayout AutoMaster l a
|
||||
autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta)
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TupleSections #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -26,7 +26,7 @@ module XMonad.Layout.AvoidFloats (
|
||||
|
||||
import XMonad
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Prelude (fi, maximumBy, maybeToList, sortBy)
|
||||
import XMonad.Prelude (fi, mapMaybe, maximumBy, sortOn)
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Data.Ord
|
||||
@ -107,10 +107,10 @@ instance LayoutModifier AvoidFloats Window where
|
||||
modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
|
||||
floating <- gets $ W.floating . windowset
|
||||
case cache lm of
|
||||
Just (key, mer) | key == (floating,r) -> flip (,) Nothing <$> runLayout w mer
|
||||
Just (key, mer) | key == (floating,r) -> (, Nothing) <$> runLayout w mer
|
||||
_ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
|
||||
let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
|
||||
flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
|
||||
(, Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
|
||||
where
|
||||
toRect :: WindowAttributes -> Rectangle
|
||||
toRect wa = let b = fi $ wa_border_width wa
|
||||
@ -122,9 +122,9 @@ instance LayoutModifier AvoidFloats Window where
|
||||
shouldAvoid a = avoidAll lm || a `S.member` chosen lm
|
||||
|
||||
pureMess lm m
|
||||
| Just (AvoidFloatToggle) <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }
|
||||
| Just AvoidFloatToggle <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }
|
||||
| Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm = Just $ lm { avoidAll = s, cache = Nothing }
|
||||
| Just (AvoidFloatClearItems) <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing }
|
||||
| Just AvoidFloatClearItems <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing }
|
||||
| Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing }
|
||||
| Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing }
|
||||
| Just (AvoidFloatToggleItem a) <- fromMessage m = let op = if a `S.member` chosen lm then S.delete else S.insert
|
||||
@ -134,7 +134,7 @@ instance LayoutModifier AvoidFloats Window where
|
||||
pruneWindows :: AvoidFloats Window -> AvoidFloats Window
|
||||
pruneWindows lm = case cache lm of
|
||||
Nothing -> lm
|
||||
Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) }
|
||||
Just ((floating,_),_) -> lm { chosen = S.filter (`M.member` floating) (chosen lm) }
|
||||
|
||||
-- | Find all maximum empty rectangles (MERs) that are axis aligned. This is
|
||||
-- done in O(n^2) time using a modified version of the algoprithm MERAlg 1
|
||||
@ -144,9 +144,9 @@ maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle]
|
||||
maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge
|
||||
where
|
||||
upAndDownEdge = findGaps br rectangles
|
||||
noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms
|
||||
downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms
|
||||
bottoms = sortBy (comparing bottom) $ splitContainers rectangles
|
||||
noneOrUpEdge = concatMap (everyLower br bottoms) bottoms
|
||||
downEdge = mapMaybe (bottomEdge br bottoms) bottoms
|
||||
bottoms = sortOn bottom $ splitContainers rectangles
|
||||
|
||||
everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
|
||||
everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms
|
||||
@ -177,8 +177,8 @@ shrinkBounds' mr r (boundLeft, boundRight)
|
||||
|
||||
bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
|
||||
bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms
|
||||
boundLeft = maximum $ left br : (filter (< right r) $ map right rs)
|
||||
boundRight = minimum $ right br : (filter (> left r) $ map left rs)
|
||||
boundLeft = maximum $ left br : filter (< right r) (map right rs)
|
||||
boundRight = minimum $ right br : filter (> left r) (map left rs)
|
||||
in if any (\a -> left a <= left r && right r <= right a) rs
|
||||
then Nothing
|
||||
else mkRect boundLeft boundRight (bottom r) (bottom br)
|
||||
@ -186,11 +186,11 @@ bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a <
|
||||
-- | Split rectangles that horizontally fully contains another rectangle
|
||||
-- without sharing either the left or right side.
|
||||
splitContainers :: [Rectangle] -> [Rectangle]
|
||||
splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects
|
||||
splitContainers rects = splitContainers' [] $ sortOn rect_width rects
|
||||
where
|
||||
splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]
|
||||
splitContainers' res [] = res
|
||||
splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs
|
||||
splitContainers' res (r:rs) = splitContainers' (r:res) $ concatMap (doSplit r) rs
|
||||
|
||||
doSplit :: Rectangle -> Rectangle -> [Rectangle]
|
||||
doSplit guide r
|
||||
@ -206,7 +206,7 @@ findGaps
|
||||
:: Rectangle -- ^ Bounding rectangle.
|
||||
-> [Rectangle] -- ^ List of all rectangles that can cover areas in the bounding rectangle.
|
||||
-> [Rectangle]
|
||||
findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs
|
||||
findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortOn (Down . left) $ filter inBounds rs
|
||||
lastgap = mkRect end (right br) (top br) (bottom br)
|
||||
in lastgap?:gaps
|
||||
where
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.BinaryColumn
|
||||
@ -86,7 +86,7 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
|
||||
m_fl = fromIntegral m
|
||||
m_prev_fl = fromIntegral (m + 1)
|
||||
div_test = min divide m_prev_fl
|
||||
value_test = round ((fromIntegral size) / div_test) :: Integer
|
||||
value_test = round (fromIntegral size / div_test) :: Integer
|
||||
value_max = size - toInteger (min_size * m)
|
||||
(value, divide_next, no_room) =
|
||||
if value_test < value_max then
|
||||
@ -101,7 +101,7 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
|
||||
-- simply create an even grid with the remaining space.
|
||||
f m size divide True = let
|
||||
divide_next = fromIntegral m
|
||||
value_even = ((fromIntegral size) / divide)
|
||||
value_even = (fromIntegral size / divide)
|
||||
value = round value_even :: Integer
|
||||
|
||||
m_next = m - 1
|
||||
@ -112,21 +112,21 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
|
||||
n_init size_init divide_init False
|
||||
where
|
||||
n_init = n - 1
|
||||
size_init = (toInteger (rect_height rect))
|
||||
size_init = toInteger (rect_height rect)
|
||||
divide_init =
|
||||
if scale_abs == 0.0 then
|
||||
(fromIntegral n)
|
||||
fromIntegral n
|
||||
else
|
||||
(1.0 / (0.5 * scale_abs))
|
||||
1.0 / (0.5 * scale_abs)
|
||||
|
||||
heights =
|
||||
if (scale < 0.0) then
|
||||
if scale < 0.0 then
|
||||
Data.List.reverse (take n heights_noflip)
|
||||
else
|
||||
heights_noflip
|
||||
|
||||
ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]]
|
||||
rects = map (mkRect rect) $ zip heights ys
|
||||
rects = zipWith (curry (mkRect rect)) heights ys
|
||||
|
||||
mkRect :: XMonad.Rectangle
|
||||
-> (Integer,XMonad.Position)
|
||||
|
@ -157,7 +157,7 @@ instance Message SelectMoveNode
|
||||
data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
|
||||
|
||||
-- | Message for shifting window by splitting its neighbour
|
||||
data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
|
||||
newtype SplitShiftDirectional = SplitShift Direction1D deriving Typeable
|
||||
instance Message SplitShiftDirectional
|
||||
|
||||
oppositeDirection :: Direction2D -> Direction2D
|
||||
@ -253,9 +253,7 @@ goSibling z@(_, LeftCrumb _ _:_) = Just z >>= goUp >>= goRight
|
||||
goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft
|
||||
|
||||
top :: Zipper a -> Zipper a
|
||||
top z = case goUp z of
|
||||
Nothing -> z
|
||||
Just z' -> top z'
|
||||
top z = maybe z top (goUp z)
|
||||
|
||||
toTree :: Zipper a -> Tree a
|
||||
toTree = fst . top
|
||||
@ -283,10 +281,10 @@ removeCurrent :: Zipper a -> Maybe (Zipper a)
|
||||
removeCurrent (Leaf _, LeftCrumb _ r:cs) = Just (r, cs)
|
||||
removeCurrent (Leaf _, RightCrumb _ l:cs) = Just (l, cs)
|
||||
removeCurrent (Leaf _, []) = Nothing
|
||||
removeCurrent (Node _ (Leaf _) r@(Node _ _ _), cs) = Just (r, cs)
|
||||
removeCurrent (Node _ l@(Node _ _ _) (Leaf _), cs) = Just (l, cs)
|
||||
removeCurrent (Node _ (Leaf _) r@Node{}, cs) = Just (r, cs)
|
||||
removeCurrent (Node _ l@Node{} (Leaf _), cs) = Just (l, cs)
|
||||
removeCurrent (Node _ (Leaf _) (Leaf _), cs) = Just (Leaf 0, cs)
|
||||
removeCurrent z@(Node _ _ _, _) = goLeft z >>= removeCurrent
|
||||
removeCurrent z@(Node{}, _) = goLeft z >>= removeCurrent
|
||||
|
||||
rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
|
||||
rotateCurrent l@(_, []) = Just l
|
||||
@ -297,23 +295,23 @@ swapCurrent l@(_, []) = Just l
|
||||
swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)
|
||||
|
||||
insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
|
||||
insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
|
||||
insertLeftLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
|
||||
insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs)
|
||||
insertLeftLeaf (Node _ _ _) z = Just z
|
||||
insertLeftLeaf Node{} z = Just z
|
||||
insertLeftLeaf _ _ = Nothing
|
||||
|
||||
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
|
||||
insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
|
||||
insertRightLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
|
||||
insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs)
|
||||
insertRightLeaf (Node _ _ _) z = Just z
|
||||
insertRightLeaf Node{} z = Just z
|
||||
insertRightLeaf _ _ = Nothing
|
||||
|
||||
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
|
||||
findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf
|
||||
findRightLeaf n@(Node{}, _) = goRight n >>= findRightLeaf
|
||||
findRightLeaf l@(Leaf _, _) = Just l
|
||||
|
||||
findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
|
||||
findLeftLeaf n@(Node _ _ _, _) = goLeft n
|
||||
findLeftLeaf n@(Node{}, _) = goLeft n
|
||||
findLeftLeaf l@(Leaf _, _) = Just l
|
||||
|
||||
findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
|
||||
@ -508,7 +506,7 @@ toNodeRef l (Just (_, cs)) = NodeRef l (reverse $ map crumbToDir cs) []
|
||||
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
|
||||
nodeRefToLeaf n (Just z) = case goToNode n z of
|
||||
Just (Leaf l, _) -> Just l
|
||||
Just (Node _ _ _, _) -> Nothing
|
||||
Just (Node{}, _) -> Nothing
|
||||
Nothing -> Nothing
|
||||
nodeRefToLeaf _ Nothing = Nothing
|
||||
|
||||
@ -693,13 +691,13 @@ replaceFloating wsm = do
|
||||
-- some helpers to filter windows
|
||||
--
|
||||
getFloating :: X [Window]
|
||||
getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows
|
||||
getFloating = M.keys . W.floating <$> gets windowset -- all floating windows
|
||||
|
||||
getStackSet :: X (Maybe (W.Stack Window))
|
||||
getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating)
|
||||
getStackSet = W.stack . W.workspace . W.current <$> gets windowset -- windows on this WS (with floating)
|
||||
|
||||
getScreenRect :: X Rectangle
|
||||
getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset
|
||||
getScreenRect = screenRect . W.screenDetail . W.current <$> gets windowset
|
||||
|
||||
withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
|
||||
withoutFloating fs = maybe Nothing (unfloat fs)
|
||||
@ -772,8 +770,8 @@ instance LayoutClass BinarySpacePartition Window where
|
||||
splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b
|
||||
|
||||
b = numerateLeaves b_orig
|
||||
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}
|
||||
,getSelectedNode=(getSelectedNode bsp){refLeaf=(-1)}}
|
||||
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf= -1}
|
||||
,getSelectedNode=(getSelectedNode bsp){refLeaf= -1}}
|
||||
|
||||
description _ = "BSP"
|
||||
|
||||
@ -850,8 +848,8 @@ createBorder (Rectangle wx wy ww wh) c = do
|
||||
]
|
||||
ws <- mapM (\r -> createNewWindow r Nothing bc False) rects
|
||||
showWindows ws
|
||||
maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) <$> getStackSet >>= replaceStack
|
||||
M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset <$> get >>= replaceFloating
|
||||
replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) =<< getStackSet
|
||||
replaceFloating . M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset =<< get
|
||||
modify (\s -> s{mapped=mapped s `S.union` S.fromList ws})
|
||||
-- show <$> mapM isClient ws >>= debug
|
||||
return ws
|
||||
@ -861,6 +859,6 @@ createBorder (Rectangle wx wy ww wh) c = do
|
||||
removeBorder :: [Window] -> X ()
|
||||
removeBorder ws = do
|
||||
modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws})
|
||||
flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating
|
||||
maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack
|
||||
replaceFloating . flip (foldl (flip M.delete)) ws . W.floating . windowset =<< get
|
||||
replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) =<< getStackSet
|
||||
deleteWindows ws
|
||||
|
@ -57,7 +57,7 @@ data BorderInfo = BI { bWin :: Window,
|
||||
|
||||
type RectWithBorders = (Rectangle, [BorderInfo])
|
||||
|
||||
data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)
|
||||
newtype BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)
|
||||
|
||||
brBorderSize :: Dimension
|
||||
brBorderSize = 2
|
||||
@ -99,7 +99,7 @@ instance LayoutModifier BorderResize Window where
|
||||
|
||||
compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
|
||||
compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder
|
||||
in concat $ map compileWr wrs
|
||||
in concatMap compileWr wrs
|
||||
|
||||
compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)]
|
||||
compileWr (w, (r, borderInfos)) =
|
||||
@ -109,7 +109,7 @@ compileWr (w, (r, borderInfos)) =
|
||||
handleGone :: M.Map Window RectWithBorders -> X ()
|
||||
handleGone wrsGone = mapM_ deleteWindow borderWins
|
||||
where
|
||||
borderWins = map bWin . concat . map snd . M.elems $ wrsGone
|
||||
borderWins = map bWin . concatMap snd . M.elems $ wrsGone
|
||||
|
||||
handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders)
|
||||
handleAppeared wrsAppeared = do
|
||||
@ -124,58 +124,58 @@ handleSingleAppeared (w, r) = do
|
||||
return (w, (r, borderInfos))
|
||||
|
||||
handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders
|
||||
handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere
|
||||
handleStillThere = M.map handleSingleStillThere
|
||||
|
||||
handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders
|
||||
handleSingleStillThere (Nothing, entry) = entry
|
||||
handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)
|
||||
where
|
||||
changedBorderBlueprints = prepareBorders rCurrent
|
||||
updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints
|
||||
updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints
|
||||
-- assuming that the four borders are always in the same order
|
||||
|
||||
updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo
|
||||
updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r }
|
||||
|
||||
createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))]
|
||||
createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime
|
||||
createBorderLookupTable wrsLastTime = concatMap processSingleEntry (M.toList wrsLastTime)
|
||||
where
|
||||
processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]
|
||||
processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r))
|
||||
|
||||
prepareBorders :: Rectangle -> [BorderBlueprint]
|
||||
prepareBorders (Rectangle x y wh ht) =
|
||||
[((Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder),
|
||||
((Rectangle x y brBorderSize ht) , xC_left_side , LeftSideBorder),
|
||||
((Rectangle x y wh brBorderSize) , xC_top_side , TopSideBorder),
|
||||
((Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize), xC_bottom_side, BottomSideBorder)
|
||||
[(Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht, xC_right_side , RightSideBorder),
|
||||
(Rectangle x y brBorderSize ht , xC_left_side , LeftSideBorder),
|
||||
(Rectangle x y wh brBorderSize , xC_top_side , TopSideBorder),
|
||||
(Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize, xC_bottom_side, BottomSideBorder)
|
||||
]
|
||||
|
||||
handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()
|
||||
handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
|
||||
| et == buttonPress, Just edge <- lookup ew borders =
|
||||
case edge of
|
||||
(RightSideBorder, hostWin, (Rectangle hx hy _ hht)) ->
|
||||
(RightSideBorder, hostWin, Rectangle hx hy _ hht) ->
|
||||
mouseDrag (\x _ -> do
|
||||
let nwh = max 1 $ fi (x - hx)
|
||||
rect = Rectangle hx hy nwh hht
|
||||
focus hostWin
|
||||
when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
|
||||
(LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->
|
||||
(LeftSideBorder, hostWin, Rectangle hx hy hwh hht) ->
|
||||
mouseDrag (\x _ -> do
|
||||
let nx = max 0 $ min (hx + fi hwh) $ x
|
||||
let nx = max 0 $ min (hx + fi hwh) x
|
||||
nwh = max 1 $ hwh + fi (hx - x)
|
||||
rect = Rectangle nx hy nwh hht
|
||||
focus hostWin
|
||||
when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin)
|
||||
(TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->
|
||||
(TopSideBorder, hostWin, Rectangle hx hy hwh hht) ->
|
||||
mouseDrag (\_ y -> do
|
||||
let ny = max 0 $ min (hy + fi hht) $ y
|
||||
let ny = max 0 $ min (hy + fi hht) y
|
||||
nht = max 1 $ hht + fi (hy - y)
|
||||
rect = Rectangle hx ny hwh nht
|
||||
focus hostWin
|
||||
when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin)
|
||||
(BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) ->
|
||||
(BottomSideBorder, hostWin, Rectangle hx hy hwh _) ->
|
||||
mouseDrag (\_ y -> do
|
||||
let nht = max 1 $ fi (y - hy)
|
||||
rect = Rectangle hx hy hwh nht
|
||||
@ -183,7 +183,7 @@ handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
|
||||
when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
|
||||
handleResize _ _ = return ()
|
||||
|
||||
createBorder :: BorderBlueprint -> X (BorderInfo)
|
||||
createBorder :: BorderBlueprint -> X BorderInfo
|
||||
createBorder (borderRect, borderCursor, borderType) = do
|
||||
borderWin <- createInputWindow borderCursor borderRect
|
||||
return BI { bWin = borderWin, bRect = borderRect, bType = borderType }
|
||||
@ -214,10 +214,10 @@ for = flip map
|
||||
|
||||
reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
|
||||
reorder wrs order =
|
||||
let ordered = concat $ map (pickElem wrs) order
|
||||
rest = filter (\(w, _) -> not (w `elem` order)) wrs
|
||||
let ordered = concatMap (pickElem wrs) order
|
||||
rest = filter (\(w, _) -> w `notElem` order) wrs
|
||||
in ordered ++ rest
|
||||
where
|
||||
pickElem list e = case (lookup e list) of
|
||||
pickElem list e = case lookup e list of
|
||||
Just result -> [(e, result)]
|
||||
Nothing -> []
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@ -36,7 +36,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
|
||||
LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
|
||||
import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
|
||||
broadcastMessage, sendMessage, windows, withFocused, Window)
|
||||
import XMonad.Prelude (fromMaybe, listToMaybe, maybeToList, union, (\\))
|
||||
import XMonad.Prelude (find, fromMaybe, listToMaybe, maybeToList, union, (\\))
|
||||
import XMonad.Util.Stack (reverseS)
|
||||
import qualified Data.Map as M
|
||||
import qualified XMonad.StackSet as W
|
||||
@ -110,13 +110,13 @@ boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
|
||||
boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just []))
|
||||
|
||||
instance LayoutModifier BoringWindows Window where
|
||||
redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do
|
||||
redoLayout b@BoringWindows{ hiddenBoring = bs } _r mst arrs = do
|
||||
let bs' = W.integrate' mst \\ map fst arrs
|
||||
return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } )
|
||||
return (arrs, Just $ b { hiddenBoring = bs' <$ bs } )
|
||||
|
||||
handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m
|
||||
| Just (Replace k ws) <- fromMessage m
|
||||
, maybe True (ws/=) (M.lookup k nbs) =
|
||||
, Just ws /= M.lookup k nbs =
|
||||
let nnb = if null ws then M.delete k nbs
|
||||
else M.insert k ws nbs
|
||||
in rjl bst { namedBoring = nnb }
|
||||
@ -155,8 +155,8 @@ instance LayoutModifier BoringWindows Window where
|
||||
skipBoringSwapUp = skipBoring'
|
||||
(maybe True (`notElem` bs) . listToMaybe . W.down)
|
||||
swapUp'
|
||||
skipBoring' p f st = fromMaybe st $ listToMaybe
|
||||
$ filter p
|
||||
skipBoring' p f st = fromMaybe st
|
||||
$ find p
|
||||
$ drop 1
|
||||
$ take (length $ W.integrate st)
|
||||
$ iterate f st
|
||||
|
@ -48,7 +48,7 @@ buttonDeco :: (Eq a, Shrinker s) => s -> Theme
|
||||
-> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a
|
||||
buttonDeco s c = decoration s c $ NFD True
|
||||
|
||||
data ButtonDecoration a = NFD Bool deriving (Show, Read)
|
||||
newtype ButtonDecoration a = NFD Bool deriving (Show, Read)
|
||||
|
||||
instance Eq a => DecorationStyle ButtonDecoration a where
|
||||
describeDeco _ = "ButtonDeco"
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.CenteredMaster
|
||||
@ -29,6 +29,8 @@ import XMonad
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Control.Arrow (first)
|
||||
|
||||
-- $usage
|
||||
-- This module defines two new layout modifiers: centerMaster and topRightMaster.
|
||||
-- centerMaster places master window at center of screen, on top of others.
|
||||
@ -76,15 +78,15 @@ applyPosition :: (LayoutClass l a, Eq a) =>
|
||||
|
||||
applyPosition pos wksp rect = do
|
||||
let stack = W.stack wksp
|
||||
let ws = W.integrate' $ stack
|
||||
let ws = W.integrate' stack
|
||||
if null ws then
|
||||
runLayout wksp rect
|
||||
else do
|
||||
let first = head ws
|
||||
let firstW = head ws
|
||||
let other = tail ws
|
||||
let filtStack = stack >>= W.filter (first /=)
|
||||
let filtStack = stack >>= W.filter (firstW /=)
|
||||
wrs <- runLayout (wksp {W.stack = filtStack}) rect
|
||||
return ((first, place pos other rect) : fst wrs, snd wrs)
|
||||
return $ first ((firstW, place pos other rect) :) wrs
|
||||
|
||||
-- | Place master window (it's Rectangle is given), using the given Positioner.
|
||||
-- If second argument is empty (that is, there is only one window on workspace),
|
||||
@ -107,5 +109,3 @@ center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h
|
||||
h = round (fromIntegral sh * ry)
|
||||
x = sx + fromIntegral (sw-w) `div` 2
|
||||
y = sy + fromIntegral (sh-h) `div` 2
|
||||
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.Column
|
||||
@ -40,7 +40,7 @@ import qualified XMonad.StackSet as W
|
||||
-- In this example, each next window will have height 1.6 times less then
|
||||
-- previous window.
|
||||
|
||||
data Column a = Column Float deriving (Read,Show)
|
||||
newtype Column a = Column Float deriving (Read,Show)
|
||||
|
||||
instance LayoutClass Column a where
|
||||
pureLayout = columnLayout
|
||||
@ -57,15 +57,13 @@ columnLayout (Column q) rect stack = zip ws rects
|
||||
n = length ws
|
||||
heights = map (xn n rect q) [1..n]
|
||||
ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]]
|
||||
rects = map (mkRect rect) $ zip heights ys
|
||||
rects = zipWith (curry (mkRect rect)) heights ys
|
||||
|
||||
mkRect :: Rectangle -> (Dimension,Position) -> Rectangle
|
||||
mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h
|
||||
|
||||
xn :: Int -> Rectangle -> Float -> Int -> Dimension
|
||||
xn n (Rectangle _ _ _ h) q k = if q==1 then
|
||||
h `div` (fromIntegral n)
|
||||
h `div` fromIntegral n
|
||||
else
|
||||
round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n))
|
||||
|
||||
|
||||
round (fromIntegral h*q^(n-k)*(1-q)/(1-q^n))
|
||||
|
@ -23,7 +23,7 @@ module XMonad.Layout.Combo (
|
||||
) where
|
||||
|
||||
import XMonad hiding (focus)
|
||||
import XMonad.Prelude (delete, intersect, isJust, (\\))
|
||||
import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\))
|
||||
import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )
|
||||
import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
|
||||
import qualified XMonad.StackSet as W ( differentiate )
|
||||
@ -76,14 +76,14 @@ combineTwo = C2 [] []
|
||||
instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
|
||||
=> LayoutClass (CombineTwo (l ()) l1 l2) a where
|
||||
runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
|
||||
where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
|
||||
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
|
||||
super' <- maybe super id <$>
|
||||
where arrange [] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources)
|
||||
l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources)
|
||||
super' <- fromMaybe super <$>
|
||||
handleMessage super (SomeMessage ReleaseResources)
|
||||
return ([], Just $ C2 [] [] super' l1' l2')
|
||||
arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
|
||||
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
|
||||
super' <- maybe super id <$>
|
||||
arrange [w] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources)
|
||||
l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources)
|
||||
super' <- fromMaybe super <$>
|
||||
handleMessage super (SomeMessage ReleaseResources)
|
||||
return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
|
||||
arrange origws =
|
||||
@ -101,17 +101,17 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
|
||||
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
|
||||
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
|
||||
return (wrs1++wrs2, Just $ C2 f' w2'
|
||||
(maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))
|
||||
(fromMaybe super msuper') (fromMaybe l1 ml1') (fromMaybe l2 ml2'))
|
||||
handleMessage (C2 f ws2 super l1 l2) m
|
||||
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
|
||||
w1 `notElem` ws2,
|
||||
w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
|
||||
l2' <- maybe l2 id <$> handleMessage l2 m
|
||||
w2 `elem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m
|
||||
l2' <- fromMaybe l2 <$> handleMessage l2 m
|
||||
return $ Just $ C2 f (w1:ws2) super l1' l2'
|
||||
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
|
||||
w1 `elem` ws2,
|
||||
w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
|
||||
l2' <- maybe l2 id <$> handleMessage l2 m
|
||||
w2 `notElem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m
|
||||
l2' <- fromMaybe l2 <$> handleMessage l2 m
|
||||
let ws2' = case delete w1 ws2 of [] -> [w2]
|
||||
x -> x
|
||||
return $ Just $ C2 f ws2' super l1' l2'
|
||||
@ -138,6 +138,6 @@ differentiate [] xs = W.differentiate xs
|
||||
broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
|
||||
broadcastPrivate a ol = do nml <- mapM f ol
|
||||
if any isJust nml
|
||||
then return $ Just $ zipWith ((flip maybe) id) ol nml
|
||||
then return $ Just $ zipWith (`maybe` id) ol nml
|
||||
else return Nothing
|
||||
where f l = handleMessage l a `catchX` return Nothing
|
||||
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
|
||||
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.ComboP
|
||||
@ -97,7 +97,7 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
|
||||
superstack = Just Stack { focus=(), up=[], down=[()] }
|
||||
f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most
|
||||
in do
|
||||
matching <- (hasProperty prop) `filterM` new -- new windows matching predecate
|
||||
matching <- hasProperty prop `filterM` new -- new windows matching predecate
|
||||
let w1' = w1c ++ matching -- updated first pane windows
|
||||
w2' = w2c ++ (new \\ matching) -- updated second pane windows
|
||||
s1 = differentiate f' w1' -- first pane stack
|
||||
@ -105,8 +105,8 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
|
||||
([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
|
||||
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
|
||||
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
|
||||
return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper')
|
||||
(maybe l1 id ml1') (maybe l2 id ml2') prop)
|
||||
return (wrs1++wrs2, Just $ C2P f' w1' w2' (fromMaybe super msuper')
|
||||
(fromMaybe l1 ml1') (fromMaybe l2 ml2') prop)
|
||||
|
||||
handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
|
||||
| Just PartitionWins <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop
|
||||
@ -127,13 +127,13 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
|
||||
msuper' <- handleMessage super m
|
||||
if isJust msuper' || isJust ml1' || isJust ml2'
|
||||
then return $ Just $ C2P f ws1 ws2
|
||||
(maybe super id msuper')
|
||||
(maybe l1 id ml1')
|
||||
(maybe l2 id ml2') prop
|
||||
(fromMaybe super msuper')
|
||||
(fromMaybe l1 ml1')
|
||||
(fromMaybe l2 ml2') prop
|
||||
else return Nothing
|
||||
|
||||
description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++
|
||||
description l2 ++ " with " ++ description super ++ " using "++ (show prop)
|
||||
description l2 ++ " with " ++ description super ++ " using "++ show prop
|
||||
|
||||
-- send focused window to the other pane. Does nothing if we don't
|
||||
-- own the focused window
|
||||
@ -164,7 +164,7 @@ forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do
|
||||
then return Nothing
|
||||
else handleMessage super m
|
||||
if isJust ml1 || isJust ml2 || isJust ms
|
||||
then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop
|
||||
then return $ Just $ C2P f ws1 ws2 (fromMaybe super ms) (fromMaybe l1 ml1) (fromMaybe l2 ml2) prop
|
||||
else return Nothing
|
||||
|
||||
-- forwards message m to layout l if focused window is among w
|
||||
@ -172,7 +172,7 @@ forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessag
|
||||
forwardIfFocused l w m = do
|
||||
mst <- gets (W.stack . W.workspace . W.current . windowset)
|
||||
maybe (return Nothing) send mst where
|
||||
send st = if (W.focus st) `elem` w
|
||||
send st = if W.focus st `elem` w
|
||||
then handleMessage l m
|
||||
else return Nothing
|
||||
|
||||
|
@ -34,7 +34,7 @@ import XMonad.Prelude( msum )
|
||||
|
||||
-- apply a factor to a Rectangle Dimension
|
||||
(<%>) :: Dimension -> Rational -> Dimension
|
||||
d <%> f = floor $ f * (fromIntegral d)
|
||||
d <%> f = floor $ f * fromIntegral d
|
||||
|
||||
-- | The Cross Layout draws the focused window in the center of the screen
|
||||
-- and part of the other windows on the sides. The 'Shrink' and 'Expand'
|
||||
@ -57,10 +57,10 @@ simpleCross :: Cross a
|
||||
simpleCross = Cross (4/5) (1/100)
|
||||
|
||||
instance LayoutClass Cross a where
|
||||
pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++
|
||||
(zip winCycle (upRects r f)) ++
|
||||
(zip (reverse winCycle) (downRects r f))
|
||||
where winCycle = (up s) ++ (reverse (down s))
|
||||
pureLayout (Cross f _) r s = [(focus s, mainRect r f)]
|
||||
++ zip winCycle (upRects r f)
|
||||
++ zip (reverse winCycle) (downRects r f)
|
||||
where winCycle = up s ++ reverse (down s)
|
||||
|
||||
pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)]
|
||||
where resize Shrink = Cross (max (1/100) $ f - d) d
|
||||
@ -71,8 +71,8 @@ instance LayoutClass Cross a where
|
||||
-- get the Rectangle for the focused window
|
||||
mainRect :: Rectangle -> Rational -> Rectangle
|
||||
mainRect (Rectangle rx ry rw rh) f = Rectangle
|
||||
(rx + (fromIntegral (rw <%> invf)))
|
||||
(ry + (fromIntegral (rh <%> invf)))
|
||||
(rx + fromIntegral (rw <%> invf))
|
||||
(ry + fromIntegral (rh <%> invf))
|
||||
(rw <%> f) (rh <%> f)
|
||||
where invf = (1/2) * (1-f)
|
||||
|
||||
@ -88,25 +88,25 @@ downRects r f = [bottomRectangle r nf, leftRectangle r nf]
|
||||
|
||||
topRectangle :: Rectangle -> Rational -> Rectangle
|
||||
topRectangle (Rectangle rx ry rw rh) f = Rectangle
|
||||
(rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
|
||||
(rx + fromIntegral (rw <%> ((1-f)*(1/2))))
|
||||
ry
|
||||
(rw <%> f) (rh <%> ((1-f)*(1/2)))
|
||||
|
||||
rightRectangle :: Rectangle -> Rational -> Rectangle
|
||||
rightRectangle (Rectangle rx ry rw rh) f = Rectangle
|
||||
(rx + (fromIntegral (rw - (rw <%> (1/2)))))
|
||||
(ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
|
||||
(rx + fromIntegral (rw - (rw <%> (1/2))))
|
||||
(ry + fromIntegral (rh <%> ((1-f)*(1/2))))
|
||||
(rw <%> (1/2)) (rh <%> f)
|
||||
|
||||
bottomRectangle :: Rectangle -> Rational -> Rectangle
|
||||
bottomRectangle (Rectangle rx ry rw rh) f = Rectangle
|
||||
(rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
|
||||
(ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2))))))
|
||||
(rx + fromIntegral (rw <%> ((1-f)*(1/2))))
|
||||
(ry + fromIntegral (rh - (rh <%> ((1-f)*(1/2)))))
|
||||
(rw <%> f) (rh <%> ((1-f)*(1/2)))
|
||||
|
||||
leftRectangle :: Rectangle -> Rational -> Rectangle
|
||||
leftRectangle (Rectangle rx ry rw rh) f = Rectangle
|
||||
rx
|
||||
(ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
|
||||
(ry + fromIntegral (rh <%> ((1-f)*(1/2))))
|
||||
(rw <%> (1/2)) (rh <%> f)
|
||||
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
x
Reference in New Issue
Block a user