From 8927ac2d579b192a176901602c8e73951d45f963 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Sat, 3 Oct 2009 21:38:04 +0200 Subject: Add a GSCONFIG class to overload defaultGSConfig. Ignore-this: 220a13bf1ee145b18f28c66e32c79266 This uses -XOverlappingInstances to provide a fallback instance which uses the focusedBorderColor and normalBorderColor, but that part is optional. User's configs should use -XNoMonomorphismRestriction if they want to avoid writing a type signature for myGSConfig. Also, type variables become ambiguous in expressions like: > myGSConfig darcs-hash:20091003193804-1499c-ae124fc732c4bc956ace090b57681f2463441990.gz --- XMonad/Actions/GridSelect.hs | 44 ++++++++++++++++++++++++++++++-------------- XMonad/Actions/WindowMenu.hs | 9 +-------- 2 files changed, 31 insertions(+), 22 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs index 4ca34bc..ff2d4ae 100644 --- a/XMonad/Actions/GridSelect.hs +++ b/XMonad/Actions/GridSelect.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.GridSelect @@ -20,10 +20,9 @@ module XMonad.Actions.GridSelect ( -- * Configuration GSConfig(..), + GSCONFIG(defaultGSConfig), NavigateMap, TwoDPosition, - defaultGSConfig, - defaultGSSpawnConfig, buildDefaultGSConfig, -- * Variations on 'gridselect' @@ -75,7 +74,7 @@ import Data.Word (Word8) -- the user select from it. E.g. to spawn an application from a given list, you -- can use the following: -- --- > , ((modMask x, xK_s), spawnSelected defaultGSSpawnConfig ["xterm","gmplayer","gvim"]) +-- > , ((modMask x, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"]) -- $screenshots -- @@ -98,6 +97,31 @@ data GSConfig a = GSConfig { gs_originFractY :: Double } +class GSCONFIG a where + defaultGSConfig :: GSConfig a -- ^ A basic configuration for 'gridselect'. + -- To configure your own colorizer, use + -- 'buildDefaultGSConfig', otherwise the + -- default colorizer with the correct type + -- will be used. + -- + -- That is 'fromClassName' if + -- you are selecting a 'Window', or + -- 'defaultColorizer' if you are selecting a + -- 'String'. The catch-all instance @GSCONFIG + -- a@ uses the 'focusedBorderColor' and + -- 'normalBorderColor' colors. + +instance GSCONFIG Window where + defaultGSConfig = buildDefaultGSConfig fromClassName + +instance GSCONFIG String where + defaultGSConfig = buildDefaultGSConfig defaultColorizer + +instance GSCONFIG a where + defaultGSConfig = buildDefaultGSConfig $ \_ isFg -> do + let getColor = if isFg then focusedBorderColor else normalBorderColor + asks $ flip (,) "black" . getColor . config + type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition) type TwoDPosition = (Integer, Integer) @@ -334,9 +358,8 @@ gridselect gsconfig elmap = font <- initXMF (gs_font gsconfig) let screenWidth = toInteger $ rect_width s; screenHeight = toInteger $ rect_height s; - selectedElement <- if (status == grabSuccess) then - do - let restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2 + selectedElement <- if (status == grabSuccess) then do + let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double restrictX = floor $ restriction screenWidth gs_cellwidth restrictY = floor $ restriction screenHeight gs_cellheight originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX @@ -386,10 +409,6 @@ decorateName' :: Window -> X String decorateName' w = do fmap show $ getName w --- | The default 'GSConfig' to use when selecting windows. -defaultGSConfig :: GSConfig Window -defaultGSConfig = buildDefaultGSConfig fromClassName - -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2) @@ -420,9 +439,6 @@ bringSelected = withSelectedWindow $ \w -> do goToSelected :: GSConfig Window -> X () goToSelected = withSelectedWindow $ windows . W.focusWindow -defaultGSSpawnConfig :: GSConfig String -defaultGSSpawnConfig = buildDefaultGSConfig defaultColorizer - -- | Select an application to spawn from a given list spawnSelected :: GSConfig String -> [String] -> X () spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn diff --git a/XMonad/Actions/WindowMenu.hs b/XMonad/Actions/WindowMenu.hs index 0401424..9d30823 100644 --- a/XMonad/Actions/WindowMenu.hs +++ b/XMonad/Actions/WindowMenu.hs @@ -41,21 +41,14 @@ import XMonad.Util.XUtils (fi) -- -- > , ((modMask x, xK_o ), windowMenu) -simpleColorizer :: (Monad m) => t -> t -> t1 -> Bool -> m (t, [Char]) -simpleColorizer nBC _ _ False = return (nBC, "black") -simpleColorizer _ fBC _ True = return (fBC, "black") - windowMenu :: X () windowMenu = withFocused $ \w -> do - nBC <- asks (normalBorderColor . config) - fBC <- asks (focusedBorderColor . config) tags <- asks (workspaces . config) Rectangle x y wh ht <- getSize w Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset let originFractX = (fi x - fi sx + fi wh / 2) / fi swh originFractY = (fi y - fi sy + fi ht / 2) / fi sht - colorizer = simpleColorizer nBC fBC - gsConfig = (buildDefaultGSConfig colorizer) + gsConfig = defaultGSConfig { gs_originFractX = originFractX , gs_originFractY = originFractY } actions = [ ("Cancel menu", return ()) -- cgit v1.2.3