Mon Jun 29 18:52:54 CEST 2009 Daniel Schoepe * Add an extensible state field to XState This patch adds functionality for other modules to store arbitrary data in XState. The patch also ensures that the data persists between restarts. This can be used to simplify modules that use IORefs to maintain some form of mutable state(e.g. X.A.SpawnOn), since passing around the IORef is now no longer necessary. The functionality is implemented by storing a Map String StateExtension in XState that associates string representations of data types with their values. These values have to implement Typeable, Show and Read. Proper instances for the latter two are only needed when one wants the data to be persistent between restarts. Mon Jun 29 22:18:11 CEST 2009 Daniel Schoepe * Add some convenience functions to ExtensibleState This patch adds some convenience functions to XMonad.ExtensibleState and fixes a bug. New patches: [Add an extensible state field to XState Daniel Schoepe **20090629165254 Ignore-this: 6930d4e528932b7659020d9d9b69158c This patch adds functionality for other modules to store arbitrary data in XState. The patch also ensures that the data persists between restarts. This can be used to simplify modules that use IORefs to maintain some form of mutable state(e.g. X.A.SpawnOn), since passing around the IORef is now no longer necessary. The functionality is implemented by storing a Map String StateExtension in XState that associates string representations of data types with their values. These values have to implement Typeable, Show and Read. Proper instances for the latter two are only needed when one wants the data to be persistent between restarts. ] { hunk ./Main.hs 40 let launch = catchIO buildLaunch >> xmonad defaultConfig case args of [] -> launch - ["--resume", _] -> launch + ["--resume", _, _] -> launch ["--help"] -> usage ["--recompile"] -> recompile True >> return () ["--restart"] -> sendRestart >> return () hunk ./XMonad.hs 23 module XMonad.Layout, module XMonad.ManageHook, module XMonad.Operations, + module XMonad.ExtensibleState, module Graphics.X11, module Graphics.X11.Xlib.Extras, (.|.), hunk ./XMonad.hs 40 import XMonad.Layout import XMonad.ManageHook import XMonad.Operations +import XMonad.ExtensibleState -- import XMonad.StackSet -- conflicts with 'workspaces' defined in XMonad.hs -- modules needed to get basic configuration working hunk ./XMonad/Config.hs 30 import XMonad.Core as XMonad hiding (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse - ,handleEventHook) + ,handleEventHook,stateExtensions) import qualified XMonad.Core as XMonad (workspaces,manageHook,numlockMask,keys,logHook,startupHook,borderWidth,mouseBindings ,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse hunk ./XMonad/Config.hs 34 - ,handleEventHook) + ,handleEventHook,stateExtensions) import XMonad.Layout import XMonad.Operations hunk ./XMonad/Config.hs 251 -- you may also bind events to the mouse scroll wheel (button4 and button5) ] +stateExtensions :: [StateExtension] +stateExtensions = [] + -- | And, finally, the default set of configuration values itself defaultConfig = XConfig { XMonad.borderWidth = borderWidth hunk ./XMonad/Config.hs 270 , XMonad.mouseBindings = mouseBindings , XMonad.manageHook = manageHook , XMonad.handleEventHook = handleEventHook - , XMonad.focusFollowsMouse = focusFollowsMouse } + , XMonad.focusFollowsMouse = focusFollowsMouse + , XMonad.stateExtensions = stateExtensions } hunk ./XMonad/Core.hs 27 XConf(..), XConfig(..), LayoutClass(..), Layout(..), readsLayout, Typeable, Message, SomeMessage(..), fromMessage, LayoutMessages(..), + StateExtension(..), ExtensionClass, runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, withDisplay, withWindowSet, isRoot, runOnWorkspaces, getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX, hunk ./XMonad/Core.hs 53 import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras (Event) import Data.Typeable -import Data.Maybe (isJust) import Data.Monoid hunk ./XMonad/Core.hs 54 -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe,isJust) import qualified Data.Map as M import qualified Data.Set as S hunk ./XMonad/Core.hs 61 -- | XState, the (mutable) window manager state. data XState = XState - { windowset :: !WindowSet -- ^ workspace list - , mapped :: !(S.Set Window) -- ^ the Set of mapped windows - , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents - , dragging :: !(Maybe (Position -> Position -> X (), X ())) } - + { windowset :: !WindowSet -- ^ workspace list + , mapped :: !(S.Set Window) -- ^ the Set of mapped windows + , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents + , dragging :: !(Maybe (Position -> Position -> X (), X ())) + , extensibleState :: !(M.Map String StateExtension) -- ^ stores custom state information + } -- | XConf, the (read-only) window manager configuration. data XConf = XConf { display :: Display -- ^ the X11 display hunk ./XMonad/Core.hs 105 , logHook :: !(X ()) -- ^ The action to perform when the windows set is changed , startupHook :: !(X ()) -- ^ The action to perform on startup , focusFollowsMouse :: !Bool -- ^ Whether window entry events can change focus + , stateExtensions :: [StateExtension] -- ^ List of extensions that store mutable state in XState } hunk ./XMonad/Core.hs 346 instance Message LayoutMessages +-- --------------------------------------------------------------------- +-- | Extensible state +-- +-- | Every module must make the data it wants to store +-- an instance of this class: +class (Read a, Show a, Typeable a) => ExtensionClass a + +data StateExtension = forall a . ExtensionClass a => StateExtension a + +instance Show StateExtension where + show (StateExtension e) = show e + -- --------------------------------------------------------------------- -- | General utilities -- addfile ./XMonad/ExtensibleState.hs hunk ./XMonad/ExtensibleState.hs 1 +{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.StateExtension +-- Copyright : (c) Daniel Schoepe 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : daniel.schoepe@gmail.com +-- Stability : unstable +-- Portability : not portable +-- +-- Module for storing custom mutable state in xmonad. +-- +----------------------------------------------------------------------------- + +module XMonad.ExtensibleState ( + -- * Usage + -- $usage + modifyStateExts + , addStateExt + , modifyStateExt + , removeStateExt + , getStateExt + , readExtVal + ) where + +import Data.Typeable (typeOf,Typeable) +import Data.List (find) +import qualified Data.Map as M +import XMonad.Core +import Control.Monad.State +import Unsafe.Coerce (unsafeCoerce) + +-- --------------------------------------------------------------------- +-- $usage +-- +-- To utilize this feature in a contrib module create a data type, +-- and make it an instance of ExtensionClass. You can then use +-- the functions from this module for storing your data: +-- +-- > {-# DeriveDataTypeable #-} +-- > +-- > data ListStorage = ListStorage [Integer] deriving (Read,Show,Typeable) +-- > instance ExtensionClass ListStorage +-- > +-- > .. addStateExt (ListStorage [23,42]) +-- +-- To retrieve the stored data call: +-- +-- > .. getStateExt +-- +-- If the type can't be infered from the usage of the retrieved data, you +-- might need to add an explicit type signature: +-- +-- > .. getStateExt :: X (Maybe ListStorage) +-- +-- If you want the data to be persistent between restarts, instruct the user +-- to add a type witness to the stateExtensions field of his config and supply +-- such a value: +-- +-- > myModuleExtension = StateExtension (undefined :: ListStorage) +-- > +-- > .. stateExtensions = [otherExtension, myModuleExtension] +-- +-- One should take care that the string representation of the chosen type +-- is unique among the stored values, otherwise it will be overwritten. +-- Normally these values are fully qualified module name when deriving Typeable, so +-- name collisions should not be a problem in most cases. +-- + +-- | Given a list of possible type witnesses and a pair of strings, +-- try to find a type whose representation matches the first string +-- and parse the second string as such. +readExtVal :: [StateExtension] -> (String,String) -> Maybe (String,StateExtension) +readExtVal es (t,val) = do + (StateExtension e) <- find (\(StateExtension a) -> show (typeOf a) == t) es + [(x,"")] <- return $ reads val + return . ((,) t) . StateExtension $ x `asTypeOf` e + +-- | Modify the map of state extensions by applying the given function. +-- Normally, one doesn't need to call this function directly, and should use +-- 'modifyStateExt' instead. +modifyStateExts :: (M.Map String StateExtension -> M.Map String StateExtension) -> X () +modifyStateExts f = modify $ \st -> st { extensibleState = f (extensibleState st) } + +-- | Apply a function to stored value of the matching type +modifyStateExt :: forall a . ExtensionClass a => (a -> a) -> X () +modifyStateExt f = do + Just ste <- getStateExt + let v = unsafeCoerce (ste :: a) :: a -- this safe, since getStateExt is guaranteed to return the + -- required type or Nothing. + modifyStateExts (M.insert (show . typeOf $ v) $ StateExtension (f v)) + +-- | Add a value to the extensible state field. A previously stored value with the same +-- type will be overwritten. (More precisely: A value whose string representation of its type +-- is equal to the new one's) +addStateExt :: ExtensionClass a => a -> X () +addStateExt v = modifyStateExts (M.insert (show . typeOf $ v) $ StateExtension v) + +-- | Try to retrieve a value of the requested type, return Nothing if there is no such value. +getStateExt :: forall a . ExtensionClass a => X (Maybe a) +getStateExt = do + Just (StateExtension val) <- gets (M.lookup (show . typeOf $ (undefined :: a)) . extensibleState) + if typeOf val == typeOf (undefined :: a) + then return . Just . unsafeCoerce $ val -- this is safe, since the types are checked by typeOf + else return Nothing + +-- | Remove the value from the extensible state field that has the same type as the supplied argument +removeStateExt :: ExtensionClass a => a -> X () +removeStateExt wit = modifyStateExts (M.delete (show . typeOf $ wit)) + hunk ./XMonad/Main.hsc 24 import qualified Data.Set as S import Control.Monad.Reader import Control.Monad.State -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe,catMaybes) import Data.Monoid (getAll) import Foreign.C hunk ./XMonad/Main.hsc 40 import XMonad.StackSet (new, floating, member) import qualified XMonad.StackSet as W import XMonad.Operations +import XMonad.ExtensibleState (readExtVal) import System.IO hunk ./XMonad/Main.hsc 97 let layout = layoutHook xmc lreads = readsLayout layout initialWinset = new layout (workspaces xmc) $ map SD xinesc - + exts = stateExtensions xmc maybeRead reads' s = case reads' s of [(x, "")] -> Just x _ -> Nothing hunk ./XMonad/Main.hsc 107 ws <- maybeRead reads s return . W.ensureTags layout (workspaces xmc) $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws + extState = fromMaybe M.empty $ do + ("--resume" : _ : dyns : _) <- return args + vals <- maybeRead reads dyns + return . M.fromList . catMaybes . map (readExtVal exts) . M.toList $ vals cf = XConf { display = dpy hunk ./XMonad/Main.hsc 122 , buttonActions = mouseBindings xmc xmc , mouseFocused = False , mousePosition = Nothing } - st = XState - { windowset = initialWinset - , mapped = S.empty - , waitingUnmap = M.empty - , dragging = Nothing } hunk ./XMonad/Main.hsc 123 + st = XState + { windowset = initialWinset + , mapped = S.empty + , waitingUnmap = M.empty + , dragging = Nothing + , extensibleState = extState + } allocaXEvent $ \e -> runX cf st $ do hunk ./XMonad/Operations.hs 416 restart prog resume = do broadcastMessage ReleaseResources io . flush =<< asks display - args <- if resume then gets (("--resume":) . return . showWs . windowset) else return [] + let wsData = show . W.mapLayout show . windowset + extState = return . show . M.map show . extensibleState + args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return [] catchIO (executeFile prog True args Nothing) hunk ./XMonad/Operations.hs 420 - where showWs = show . W.mapLayout show ------------------------------------------------------------------------ -- | Floating layer support hunk ./xmonad.cabal 36 library exposed-modules: XMonad XMonad.Main + XMonad.ExtensibleState XMonad.Core XMonad.Config XMonad.Layout hunk ./xmonad.cabal 63 XMonad.Main XMonad.Core XMonad.Config + XMonad.ExtensibleState XMonad.Layout XMonad.ManageHook XMonad.Operations } [Add some convenience functions to ExtensibleState Daniel Schoepe **20090629201811 Ignore-this: e825e0800bdc50cd1767a218a97bf6b4 This patch adds some convenience functions to XMonad.ExtensibleState and fixes a bug. ] { hunk ./XMonad/ExtensibleState.hs 22 modifyStateExts , addStateExt , modifyStateExt + , modifyStateExtDef + , alterStateExt , removeStateExt , getStateExt hunk ./XMonad/ExtensibleState.hs 26 + , getStateExtDef , readExtVal ) where hunk ./XMonad/ExtensibleState.hs 89 modifyStateExts :: (M.Map String StateExtension -> M.Map String StateExtension) -> X () modifyStateExts f = modify $ \st -> st { extensibleState = f (extensibleState st) } +-- | Applies the given function on the value, analogous to Data.Map.alter +alterStateExt :: forall a . ExtensionClass a => (Maybe a -> Maybe a) -> X () +alterStateExt f = modifyStateExts $ M.alter f' (show . typeOf $ (undefined :: a)) + where f' :: Maybe StateExtension -> Maybe StateExtension + f' (Just (StateExtension x)) + | typeOf x == typeOf (undefined :: a) = StateExtension `fmap` f (Just $ unsafeCoerce x) + | otherwise = Nothing -- should never happen + f' Nothing = StateExtension `fmap` f Nothing + -- | Apply a function to stored value of the matching type hunk ./XMonad/ExtensibleState.hs 99 -modifyStateExt :: forall a . ExtensionClass a => (a -> a) -> X () -modifyStateExt f = do - Just ste <- getStateExt - let v = unsafeCoerce (ste :: a) :: a -- this safe, since getStateExt is guaranteed to return the - -- required type or Nothing. - modifyStateExts (M.insert (show . typeOf $ v) $ StateExtension (f v)) +modifyStateExt :: ExtensionClass a => (a -> a) -> X () +modifyStateExt f = alterStateExt (fmap f) + +-- | Apply a function to a stored value or to a default if none is found +modifyStateExtDef :: ExtensionClass a => (a -> a) -> a -> X () +modifyStateExtDef f def = addStateExt . f =<< getStateExtDef def -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type hunk ./XMonad/ExtensibleState.hs 115 -- | Try to retrieve a value of the requested type, return Nothing if there is no such value. getStateExt :: forall a . ExtensionClass a => X (Maybe a) getStateExt = do - Just (StateExtension val) <- gets (M.lookup (show . typeOf $ (undefined :: a)) . extensibleState) - if typeOf val == typeOf (undefined :: a) - then return . Just . unsafeCoerce $ val -- this is safe, since the types are checked by typeOf - else return Nothing + v <- gets (M.lookup (show . typeOf $ (undefined :: a)) . extensibleState) + case v of + Just (StateExtension val) + | typeOf val == typeOf (undefined :: a) -> return . Just . unsafeCoerce $ val + -- this is safe, since the types are checked by typeOf + _ -> return $ Nothing + +-- | Retrieve a value with the appropriate type, or return a default value if none is found. +getStateExtDef :: ExtensionClass a => a -> X a +getStateExtDef def = maybe def id `fmap` getStateExt -- | Remove the value from the extensible state field that has the same type as the supplied argument removeStateExt :: ExtensionClass a => a -> X () } Context: [Minor bugfix in the creation of new StackSets. Wouter Swierstra **20090503154321] [Avoid deadly cycle in man/xmonad.hs Spencer Janssen **20090319081918 Ignore-this: adcba110caad465a2cbb4b9dca7cb612 ] [X.Config.hs, ./man/xmonad.hs: update Event Hook doc wirtwolff@gmail.com**20090209183837 Ignore-this: 3792043278932e371e3e2858913a2b17 ] [Use records to document Tall's arguments Spencer Janssen **20090221230628 Ignore-this: 253c09de793715c18a029406795a42fd ] [Fix possible head [] Joachim Breitner **20090106192026 This seems to be a rare case, but I just got hit by it. ] [ManageHook.doShift: use shiftWin instead of shift Spencer Janssen **20090219041458 Ignore-this: 4d7f348d6d394c581ab2809bbc45a2c6 ] [Express shift in terms of shiftWin Spencer Janssen **20090217235343 Ignore-this: 8f213bca20065a39e7c16027f7b398cf ] [Use standard -fforce-recomp instead of undocumented -no-recomp Don Stewart **20090208165518] [Support for custom event hooks Daniel Schoepe **20090203155536 Ignore-this: f22f1a7ae2d958ba1b3625aa923b7efd ] [Make X an instance of Typeable Daniel Schoepe **20090128215406 Ignore-this: bb155e62ea4e451460e3b94508dc49d2 ] [Add uninstallSignalHandlers, use in spawn Spencer Janssen **20090122002643 Ignore-this: d91bde6f965341a2619fe2dde83cc099 ] [Create a new session for forked processes Spencer Janssen **20090122000423 Ignore-this: f5d9cf254a0b07ddbf204457b7783880 ] [TAG 0.8.1 Spencer Janssen **20090118083910] [Close stdin in spawned processes Spencer Janssen **20090117040024 Ignore-this: 2e372ed6215160adae8da1c44cdede3d ] [Document spawnPID Spencer Janssen **20090117035907 Ignore-this: 1641bdcf5055b2ec7b9455265f5b1d52 ] [Asynchronously recompile/restart xmonad on mod-q Spencer Janssen **20090117035300 Ignore-this: 753d8746034f818b81df79003ae5ee0d ] [Add --restart, a command line flag to cause a running xmonad process to restart Spencer Janssen **20090117034959 Ignore-this: 45c8c8aba7cc7391b95c7e3fb01e5bf9 ] [Bump version to 0.8.1 Spencer Janssen **20090116223621 Ignore-this: 2e8e9dc7b6ca725542f4afe04253dc57 ] [Remove doubleFork, handle SIGCHLD Spencer Janssen **20090116204742 Ignore-this: f9b1a65b4f0622922f80ad2ab6c5a52f This is a rather big change. Rather than make spawned processes become children of init, we handle them in xmonad. As a side effect of this change, we never need to use waitForProcess in any contrib module -- in fact, doing so will raise an exception. The main benefit to handling SIGCHLD is that xmonad can now be started with 'exec', and will correctly clean up after inherited child processes. ] [Main.hs: escape / in Haddocks gwern0@gmail.com**20081207020915 Ignore-this: 2c4525280fbe73c46f3abd8fc13628e9 This lets haddocks for Main.hs, at least, to build with 2.3.0. ] [More flexible userCode function Daniel Schoepe **20090110221852] [Call logHook as the very last action in windows Spencer Janssen **20081209233700 Ignore-this: 4396ad891b607780f8e4b3b6bbce87e ] [Accept inferior crossing events. This patch enables fmouse-focus-follows-screen Spencer Janssen **20081205045130 Ignore-this: 3ac329fb92839827aed0a4370784cabd ] [Tile all windows at once Spencer Janssen **20081118074447] [Factor rational rect scaling into a separate function Spencer Janssen **20081118072849] [Change screen focus by clicking on the root window. Spencer Janssen **20081106224031 This is a modification of a patch from Joachim Breitner. ] [Fix #192. Spencer Janssen **20081021220059] [select base < 4 for building on ghc 6.10 Adam Vogt **20081013214509] [add killWindow function Joachim Breitner **20081005001804 This is required to kill anything that is not focused, without having to focus it first. ] [add'l documentation Devin Mullins **20080927234639] [Regression: ungrab buttons on *non* root windows Spencer Janssen **20081007214351] [Partial fix for #40 Spencer Janssen **20081007212053 Improvements: - clicking on the root will change focus to that screen - moving the mouse from a window on a screen to an empty screen changes focus to that screen The only remaining issue is that moving the mouse between two empty screens does not change focus. In order to solve this, we'd have to select motion events on the root window, which is potentially expensive. ] [Track mouse position via events received Spencer Janssen **20081007203953] [Fix haddock Spencer Janssen **20081007094641] [Move screen locating code into pointScreen Spencer Janssen **20081007094207] [Make pointWithin a top-level binding Spencer Janssen **20081007090229] [sp README, CONFIG, STYLE, TODO gwern0@gmail.com**20080913024457] [Use the same X11 dependency as xmonad-contrib Spencer Janssen **20080921061508] [Export focusUp' and focusDown' -- work entirely on stacks Spencer Janssen **20080911214803] [add W.shiftMaster, fix float/tile-reordering bug Devin Mullins **20080911053909] [TAG 0.8 Spencer Janssen **20080905195412] Patch bundle hash: 9766830ff94ccce6e7259eda4234ebe2916b59f0