mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Compile with ghc7
This commit is contained in:
parent
8056bb5c2c
commit
2ab79a7c35
@ -35,11 +35,6 @@ import Data.List (find)
|
|||||||
import Data.Maybe (isNothing)
|
import Data.Maybe (isNothing)
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
|
||||||
-- The following imports are to allow haddock to find links for documentation
|
|
||||||
-- only.
|
|
||||||
import XMonad.Actions.CopyWindow (copy)
|
|
||||||
import XMonad.Prompt (defaultXPConfig)
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||||
--
|
--
|
||||||
|
@ -82,17 +82,17 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
pointer <- io $ queryPointer d w >>= return . pointerPos
|
pointer <- io $ queryPointer d w >>= return . pointerPos
|
||||||
|
|
||||||
let uv = (pointer - wpos) / wsize
|
let uv = zipP (/) (zipP (-) pointer wpos) wsize
|
||||||
fc = mapP f uv
|
fc = mapP f uv
|
||||||
mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
|
mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
|
||||||
atl = ((1, 1) - fc) * mul
|
atl = zipP (*) (zipP (-) (1, 1) fc) mul
|
||||||
abr = fc * mul
|
abr = zipP (*) fc mul
|
||||||
mouseDrag (\ex ey -> io $ do
|
mouseDrag (\ex ey -> io $ do
|
||||||
let offset = (fromIntegral ex, fromIntegral ey) - pointer
|
let offset = zipP (-) (fromIntegral ex, fromIntegral ey) pointer
|
||||||
npos = wpos + offset * atl
|
npos = zipP (*) wpos $ zipP (*) offset atl
|
||||||
nbr = (wpos + wsize) + offset * abr
|
nbr = zipP (+) (zipP (+) wpos wsize) (zipP (*) offset abr)
|
||||||
ntl = minP (nbr - (32, 32)) npos --minimum size
|
ntl = minP (zipP (-) nbr (32, 32)) npos --minimum size
|
||||||
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
|
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (zipP (-) nbr ntl)
|
||||||
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
|
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
|
||||||
return ())
|
return ())
|
||||||
(float w)
|
(float w)
|
||||||
@ -100,14 +100,14 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
float w
|
float w
|
||||||
|
|
||||||
where
|
where
|
||||||
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
|
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py)
|
||||||
winAttrs :: WindowAttributes -> [Pnt]
|
winAttrs :: WindowAttributes -> [(Double, Double)]
|
||||||
winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
|
winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
|
||||||
|
-- Changed the type = Pnt implementation to use the zipP functionality
|
||||||
|
-- because (on ghc7) the previous implementation caused Orphan Instances
|
||||||
|
-- warnings
|
||||||
|
|
||||||
|
|
||||||
-- I'd rather I didn't have to do this, but I hate writing component 2d math
|
|
||||||
type Pnt = (Double, Double)
|
|
||||||
|
|
||||||
pairUp :: [a] -> [(a,a)]
|
pairUp :: [a] -> [(a,a)]
|
||||||
pairUp [] = []
|
pairUp [] = []
|
||||||
pairUp [_] = []
|
pairUp [_] = []
|
||||||
@ -120,15 +120,3 @@ zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
|
|||||||
|
|
||||||
minP :: Ord a => (a,a) -> (a,a) -> (a,a)
|
minP :: Ord a => (a,a) -> (a,a) -> (a,a)
|
||||||
minP = zipP min
|
minP = zipP min
|
||||||
|
|
||||||
instance Num Pnt where
|
|
||||||
(+) = zipP (+)
|
|
||||||
(-) = zipP (-)
|
|
||||||
(*) = zipP (*)
|
|
||||||
abs = mapP abs
|
|
||||||
signum = mapP signum
|
|
||||||
fromInteger = const undefined
|
|
||||||
|
|
||||||
instance Fractional Pnt where
|
|
||||||
fromRational = const undefined
|
|
||||||
recip = mapP recip
|
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Copyright : (c) Spencer Janssen 2007
|
-- Copyright : (c) Spencer Janssen 2007
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
|
{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
|
||||||
{-# OPTIONS -fglasgow-exts #-}
|
|
||||||
-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
|
-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
|
@ -442,12 +442,12 @@ defaultXPKeymap = M.fromList $
|
|||||||
keyPressHandle :: KeyMask -> KeyStroke -> XP ()
|
keyPressHandle :: KeyMask -> KeyStroke -> XP ()
|
||||||
keyPressHandle m (ks,str) = do
|
keyPressHandle m (ks,str) = do
|
||||||
km <- gets (promptKeymap . config)
|
km <- gets (promptKeymap . config)
|
||||||
mask <- cleanMask m
|
kmask <- cleanMask m -- mask is defined in ghc7
|
||||||
case M.lookup (mask,ks) km of
|
case M.lookup (kmask,ks) km of
|
||||||
Just action -> action >> updateWindows
|
Just action -> action >> updateWindows
|
||||||
Nothing -> case str of
|
Nothing -> case str of
|
||||||
"" -> eventLoop handle
|
"" -> eventLoop handle
|
||||||
_ -> when (mask .&. controlMask == 0) $ do
|
_ -> when (kmask .&. controlMask == 0) $ do
|
||||||
insertString (decodeString str)
|
insertString (decodeString str)
|
||||||
updateWindows
|
updateWindows
|
||||||
completed <- tryAutoComplete
|
completed <- tryAutoComplete
|
||||||
|
@ -105,11 +105,11 @@ it makes use of shell interpretation by relying on @$HOME@ and
|
|||||||
interpolation, whereas the safeSpawn example can be safe because
|
interpolation, whereas the safeSpawn example can be safe because
|
||||||
Firefox doesn't need any arguments if it is just being started. -}
|
Firefox doesn't need any arguments if it is just being started. -}
|
||||||
safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
|
safeSpawn :: MonadIO m => FilePath -> [String] -> m ()
|
||||||
safeSpawn prog args = io $ void $ forkProcess $ do
|
safeSpawn prog args = io $ void_ $ forkProcess $ do
|
||||||
uninstallSignalHandlers
|
uninstallSignalHandlers
|
||||||
_ <- createSession
|
_ <- createSession
|
||||||
executeFile prog True args Nothing
|
executeFile prog True args Nothing
|
||||||
where void = (>> return ()) -- TODO: replace with Control.Monad.void
|
where void_ = (>> return ()) -- TODO: replace with Control.Monad.void / void not in ghc6 apparently
|
||||||
|
|
||||||
-- | Simplified 'safeSpawn'; only takes a program (and no arguments):
|
-- | Simplified 'safeSpawn'; only takes a program (and no arguments):
|
||||||
--
|
--
|
||||||
|
Loading…
x
Reference in New Issue
Block a user