diff options
| -rw-r--r-- | XMonad/Actions/SpawnOn.hs | 55 | ||||
| -rw-r--r-- | XMonad/Config/Sjanssen.hs | 11 | ||||
| -rw-r--r-- | XMonad/Hooks/DynamicHooks.hs | 71 | ||||
| -rw-r--r-- | XMonad/Hooks/UrgencyHook.hs | 41 |
4 files changed, 76 insertions, 102 deletions
diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs index e2734de..bdec270 100644 --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SpawnOn @@ -18,7 +19,6 @@ module XMonad.Actions.SpawnOn ( -- * Usage -- $usage Spawner, - mkSpawner, manageSpawn, spawnHere, spawnOn, @@ -28,7 +28,6 @@ module XMonad.Actions.SpawnOn ( ) where import Data.List (isInfixOf) -import Data.IORef import System.Posix.Types (ProcessID) import XMonad @@ -37,6 +36,7 @@ import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell +import XMonad.Util.ExtensibleState -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -44,17 +44,16 @@ import XMonad.Prompt.Shell -- > import XMonad.Actions.SpawnOn -- -- > main = do --- > sp <- mkSpawner -- > xmonad defaultConfig { -- > ... --- > manageHook = manageSpawn sp <+> manageHook defaultConfig +-- > manageHook = manageSpawn <+> manageHook defaultConfig -- > ... -- > } -- -- To ensure that application appears on a workspace it was launched at, add keybindings like: -- --- > , ((mod1Mask,xK_o), spawnHere sp "urxvt") --- > , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig) +-- > , ((mod1Mask,xK_o), spawnHere "urxvt") +-- > , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig) -- -- The module can also be used to apply other manage hooks to the window of -- the spawned application(e.g. float or resize it). @@ -62,26 +61,29 @@ import XMonad.Prompt.Shell -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]} +newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable + +instance ExtensionClass Spawner where + initialValue = Spawner [] maxPids :: Int maxPids = 5 --- | Create 'Spawner' which then has to be passed to other functions. -mkSpawner :: (Functor m, MonadIO m) => m Spawner -mkSpawner = io . fmap Spawner $ newIORef [] +-- | Get the current Spawner or create one if it doesn't exist. +modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () +modifySpawner f = putState . Spawner . f . pidsRef =<< getState -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. -manageSpawn :: Spawner -> ManageHook -manageSpawn sp = do - pids <- io . readIORef $ pidsRef sp +manageSpawn :: ManageHook +manageSpawn = do + Spawner pids <- liftX getState mp <- pid case flip lookup pids =<< mp of - Nothing -> doF id + Nothing -> idHook Just mh -> do whenJust mp $ \p -> - io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst) + liftX . modifySpawner $ filter ((/= p) . fst) mh mkPrompt :: (String -> X ()) -> XPConfig -> X () @@ -91,32 +93,31 @@ mkPrompt cb c = do -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on current workspace. -shellPromptHere :: Spawner -> XPConfig -> X () -shellPromptHere sp = mkPrompt (spawnHere sp) +shellPromptHere :: XPConfig -> X () +shellPromptHere = mkPrompt spawnHere -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on given workspace. -shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X () -shellPromptOn sp ws = mkPrompt (spawnOn sp ws) +shellPromptOn :: WorkspaceId -> XPConfig -> X () +shellPromptOn ws = mkPrompt (spawnOn ws) -- | Replacement for 'spawn' which launches -- application on current workspace. -spawnHere :: Spawner -> String -> X () -spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd +spawnHere :: String -> X () +spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd -- | Replacement for 'spawn' which launches -- application on given workspace. -spawnOn :: Spawner -> WorkspaceId -> String -> X () -spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd +spawnOn :: WorkspaceId -> String -> X () +spawnOn ws cmd = spawnAndDo (doShift ws) cmd -- | Spawn an application and apply the manage hook when it opens. -spawnAndDo :: Spawner -> ManageHook -> String -> X () -spawnAndDo sp mh cmd = do +spawnAndDo :: ManageHook -> String -> X () +spawnAndDo mh cmd = do p <- spawnPID $ mangle cmd - io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :)) + modifySpawner $ (take maxPids . ((p,mh) :)) where -- TODO this is silly, search for a better solution mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs | otherwise = "exec " ++ xs metaChars = "&|;" - diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs index ba7d11b..be5a72b 100644 --- a/XMonad/Config/Sjanssen.hs +++ b/XMonad/Config/Sjanssen.hs @@ -21,7 +21,7 @@ import XMonad.Layout.TwoPane import qualified Data.Map as M sjanssenConfig = do - sp <- mkSpawner :: IO Spawner + sp <- mkSpawner return . ewmh $ defaultConfig { terminal = "exec urxvt" , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] @@ -30,13 +30,12 @@ sjanssenConfig = do , ((modm, button2), (\w -> focus w >> windows W.swapMaster)) , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ] , keys = \c -> mykeys sp c `M.union` keys defaultConfig c - , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog , layoutHook = modifiers layouts , manageHook = composeAll [className =? x --> doShift w | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]] - <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp + <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn <+> (isFullscreen --> doFullFloat) } where @@ -44,9 +43,9 @@ sjanssenConfig = do layouts = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme modifiers = avoidStruts . smartBorders - mykeys sp (XConfig {modMask = modm}) = M.fromList $ - [((modm, xK_p ), shellPromptHere sp myPromptConfig) - ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config)) + mykeys (XConfig {modMask = modm}) = M.fromList $ + [((modm, xK_p ), shellPromptHere myPromptConfig) + ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config)) ,((modm .|. shiftMask, xK_c ), kill1) ,((modm .|. shiftMask .|. controlMask, xK_c ), kill) ,((modm .|. shiftMask, xK_0 ), windows $ copyToAll) diff --git a/XMonad/Hooks/DynamicHooks.hs b/XMonad/Hooks/DynamicHooks.hs index f4751d9..9d4d776 100644 --- a/XMonad/Hooks/DynamicHooks.hs +++ b/XMonad/Hooks/DynamicHooks.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicHooks @@ -15,20 +16,18 @@ module XMonad.Hooks.DynamicHooks ( -- * Usage -- $usage - initDynamicHooks - ,dynamicMasterHook + dynamicMasterHook ,addDynamicHook ,updateDynamicHook ,oneShotHook ) where import XMonad -import System.IO +import XMonad.Util.ExtensibleState import Data.List import Data.Maybe (listToMaybe) import Data.Monoid -import Data.IORef -- $usage -- Provides two new kinds of 'ManageHooks' that can be defined at runtime. @@ -40,68 +39,46 @@ import Data.IORef -- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@! -- If you want them to last, you should create them as normal in your @xmonad.hs@. -- --- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@: +-- To use this module, add 'dynamicMasterHook' to your 'manageHook': -- --- > dynHooksRef <- initDynamicHooks +-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook } -- --- and then pass this value to the other functions in this module. +-- You can then use the supplied functions in your keybindings: -- --- You also need to add the base 'ManageHook': --- --- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef } --- --- You must include this @dynHooksRef@ value when using the functions in this --- module: --- --- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList --- > [((modm, xK_i), oneShotHook dynHooksRef --- > "FFlaunchHook" (className =? "firefox") (doShift "3") --- > >> spawn "firefox") --- > ,((modm, xK_u), addDynamicHook dynHooksRef --- > (className =? "example" --> doFloat)) --- > ,((modm, xK_y), updatePermanentHook dynHooksRef --- > (const idHook))) ] -- resets the permanent hook. +-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat) -- data DynamicHooks = DynamicHooks { transients :: [(Query Bool, ManageHook)] , permanent :: ManageHook } + deriving Typeable +instance ExtensionClass DynamicHooks where + initialValue = DynamicHooks [] idHook --- | Creates the 'IORef' that stores the dynamically created 'ManageHook's. -initDynamicHooks :: IO (IORef DynamicHooks) -initDynamicHooks = newIORef (DynamicHooks { transients = [], - permanent = idHook }) - - --- this hook is always executed, and the IORef's contents checked. +-- this hook is always executed, and the contents of the stored hooks checked. -- note that transient hooks are run second, therefore taking precedence -- over permanent ones on matters such as which workspace to shift to. -- doFloat and doIgnore are idempotent. -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'. -dynamicMasterHook :: IORef DynamicHooks -> ManageHook -dynamicMasterHook ref = return True --> - (ask >>= \w -> liftX (do - dh <- io $ readIORef ref +dynamicMasterHook :: ManageHook +dynamicMasterHook = (ask >>= \w -> liftX (do + dh <- getState (Endo f) <- runQuery (permanent dh) w ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh) let (ts',nts) = partition fst ts gs <- mapM (flip runQuery w . snd . snd) ts' let (Endo g) = maybe (Endo id) id $ listToMaybe gs - io $ writeIORef ref $ dh { transients = map snd nts } + putState $ dh { transients = map snd nts } return $ Endo $ f . g )) - -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'. -addDynamicHook :: IORef DynamicHooks -> ManageHook -> X () -addDynamicHook ref m = updateDynamicHook ref (<+> m) - +addDynamicHook :: ManageHook -> X () +addDynamicHook m = updateDynamicHook (<+> m) -- | Modifies the permanent 'ManageHook' with an arbitrary function. -updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X () -updateDynamicHook ref f = - io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) } - +updateDynamicHook :: (ManageHook -> ManageHook) -> X () +updateDynamicHook f = modifyState $ \dh -> dh { permanent = f (permanent dh) } -- | Creates a one-shot 'ManageHook'. Note that you have to specify the two -- parts of the 'ManageHook' separately. Where you would usually write: @@ -112,11 +89,5 @@ updateDynamicHook ref f = -- -- > oneShotHook dynHooksRef (className =? "example) doFloat -- -oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X () -oneShotHook ref q a = - io $ modifyIORef ref - $ \dh -> dh { transients = (q,a):(transients dh) } - - - - +oneShotHook :: Query Bool -> ManageHook -> X () +oneShotHook q a = modifyState $ \dh -> dh { transients = (q,a):(transients dh) } diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs index 7faacc4..c69cecf 100644 --- a/XMonad/Hooks/UrgencyHook.hs +++ b/XMonad/Hooks/UrgencyHook.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable, + FlexibleInstances #-} ----------------------------------------------------------------------------- -- | @@ -71,17 +72,16 @@ import XMonad import qualified XMonad.StackSet as W import XMonad.Util.Dzen (dzenWithArgs, seconds) +import XMonad.Util.ExtensibleState import XMonad.Util.NamedWindows (getName) import XMonad.Util.Timer (TimerId, startTimer, handleTimer) import Control.Applicative ((<$>)) import Control.Monad (when) import Data.Bits (testBit) -import Data.IORef import Data.List (delete) import Data.Maybe (listToMaybe, maybeToList) import qualified Data.Set as S -import Foreign (unsafePerformIO) -- $usage -- @@ -213,6 +213,15 @@ withUrgencyHookC hook urgConf conf = conf { logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf } +data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable) + +onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents +onUrgents f = Urgents . f . fromUrgents + +instance ExtensionClass Urgents where + initialValue = Urgents [] + extensionType = PersistentExtension + -- | Global configuration, applied to all types of 'UrgencyHook'. See -- 'urgencyConfig' for the defaults. data UrgencyConfig = UrgencyConfig @@ -262,25 +271,18 @@ focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMayb clearUrgents :: X () clearUrgents = adjustUrgents (const []) >> adjustReminders (const []) --- | Stores the global set of all urgent windows, across workspaces. Not exported -- use --- 'readUrgents' or 'withUrgents' instead. -{-# NOINLINE urgents #-} -urgents :: IORef [Window] -urgents = unsafePerformIO (newIORef []) --- (Hey, I don't like it any more than you do.) - -- | X action that returns a list of currently urgent windows. You might use -- it, or 'withUrgents', in your custom logHook, to display the workspaces that -- contain urgent windows. readUrgents :: X [Window] -readUrgents = io $ readIORef urgents +readUrgents = fromUrgents <$> getState -- | An HOF version of 'readUrgents', for those who prefer that sort of thing. withUrgents :: ([Window] -> X a) -> X a withUrgents f = readUrgents >>= f adjustUrgents :: ([Window] -> [Window]) -> X () -adjustUrgents f = io $ modifyIORef urgents f +adjustUrgents f = modifyState $ onUrgents f type Interval = Rational @@ -290,18 +292,19 @@ data Reminder = Reminder { timer :: TimerId , window :: Window , interval :: Interval , remaining :: Maybe Int - } deriving Eq + } deriving (Show,Read,Eq,Typeable) + +instance ExtensionClass [Reminder] where + initialValue = [] + extensionType = PersistentExtension -- | Stores the list of urgency reminders. -{-# NOINLINE reminders #-} -reminders :: IORef [Reminder] -reminders = unsafePerformIO (newIORef []) readReminders :: X [Reminder] -readReminders = io $ readIORef reminders +readReminders = getState adjustReminders :: ([Reminder] -> [Reminder]) -> X () -adjustReminders f = io $ modifyIORef reminders f +adjustReminders f = modifyState f clearUrgency :: Window -> X () clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window) @@ -332,7 +335,7 @@ handleEvent wuh event = callUrgencyHook wuh w else clearUrgency w - userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified + userCodeDef () =<< asks (logHook . config) DestroyWindowEvent {ev_window = w} -> clearUrgency w _ -> |