mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
Remove redundant do's
This commit is contained in:
parent
c3bb1cb2e7
commit
bcd4dde298
@ -62,7 +62,7 @@ type ExtensionActions = M.Map String (String -> X())
|
|||||||
instance XPrompt CalculatorMode where
|
instance XPrompt CalculatorMode where
|
||||||
showXPrompt CalcMode = "calc %s> "
|
showXPrompt CalcMode = "calc %s> "
|
||||||
commandToComplete CalcMode = id --send the whole string to `calc`
|
commandToComplete CalcMode = id --send the whole string to `calc`
|
||||||
completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
|
completionFunction CalcMode = \s -> if (length s == 0) then return [] else
|
||||||
lines <$> runProcessWithInput "calc" [s] ""
|
lines <$> runProcessWithInput "calc" [s] ""
|
||||||
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
|
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
|
||||||
|
|
||||||
@ -88,7 +88,7 @@ instance XPrompt HoogleMode where
|
|||||||
|
|
||||||
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
|
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
|
||||||
completionFunctionWith :: String -> [String] -> IO [String]
|
completionFunctionWith :: String -> [String] -> IO [String]
|
||||||
completionFunctionWith cmd args = do lines <$> runProcessWithInput cmd args ""
|
completionFunctionWith cmd args = lines <$> runProcessWithInput cmd args ""
|
||||||
|
|
||||||
-- | Creates a prompt with the given modes
|
-- | Creates a prompt with the given modes
|
||||||
launcherPrompt :: XPConfig -> [XPMode] -> X()
|
launcherPrompt :: XPConfig -> [XPMode] -> X()
|
||||||
|
@ -105,7 +105,7 @@ handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
|
|||||||
handleResize _ _ = return ()
|
handleResize _ _ = return ()
|
||||||
|
|
||||||
createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
|
createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
|
||||||
createInputWindow ((w,r),mr) = do
|
createInputWindow ((w,r),mr) =
|
||||||
case mr of
|
case mr of
|
||||||
Just tr -> withDisplay $ \d -> do
|
Just tr -> withDisplay $ \d -> do
|
||||||
tw <- mkInputWindow d tr
|
tw <- mkInputWindow d tr
|
||||||
|
@ -136,11 +136,11 @@ withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
|
|||||||
setPosition posRef pos targetRect
|
setPosition posRef pos targetRect
|
||||||
|
|
||||||
trackMovement :: IORef WNState -> X ()
|
trackMovement :: IORef WNState -> X ()
|
||||||
trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do
|
trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
|
||||||
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
|
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
|
||||||
|
|
||||||
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
|
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
|
||||||
fromCurrentPoint posRef f = withFocused $ \win -> do
|
fromCurrentPoint posRef f = withFocused $ \win ->
|
||||||
currentPosition posRef >>= f win
|
currentPosition posRef >>= f win
|
||||||
|
|
||||||
-- Gets the current position from the IORef passed in, or if nothing (say, from
|
-- Gets the current position from the IORef passed in, or if nothing (say, from
|
||||||
|
@ -110,8 +110,7 @@ getWorkspaceName w = ($ w) <$> getWorkspaceNames'
|
|||||||
|
|
||||||
-- | Gets the name of the current workspace. See 'getWorkspaceName'
|
-- | Gets the name of the current workspace. See 'getWorkspaceName'
|
||||||
getCurrentWorkspaceName :: X (Maybe String)
|
getCurrentWorkspaceName :: X (Maybe String)
|
||||||
getCurrentWorkspaceName = do
|
getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset)
|
||||||
getWorkspaceName =<< gets (W.currentTag . windowset)
|
|
||||||
|
|
||||||
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
|
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
|
||||||
-- again.
|
-- again.
|
||||||
@ -129,7 +128,7 @@ setCurrentWorkspaceName name = do
|
|||||||
|
|
||||||
-- | Prompt for a new name for the current workspace and set it.
|
-- | Prompt for a new name for the current workspace and set it.
|
||||||
renameWorkspace :: XPConfig -> X ()
|
renameWorkspace :: XPConfig -> X ()
|
||||||
renameWorkspace conf = do
|
renameWorkspace conf =
|
||||||
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
|
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
|
||||||
where pr = Wor "Workspace name: "
|
where pr = Wor "Workspace name: "
|
||||||
|
|
||||||
|
@ -145,14 +145,14 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
|
|||||||
-- Remap the current workspace to handle any renames that f might be doing.
|
-- Remap the current workspace to handle any renames that f might be doing.
|
||||||
let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
|
let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
|
||||||
current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
|
current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
|
||||||
whenChanged (CurrentDesktop $ fromMaybe 0 current) $ do
|
whenChanged (CurrentDesktop $ fromMaybe 0 current) $
|
||||||
mapM_ setCurrentDesktop current
|
mapM_ setCurrentDesktop current
|
||||||
|
|
||||||
-- Set window-desktop mapping
|
-- Set window-desktop mapping
|
||||||
let windowDesktops =
|
let windowDesktops =
|
||||||
let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
|
let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
|
||||||
in M.unions $ zipWith f [0..] ws
|
in M.unions $ zipWith f [0..] ws
|
||||||
whenChanged (WindowDesktops windowDesktops) $ do
|
whenChanged (WindowDesktops windowDesktops) $
|
||||||
mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
|
mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
|
||||||
|
|
||||||
-- Set active window
|
-- Set active window
|
||||||
@ -201,13 +201,13 @@ handle f (ClientMessageEvent {
|
|||||||
if 0 <= n && fi n < length ws then
|
if 0 <= n && fi n < length ws then
|
||||||
windows $ W.shiftWin (W.tag (ws !! fi n)) w
|
windows $ W.shiftWin (W.tag (ws !! fi n)) w
|
||||||
else trace $ "Bad _NET_DESKTOP with data[0]="++show n
|
else trace $ "Bad _NET_DESKTOP with data[0]="++show n
|
||||||
else if mt == a_aw then do
|
else if mt == a_aw then
|
||||||
windows $ W.focusWindow w
|
windows $ W.focusWindow w
|
||||||
else if mt == a_cw then do
|
else if mt == a_cw then
|
||||||
killWindow w
|
killWindow w
|
||||||
else if mt `elem` a_ignore then do
|
else if mt `elem` a_ignore then
|
||||||
return ()
|
return ()
|
||||||
else do
|
else
|
||||||
-- The Message is unknown to us, but that is ok, not all are meant
|
-- The Message is unknown to us, but that is ok, not all are meant
|
||||||
-- to be handled by the window manager
|
-- to be handled by the window manager
|
||||||
return ()
|
return ()
|
||||||
|
@ -104,11 +104,11 @@ instance ExtensionClass StrutCache where
|
|||||||
initialValue = StrutCache M.empty
|
initialValue = StrutCache M.empty
|
||||||
|
|
||||||
updateStrutCache :: Window -> [Strut] -> X Bool
|
updateStrutCache :: Window -> [Strut] -> X Bool
|
||||||
updateStrutCache w strut = do
|
updateStrutCache w strut =
|
||||||
XS.modified $ StrutCache . M.insert w strut . fromStrutCache
|
XS.modified $ StrutCache . M.insert w strut . fromStrutCache
|
||||||
|
|
||||||
deleteFromStructCache :: Window -> X Bool
|
deleteFromStructCache :: Window -> X Bool
|
||||||
deleteFromStructCache w = do
|
deleteFromStructCache w =
|
||||||
XS.modified $ StrutCache . M.delete w . fromStrutCache
|
XS.modified $ StrutCache . M.delete w . fromStrutCache
|
||||||
|
|
||||||
-- | Detects if the given window is of type DOCK and if so, reveals
|
-- | Detects if the given window is of type DOCK and if so, reveals
|
||||||
@ -116,7 +116,7 @@ deleteFromStructCache w = do
|
|||||||
manageDocks :: ManageHook
|
manageDocks :: ManageHook
|
||||||
manageDocks = checkDock --> (doIgnore <+> setDocksMask)
|
manageDocks = checkDock --> (doIgnore <+> setDocksMask)
|
||||||
where setDocksMask = do
|
where setDocksMask = do
|
||||||
ask >>= \win -> liftX $ withDisplay $ \dpy -> do
|
ask >>= \win -> liftX $ withDisplay $ \dpy ->
|
||||||
io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
|
io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
|
||||||
mempty
|
mempty
|
||||||
|
|
||||||
|
@ -99,7 +99,7 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do
|
|||||||
|
|
||||||
positionStoreEventHook :: Event -> X All
|
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) $ do
|
when (et == destroyNotify) $
|
||||||
modifyPosStore (\ps -> posStoreRemove ps w)
|
modifyPosStore (\ps -> posStoreRemove ps w)
|
||||||
return (All True)
|
return (All True)
|
||||||
positionStoreEventHook _ = return (All True)
|
positionStoreEventHook _ = return (All True)
|
||||||
|
@ -356,7 +356,7 @@ handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
|
|||||||
handleEvent wuh event =
|
handleEvent wuh event =
|
||||||
case event of
|
case event of
|
||||||
-- WM_HINTS urgency flag
|
-- WM_HINTS urgency flag
|
||||||
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
|
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } ->
|
||||||
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
|
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
|
||||||
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
|
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
|
||||||
|
@ -73,7 +73,7 @@ autoLayout k bias wksp rect = do
|
|||||||
let n = length ws
|
let n = length ws
|
||||||
if null ws then
|
if null ws then
|
||||||
runLayout wksp rect
|
runLayout wksp rect
|
||||||
else do
|
else
|
||||||
if (n<=k) then
|
if (n<=k) then
|
||||||
return ((divideRow rect ws),Nothing)
|
return ((divideRow rect ws),Nothing)
|
||||||
else do
|
else do
|
||||||
|
@ -319,7 +319,7 @@ handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew
|
|||||||
distFromLeft = ex - fi dx
|
distFromLeft = ex - fi dx
|
||||||
distFromRight = fi dwh - (ex - fi dx)
|
distFromRight = fi dwh - (ex - fi dx)
|
||||||
dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)
|
dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)
|
||||||
when (not dealtWith) $ do
|
when (not dealtWith) $
|
||||||
mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)
|
mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)
|
||||||
(decorationAfterDraggingHook ds (mainw, r) ew)
|
(decorationAfterDraggingHook ds (mainw, r) ew)
|
||||||
handleMouseFocusDrag _ _ _ = return ()
|
handleMouseFocusDrag _ _ _ = return ()
|
||||||
|
@ -81,14 +81,14 @@ handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
|
|||||||
-- layout specific messages
|
-- layout specific messages
|
||||||
| Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
|
| Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
|
||||||
| Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
|
| Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
|
||||||
| Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
|
| Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
|
||||||
return $ Just (DragPane mb ty delta frac)
|
return $ Just (DragPane mb ty delta frac)
|
||||||
handleMess _ _ = return Nothing
|
handleMess _ _ = return Nothing
|
||||||
|
|
||||||
handleEvent :: DragPane a -> Event -> X ()
|
handleEvent :: DragPane a -> Event -> X ()
|
||||||
handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
|
handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
|
||||||
(ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
|
(ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
|
||||||
| t == buttonPress && thisw == win || thisbw == win = do
|
| t == buttonPress && thisw == win || thisbw == win =
|
||||||
mouseDrag (\ex ey -> do
|
mouseDrag (\ex ey -> do
|
||||||
let frac = case ty of
|
let frac = case ty of
|
||||||
Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
|
Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
|
||||||
|
@ -113,7 +113,7 @@ applyMaster f k _ frac wksp rect = do
|
|||||||
let st= S.stack wksp
|
let st= S.stack wksp
|
||||||
let ws = S.integrate' $ st
|
let ws = S.integrate' $ st
|
||||||
let n = length ws + fromEnum f
|
let n = length ws + fromEnum f
|
||||||
if n > 1 then do
|
if n > 1 then
|
||||||
if(n<=k) then
|
if(n<=k) then
|
||||||
return ((divideCol rect ws), Nothing)
|
return ((divideCol rect ws), Nothing)
|
||||||
else do
|
else do
|
||||||
|
@ -65,7 +65,7 @@ instance LayoutClass PositionStoreFloat Window where
|
|||||||
Just changedRect -> (w, changedRect)
|
Just changedRect -> (w, changedRect)
|
||||||
let wrs' = focused : wrs
|
let wrs' = focused : wrs
|
||||||
let paintOrder' = nub (w : paintOrder)
|
let paintOrder' = nub (w : paintOrder)
|
||||||
when (isJust maybeChange) $ do
|
when (isJust maybeChange) $
|
||||||
updatePositionStore focused sr
|
updatePositionStore focused sr
|
||||||
return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))
|
return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))
|
||||||
where
|
where
|
||||||
|
@ -525,7 +525,7 @@ mkXPromptWithModes modes conf = do
|
|||||||
om = XPMultipleModes modeStack
|
om = XPMultipleModes modeStack
|
||||||
st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om
|
st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om
|
||||||
if successful st'
|
if successful st'
|
||||||
then do
|
then
|
||||||
case operationMode st' of
|
case operationMode st' of
|
||||||
XPMultipleModes ms -> let
|
XPMultipleModes ms -> let
|
||||||
action = modeAction $ W.focus ms
|
action = modeAction $ W.focus ms
|
||||||
@ -595,7 +595,7 @@ runXP st = do
|
|||||||
(grabKeyboard d w True grabModeAsync grabModeAsync currentTime)
|
(grabKeyboard d w True grabModeAsync grabModeAsync currentTime)
|
||||||
(\_ -> ungrabKeyboard d currentTime)
|
(\_ -> ungrabKeyboard d currentTime)
|
||||||
(\status ->
|
(\status ->
|
||||||
(flip execStateT st $ do
|
(flip execStateT st $
|
||||||
when (status == grabSuccess) $ do
|
when (status == grabSuccess) $ do
|
||||||
updateWindows
|
updateWindows
|
||||||
eventLoop handleMain evDefaultStop)
|
eventLoop handleMain evDefaultStop)
|
||||||
@ -772,7 +772,7 @@ handleInputSubmap :: XP ()
|
|||||||
-> KeyMask
|
-> KeyMask
|
||||||
-> KeyStroke
|
-> KeyStroke
|
||||||
-> XP ()
|
-> XP ()
|
||||||
handleInputSubmap defaultAction keymap keymask (keysym,keystr) = do
|
handleInputSubmap defaultAction keymap keymask (keysym,keystr) =
|
||||||
case M.lookup (keymask,keysym) keymap of
|
case M.lookup (keymask,keysym) keymap of
|
||||||
Just action -> action >> updateWindows
|
Just action -> action >> updateWindows
|
||||||
Nothing -> unless (null keystr) $ defaultAction >> updateWindows
|
Nothing -> unless (null keystr) $ defaultAction >> updateWindows
|
||||||
@ -829,7 +829,7 @@ handleInputBuffer :: (String -> String -> (Bool,Bool))
|
|||||||
-> KeyStroke
|
-> KeyStroke
|
||||||
-> Event
|
-> Event
|
||||||
-> XP ()
|
-> XP ()
|
||||||
handleInputBuffer f keymask (keysym,keystr) event = do
|
handleInputBuffer f keymask (keysym,keystr) event =
|
||||||
unless (null keystr || keymask .&. controlMask /= 0) $ do
|
unless (null keystr || keymask .&. controlMask /= 0) $ do
|
||||||
(evB,inB) <- gets (eventBuffer &&& inputBuffer)
|
(evB,inB) <- gets (eventBuffer &&& inputBuffer)
|
||||||
let keystr' = utf8Decode keystr
|
let keystr' = utf8Decode keystr
|
||||||
|
@ -136,7 +136,7 @@ someNamedScratchpadAction f confs n
|
|||||||
((maybe [] W.integrate . W.stack . W.workspace . W.current) s)
|
((maybe [] W.integrate . W.stack . W.workspace . W.current) s)
|
||||||
filterAll <- filterM (runQuery (query conf)) (W.allWindows s)
|
filterAll <- filterM (runQuery (query conf)) (W.allWindows s)
|
||||||
case filterCurrent of
|
case filterCurrent of
|
||||||
[] -> do
|
[] ->
|
||||||
case filterAll of
|
case filterAll of
|
||||||
[] -> runApplication conf
|
[] -> runApplication conf
|
||||||
_ -> f (windows . W.shiftWin (W.currentTag s)) filterAll
|
_ -> f (windows . W.shiftWin (W.currentTag s)) filterAll
|
||||||
|
Loading…
x
Reference in New Issue
Block a user