mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -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:
Tony Zorman
parent
42179b8625
commit
105e529826
@ -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,7 +241,7 @@ 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
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -96,9 +96,9 @@ 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 (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
|
||||
|
||||
@ -43,8 +43,10 @@ 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 (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
|
||||
|
||||
|
||||
@ -186,14 +186,15 @@ 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)
|
||||
|
||||
let (workspace, screen) = head 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
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ServerMode
|
||||
@ -91,11 +92,12 @@ 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)
|
||||
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)
|
||||
| otherwise -> pure ()
|
||||
return (All True)
|
||||
serverModeEventHookF _ _ _ = return (All True)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -55,18 +55,20 @@ 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)]
|
||||
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 ws = W.integrate stack
|
||||
n = length ws
|
||||
where
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)))
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user