mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-31 20:21:51 -07:00
Fix partial uses of head
Fixes: https://github.com/xmonad/xmonad-contrib/issues/830 Related: https://github.com/xmonad/xmonad-contrib/pull/836
This commit is contained in:
@@ -97,6 +97,7 @@ import XMonad.Actions.WindowBringer (bringWindow)
|
||||
import Text.Printf
|
||||
import System.Random (mkStdGen, randomR)
|
||||
import Data.Word (Word8)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
-- $usage
|
||||
--
|
||||
@@ -302,14 +303,14 @@ diamondLayer n =
|
||||
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..]
|
||||
diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
|
||||
diamond = fromList $ concatMap diamondLayer [0..]
|
||||
|
||||
diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
|
||||
diamondRestrict x y originX originY =
|
||||
L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
|
||||
map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
|
||||
take 1000 $ diamond
|
||||
takeS 1000 $ diamond
|
||||
|
||||
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
|
||||
findInElementMap pos = find ((== pos) . fst)
|
||||
@@ -658,7 +659,7 @@ gridselect gsconfig elements =
|
||||
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 = NE.head (notEmpty coords),
|
||||
td_availSlots = coords,
|
||||
td_elements = elements,
|
||||
td_gsconfig = gsconfig,
|
||||
|
@@ -66,6 +66,7 @@ import qualified XMonad.StackSet as W
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
|
||||
import XMonad.Util.Types
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
-- $usage
|
||||
-- #Usage#
|
||||
@@ -883,7 +884,7 @@ swap win winset = W.focusWindow cur
|
||||
-- Reconstruct the workspaces' window stacks to reflect the swap.
|
||||
newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
|
||||
newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
|
||||
newwinset = winset { W.current = head newscrs
|
||||
newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen.
|
||||
, W.visible = drop 1 newscrs
|
||||
}
|
||||
|
||||
|
@@ -41,6 +41,8 @@ import XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Util.Paste (sendKey)
|
||||
import XMonad.Actions.Submap (submapDefaultWithKey)
|
||||
import XMonad.Util.EZConfig (readKeySequence)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.List.NonEmpty ((<|))
|
||||
|
||||
{- $usage
|
||||
|
||||
@@ -129,7 +131,7 @@ usePrefixArgument :: LayoutClass l Window
|
||||
-> XConfig l
|
||||
-> XConfig l
|
||||
usePrefixArgument prefix conf =
|
||||
conf{ keys = M.insert binding (handlePrefixArg [binding]) . keys conf }
|
||||
conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf }
|
||||
where
|
||||
binding = case readKeySequence conf prefix of
|
||||
Just (key :| []) -> key
|
||||
@@ -141,7 +143,7 @@ useDefaultPrefixArgument :: LayoutClass l Window
|
||||
-> XConfig l
|
||||
useDefaultPrefixArgument = usePrefixArgument "C-u"
|
||||
|
||||
handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
|
||||
handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X ()
|
||||
handlePrefixArg events = do
|
||||
ks <- asks keyActions
|
||||
logger <- asks (logHook . config)
|
||||
@@ -162,12 +164,12 @@ handlePrefixArg events = do
|
||||
Raw _ -> XS.put $ Numeric x
|
||||
Numeric a -> XS.put $ Numeric $ a * 10 + x
|
||||
None -> return () -- should never happen
|
||||
handlePrefixArg (key:events)
|
||||
handlePrefixArg (key <| events)
|
||||
else do
|
||||
prefix <- XS.get
|
||||
mapM_ (uncurry sendKey) $ case prefix of
|
||||
Raw a -> replicate a (head events) ++ [key]
|
||||
_ -> reverse (key:events)
|
||||
Raw a -> replicate a (NE.head events) ++ [key]
|
||||
_ -> reverse (key : toList events)
|
||||
keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
|
||||
|
||||
-- | Turn a prefix-aware X action into an X-action.
|
||||
|
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.ShowText
|
||||
@@ -26,7 +27,7 @@ module XMonad.Actions.ShowText
|
||||
import Data.Map (Map,empty,insert,lookup)
|
||||
import Prelude hiding (lookup)
|
||||
import XMonad
|
||||
import XMonad.Prelude (All, fi, when)
|
||||
import XMonad.Prelude (All, fi, listToMaybe)
|
||||
import XMonad.StackSet (current,screen)
|
||||
import XMonad.Util.Font (Align(AlignCenter)
|
||||
, initXMF
|
||||
@@ -87,8 +88,9 @@ 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 && not (null d))
|
||||
(whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
|
||||
if | mtyp == a, Just dh <- listToMaybe d ->
|
||||
whenJust (lookup (fromIntegral dh) m) deleteWindow
|
||||
| otherwise -> pure ()
|
||||
mempty
|
||||
handleTimerEvent _ = mempty
|
||||
|
||||
|
@@ -63,6 +63,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Control.Arrow
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
|
||||
-- $usage
|
||||
@@ -240,8 +241,8 @@ swapApply ignoreFloats swapFunction = do
|
||||
(r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
|
||||
(b,s3) = swapFunction pm s2
|
||||
s4 = stackMerge s3 r
|
||||
mh = let w = head . W.integrate $ s3
|
||||
in const $ w : delete w ch
|
||||
mh = let w = NE.head . notEmpty . W.integrate $ s3
|
||||
in const $ w : delete w ch
|
||||
in (b,Just s4,mh)
|
||||
(x,y,z) = maybe (False,Nothing,id) swapApply' st
|
||||
-- Any floating master windows will be added to the history when 'windows'
|
||||
|
@@ -48,6 +48,8 @@ import XMonad.Operations (windows)
|
||||
import XMonad.Prompt.Shell (getBrowser, getEditor)
|
||||
import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
|
||||
import XMonad.Util.Run (safeSpawnProg)
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
|
||||
{- $usage
|
||||
|
||||
Import the module into your @~\/.xmonad\/xmonad.hs@:
|
||||
@@ -90,7 +92,10 @@ ifWindows qry f el = withWindowSet $ \wins -> do
|
||||
-- | The same as ifWindows, but applies a ManageHook to the first match
|
||||
-- instead and discards the other matches
|
||||
ifWindow :: Query Bool -> ManageHook -> X () -> X ()
|
||||
ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
|
||||
ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty)
|
||||
-- ifWindows guarantees that the list given to the function is
|
||||
-- non-empty. This should really use Data.List.NonEmpty, but, alas,
|
||||
-- that would be a breaking change.
|
||||
|
||||
{- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
|
||||
Presumably this executable is the same one that you were looking for.
|
||||
@@ -165,7 +170,8 @@ raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
|
||||
let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws
|
||||
-- cannot fail to match
|
||||
in windows $ focusFn y
|
||||
_ -> windows . focusFn . head $ ws
|
||||
_ -> windows . focusFn . NE.head . notEmpty $ ws
|
||||
-- ws is non-empty by ifWindows's definition.
|
||||
|
||||
-- | Given a function which gets us a String, we try to raise a window with that classname,
|
||||
-- or we then interpret that String as a executable name.
|
||||
|
@@ -109,5 +109,6 @@ shiftWs a = drop 1 a ++ take 1 a
|
||||
-- @WorkscreenId@.
|
||||
shiftToWorkscreen :: WorkscreenId -> X ()
|
||||
shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
|
||||
let ws = head . workspaces $ a !! wscrId
|
||||
windows $ W.shift ws
|
||||
case workspaces (a !! wscrId) of
|
||||
[] -> pure ()
|
||||
(w : _) -> windows $ W.shift w
|
||||
|
@@ -95,10 +95,10 @@ import XMonad.Prelude
|
||||
|
||||
-- | makeCursors requires a nonempty string, and each sublist must be nonempty
|
||||
makeCursors :: [[String]] -> Cursors String
|
||||
makeCursors [] = error "Workspace Cursors cannot be empty"
|
||||
makeCursors a = concat . reverse <$> foldl addDim x xs
|
||||
where x = end $ map return $ head a
|
||||
xs = map (map return) $ drop 1 a
|
||||
makeCursors [] = error "Workspace Cursors cannot be empty"
|
||||
makeCursors (a : as) = concat . reverse <$> foldl addDim x xs
|
||||
where x = end $ map return a
|
||||
xs = map (map return) as
|
||||
-- this could probably be simplified, but this true:
|
||||
-- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))
|
||||
-- the strange order is used because it makes the regular M-1..9
|
||||
|
Reference in New Issue
Block a user