twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-18 19:10:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Fix partial uses of head

Browse Source 
Fixes: https://github.com/xmonad/xmonad-contrib/issues/830
Related: https://github.com/xmonad/xmonad-contrib/pull/836
This commit is contained in:
Tony Zorman 2023-10-27 10:49:16 +02:00
parent 42179b8625
commit 105e529826
21 changed files with 141 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
XMonad/Actions/GridSelect.hs
View File

@ -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,

3
XMonad/Actions/Navigation2D.hs
View File

@ -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
}

12
XMonad/Actions/Prefix.hs
View File

@ -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.

8
XMonad/Actions/ShowText.hs
View File

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

5
XMonad/Actions/SwapPromote.hs
View File

@ -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'

10
XMonad/Actions/WindowGo.hs
View File

@ -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.

5
XMonad/Actions/Workscreen.hs
View File

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

8
XMonad/Actions/WorkspaceCursors.hs
View File

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

10
XMonad/Hooks/Minimize.hs
View File

@ -43,10 +43,12 @@ minimizeEventHook ClientMessageEvent{ev_window = w,
a_cs <- getAtom "WM_CHANGE_STATE"
when (mt == a_aw) $ maximizeWindow w
when (mt == a_cs) $ do
let message = fromIntegral . head $ dt
when (message == normalState) $ maximizeWindow w
when (message == iconicState) $ minimizeWindow w
when (mt == a_cs) $ case listToMaybe dt of
Nothing -> pure ()
Just dth -> do
let message = fromIntegral dth
when (message == normalState) $ maximizeWindow w
when (message == iconicState) $ minimizeWindow w
return (All True)
minimizeEventHook _ = return (All True)

21
XMonad/Hooks/Place.hs
View File

@ -186,21 +186,22 @@ placeHook p = do window <- ask
-- spawned. Each of them also needs an associated screen
-- rectangle; for hidden workspaces, we use the current
-- workspace's screen.
let infos = filter ((window `elem`) . stackContents . S.stack . fst)
let infos = find ((window `elem`) . stackContents . S.stack . fst)
$ [screenInfo $ S.current theWS]
++ map screenInfo (S.visible theWS)
++ map (, currentRect) (S.hidden theWS)
guard(not $ null infos)
case infos of
Nothing -> empty
Just info -> do
let (workspace, screen) = info
rs = mapMaybe (`M.lookup` allRs)
$ organizeClients workspace window floats
r' = purePlaceWindow p screen rs pointer r
newRect = r2rr screen r'
newFloats = M.insert window newRect (S.floating theWS)
let (workspace, screen) = head infos
rs = mapMaybe (`M.lookup` allRs)
$ organizeClients workspace window floats
r' = purePlaceWindow p screen rs pointer r
newRect = r2rr screen r'
newFloats = M.insert window newRect (S.floating theWS)
return $ theWS { S.floating = newFloats }
return $ theWS { S.floating = newFloats }
placeWindow :: Placement -> Window

16
XMonad/Hooks/ServerMode.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ServerMode
@ -89,13 +90,14 @@ serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_
--
serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
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
let atom = fromIntegral (head dt)
d <- asks display
atm <- io $ internAtom d key False
if | mt == atm, Just dth <- listToMaybe dt -> do
let atom = fromIntegral dth
cmd <- io $ getAtomName d atom
case cmd of
Just command -> func command
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)
return (All True)
Just command -> func command
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)
| otherwise -> pure ()
return (All True)
serverModeEventHookF _ _ _ = return (All True)

9
XMonad/Hooks/StatusBar/PP.hs
View File

@ -57,6 +57,7 @@ module XMonad.Hooks.StatusBar.PP (
import Control.Monad.Reader
import Control.DeepSeq
import qualified Data.List.NonEmpty as NE
import XMonad
import XMonad.Prelude
@ -463,8 +464,12 @@ xmobarStrip :: String -> String
xmobarStrip = converge (xmobarStripTags ["fc","icon","action"])
converge :: (Eq a) => (a -> a) -> a -> a
converge f a = let xs = iterate f a
in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ drop 1 xs
converge f a
= fst . NE.head . notEmpty -- If this function terminates, we will find a match.
. dropWhile (uncurry (/=))
. zip xs
$ drop 1 xs
where xs = iterate f a
xmobarStripTags :: [String] -- ^ tags
-> String -> String -- ^ with all \<tag\>...\</tag\> removed

8
XMonad/Layout/Combo.hs
View File

@ -28,7 +28,7 @@ module XMonad.Layout.Combo (
import XMonad hiding (focus)
import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..))
import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\))
import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe)
import XMonad.StackSet (Stack (..), Workspace (..), integrate')
import XMonad.Util.Stack (zipperFocusedAtFirstOf)
@ -124,9 +124,9 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
msuper' <- broadcastPrivate m [super]
if isJust msuper' || isJust ml1' || isJust ml2'
then return $ Just $ C2 f ws2
(maybe super head msuper')
(maybe l1 head ml1')
(maybe l2 head ml2')
(fromMaybe super (listToMaybe =<< msuper'))
(fromMaybe l1 (listToMaybe =<< ml1'))
(fromMaybe l2 (listToMaybe =<< ml2'))
else return Nothing
description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++
description l2 ++" with "++ description super

2
XMonad/Layout/MultiColumns.hs
View File

@ -97,7 +97,7 @@ instance LayoutClass MultiCol a where
where resize Shrink = l { multiColSize = max (-0.5) $ s-ds }
resize Expand = l { multiColSize = min 1 $ s+ds }
incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ drop 1 r }
where newval = max 0 $ head r + x
where newval = max 0 $ maybe 0 (x +) (listToMaybe r)
r = drop a n
n = multiColNWin l
ds = multiColDeltaSize l

36
XMonad/Layout/OneBig.hs
View File

@ -55,23 +55,25 @@ oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m)
-- | Main layout function
oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)]
oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)]
++ divideBottom bottomRect bottomWs
++ divideRight rightRect rightWs
where ws = W.integrate stack
n = length ws
ht (Rectangle _ _ _ hh) = hh
wd (Rectangle _ _ ww _) = ww
h' = round (fromIntegral (ht rect)*cy)
w = wd rect
m = calcBottomWs n w h'
master = head ws
other = drop 1 ws
bottomWs = take m other
rightWs = drop m other
masterRect = cmaster n m cx cy rect
bottomRect = cbottom cy rect
rightRect = cright cx cy rect
oneBigLayout (OneBig cx cy) rect stack =
let ws = W.integrate stack
n = length ws
in case ws of
[] -> []
(master : other) -> [(master,masterRect)]
++ divideBottom bottomRect bottomWs
++ divideRight rightRect rightWs
where
ht (Rectangle _ _ _ hh) = hh
wd (Rectangle _ _ ww _) = ww
h' = round (fromIntegral (ht rect)*cy)
w = wd rect
m = calcBottomWs n w h'
bottomWs = take m other
rightWs = drop m other
masterRect = cmaster n m cx cy rect
bottomRect = cbottom cy rect
rightRect = cright cx cy rect
-- | Calculate how many windows must be placed at bottom
calcBottomWs :: Int -> Dimension -> Dimension -> Int

12
XMonad/Layout/TallMastersCombo.hs
View File

@ -1,5 +1,9 @@
-- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
---------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.TallMastersCombo
@ -45,7 +49,7 @@ import XMonad hiding (focus, (|||))
import qualified XMonad.Layout as LL
import XMonad.Layout.Decoration
import XMonad.Layout.Simplest (Simplest (..))
import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust)
import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe)
import XMonad.StackSet (Stack (..), Workspace (..), integrate')
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (zipperFocusedAtFirstOf)
@ -245,14 +249,14 @@ instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombine
return $ mergeSubLayouts mlayout1 mlayout2 (TMSCombineTwo f w1 w2 (not vsp) nmaster delta frac layout1 layout2) True
| Just SwapSubMaster <- fromMessage m =
-- first get the submaster window
let subMaster = if null w2 then Nothing else Just $ head w2
let subMaster = listToMaybe w2
in case subMaster of
Just mw -> do windows $ W.modify' $ swapWindow mw
return Nothing
Nothing -> return Nothing
| Just FocusSubMaster <- fromMessage m =
-- first get the submaster window
let subMaster = if null w2 then Nothing else Just $ head w2
let subMaster = listToMaybe w2
in case subMaster of
Just mw -> do windows $ W.modify' $ focusWindow mw
return Nothing

49
XMonad/Prompt.hs
View File

@ -113,11 +113,13 @@ import Control.Monad.State
import Data.Bifunctor (bimap)
import Data.Bits
import Data.IORef
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Set (fromList, toList)
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Files
import Data.List.NonEmpty (nonEmpty)
-- $usage
-- For usage examples see "XMonad.Prompt.Shell",
@ -536,11 +538,11 @@ mkXPrompt t conf compl action = void $ mkXPromptWithReturn t conf compl action
-- The argument supplied to the action to execute is always the current highlighted item,
-- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.
mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
mkXPromptWithModes modes conf = do
let defaultMode = head modes
modeStack = W.Stack { W.focus = defaultMode -- Current mode
mkXPromptWithModes [] _ = pure ()
mkXPromptWithModes (defaultMode : modes) conf = do
let modeStack = W.Stack { W.focus = defaultMode -- Current mode
, W.up = []
, W.down = drop 1 modes -- Other modes
, W.down = modes -- Other modes
}
om = XPMultipleModes modeStack
st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om
@ -649,9 +651,9 @@ eventLoop handle stopAction = do
ks <- keycodeToKeysym d (ev_keycode ev) 0
return (ks, s, ev)
else return (noSymbol, "", ev)
l -> do
modify $ \s -> s { eventBuffer = drop 1 l }
return $ head l
(l : ls) -> do
modify $ \s -> s { eventBuffer = ls }
return l
handle (keysym,keystr) event
stopAction >>= \stop -> unless stop (eventLoop handle stopAction)
@ -785,8 +787,10 @@ handleCompletion dir cs = do
| -- We only have one suggestion, so we need to be a little
-- bit smart in order to avoid a loop.
length cs == 1 =
if command st == hlCompl then put st else replaceCompletion (head cs)
Just (ch :| []) <- nonEmpty cs =
if command st == hlCompl
then put st
else replaceCompletion ch
-- The current suggestion matches the command, so advance
-- to the next completion and try again.
@ -1396,11 +1400,11 @@ moveHistory f = do
-- starting cursor character is not considered, and the cursor is placed over
-- the matching character.
toHeadChar :: Direction1D -> String -> XP ()
toHeadChar d s = unless (null s) $ do
toHeadChar _ "" = pure ()
toHeadChar d (c : _) = do
cmd <- gets command
off <- gets offset
let c = head s
off' = (if d == Prev then negate . fst else snd)
let off' = (if d == Prev then negate . fst else snd)
. join (***) (maybe 0 (+1) . elemIndex c)
. (reverse *** drop 1)
$ splitAt off cmd
@ -1464,9 +1468,7 @@ redrawWindows
redrawWindows emptyAction compls = do
d <- gets dpy
drawWin
case compls of
[] -> emptyAction
l -> redrawComplWin l
maybe emptyAction redrawComplWin (nonEmpty compls)
io $ sync d False
where
-- | Draw the main prompt window.
@ -1485,14 +1487,14 @@ redrawWindows emptyAction compls = do
io $ freePixmap dpy pm
-- | Redraw the completion window, if necessary.
redrawComplWin :: [String] -> XP ()
redrawComplWin :: NonEmpty String -> XP ()
redrawComplWin compl = do
XPS{ showComplWin, complWinDim, complWin } <- get
nwi <- getComplWinDim compl
let recreate = do destroyComplWin
w <- createComplWin nwi
drawComplWin w compl
if compl /= [] && showComplWin
if showComplWin
then io (readIORef complWin) >>= \case
Just w -> case complWinDim of
Just wi -> if nwi == wi -- complWinDim did not change
@ -1566,7 +1568,7 @@ destroyComplWin = do
-- | Given the completions that we would like to show, calculate the
-- required dimensions for the completion windows.
getComplWinDim :: [String] -> XP ComplWindowDim
getComplWinDim :: NonEmpty String -> XP ComplWindowDim
getComplWinDim compl = do
XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get
let -- Height of a single completion row
@ -1607,7 +1609,7 @@ getComplWinDim compl = do
-- Get font ascent and descent. Coherence condition: we will print
-- everything using the same font.
(asc, desc) <- io $ textExtentsXMF fs $ head compl
(asc, desc) <- io $ textExtentsXMF fs $ NE.head compl
let yp = fi $ (ht + fi (asc - desc)) `div` 2 -- y position of the first row
yRows = take (fi rows) [yp, yp + fi ht ..] -- y positions of all rows
@ -1617,7 +1619,7 @@ getComplWinDim compl = do
pure $ ComplWindowDim x y winWidth rowHeight xCols yRows
-- | Draw the completion window.
drawComplWin :: Window -> [String] -> XP ()
drawComplWin :: Window -> NonEmpty String -> XP ()
drawComplWin w entries = do
XPS{ config, color, dpy, gcon } <- get
let scr = defaultScreenOfDisplay dpy
@ -1640,7 +1642,7 @@ printComplEntries
-> GC
-> String -- ^ Default foreground color
-> String -- ^ Default background color
-> [String] -- ^ Entries to be printed...
-> NonEmpty String -- ^ Entries to be printed...
-> ComplWindowDim -- ^ ...into a window of this size
-> XP ()
printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do
@ -1662,7 +1664,7 @@ printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do
where
-- | Create the completion matrix to be printed.
complMat :: [[String]]
= chunksOf (length cwRows) (take (length cwCols * length cwRows) entries)
= chunksOf (length cwRows) (take (length cwCols * length cwRows) (NE.toList entries))
-- | Find the column and row indexes in which a string appears.
-- If the string is not in the matrix, the indices default to @(0, 0)@.
@ -1808,7 +1810,8 @@ uniqSort = toList . fromList
-- immediately next to each other.
deleteAllDuplicates, deleteConsecutive :: [String] -> [String]
deleteAllDuplicates = nub
deleteConsecutive = map head . group
deleteConsecutive = map (NE.head . notEmpty) . group
-- The elements of group will always have at least one element.
newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String)))

3
XMonad/Prompt/OrgMode.hs
View File

@ -67,6 +67,7 @@ import XMonad.Util.XSelection (getSelection)
import XMonad.Util.Run
import Control.DeepSeq (deepseq)
import qualified Data.List.NonEmpty as NE (head)
import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian)
#if MIN_VERSION_time(1, 9, 0)
import Data.Time.Format.ISO8601 (iso8601Show)
@ -525,7 +526,7 @@ pInput inp = (`runParser` inp) . choice $
where
go :: String -> Parser String
go consumed = do
str <- munch (/= head ptn)
str <- munch (/= NE.head (notEmpty ptn))
word <- munch1 (/= ' ')
bool go pure (word == ptn) $ consumed <> str <> word

5
XMonad/Util/ExclusiveScratchpads.hs
View File

@ -46,6 +46,7 @@ import XMonad.Actions.TagWindows (addTag,delTag)
import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)
import qualified XMonad.StackSet as W
import qualified Data.List.NonEmpty as NE
-- $usage
--
@ -174,8 +175,8 @@ resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do
let ys = filterM (flip runQuery w . query) xs
unlessX (null <$> ys) $ do
mh <- head . map hook <$> ys -- ys /= [], so `head` is fine
n <- head . map name <$> ys -- same
mh <- NE.head . notEmpty . map hook <$> ys -- ys /= [], so `head` is fine
n <- NE.head . notEmpty . map name <$> ys -- same
(windows . appEndo <=< runQuery mh) w
hideOthers xs n

5
XMonad/Util/Image.hs
View File

@ -22,7 +22,8 @@ module XMonad.Util.Image
) where
import XMonad
import XMonad.Util.Font (stringToPixel,fi)
import XMonad.Prelude
import XMonad.Util.Font (stringToPixel)
-- | Placement of the icon in the title bar
data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner
@ -42,7 +43,7 @@ data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the up
-- | Gets the ('width', 'height') of an image
imageDims :: [[Bool]] -> (Int, Int)
imageDims img = (length (head img), length img)
imageDims img = (length (fromMaybe [] (listToMaybe img)), length img)
-- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing
-- the image given its 'Placement'

9
XMonad/Util/Timer.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.Timer
@ -20,9 +21,10 @@ module XMonad.Util.Timer
, TimerId
) where
import XMonad
import Control.Concurrent
import Data.Unique
import XMonad
import XMonad.Prelude (listToMaybe)
-- $usage
-- This module can be used to setup a timer to handle deferred events.
@ -53,7 +55,6 @@ handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer ti ClientMessageEvent{ev_message_type = mt, ev_data = dt} action = do
d <- asks display
a <- io $ internAtom d "XMONAD_TIMER" False
if mt == a && dt /= [] && fromIntegral (head dt) == ti
then action
else return Nothing
if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action
| otherwise -> return Nothing
handleTimer _ _ _ = return Nothing