Support for extensible state in contrib modules.

This commit is contained in:
Daniel Schoepe 2009-11-06 11:50:50 +00:00
parent 44bc9558d9
commit 73e406f4a6
5 changed files with 61 additions and 18 deletions

View File

@ -39,7 +39,7 @@ main = do
let launch = catchIO buildLaunch >> xmonad defaultConfig let launch = catchIO buildLaunch >> xmonad defaultConfig
case args of case args of
[] -> launch [] -> launch
["--resume", _] -> launch ("--resume":_) -> launch
["--help"] -> usage ["--help"] -> usage
["--recompile"] -> recompile True >>= flip unless exitFailure ["--recompile"] -> recompile True >>= flip unless exitFailure
["--restart"] -> sendRestart >> return () ["--restart"] -> sendRestart >> return ()

View File

@ -264,4 +264,5 @@ defaultConfig = XConfig
, XMonad.mouseBindings = mouseBindings , XMonad.mouseBindings = mouseBindings
, XMonad.manageHook = manageHook , XMonad.manageHook = manageHook
, XMonad.handleEventHook = handleEventHook , XMonad.handleEventHook = handleEventHook
, XMonad.focusFollowsMouse = focusFollowsMouse } , XMonad.focusFollowsMouse = focusFollowsMouse
}

View File

@ -24,6 +24,7 @@ module XMonad.Core (
XConf(..), XConfig(..), LayoutClass(..), XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message, Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, LayoutMessages(..), SomeMessage(..), fromMessage, LayoutMessages(..),
StateExtension(..), ExtensionClass(..),
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX, getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX,
@ -51,20 +52,24 @@ import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (Event) import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable import Data.Typeable
import Data.List ((\\)) import Data.List ((\\))
import Data.Maybe (isJust) import Data.Maybe (isJust,fromMaybe)
import Data.Monoid import Data.Monoid
import Data.Maybe (fromMaybe)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
-- | XState, the (mutable) window manager state. -- | XState, the (mutable) window manager state.
data XState = XState data XState = XState
{ windowset :: !WindowSet -- ^ workspace list { windowset :: !WindowSet -- ^ workspace list
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows , mapped :: !(S.Set Window) -- ^ the Set of mapped windows
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
, dragging :: !(Maybe (Position -> Position -> X (), X ())) } , dragging :: !(Maybe (Position -> Position -> X (), X ()))
, extensibleState :: !(M.Map String (Either String StateExtension))
-- ^ stores custom state information.
--
-- The module XMonad.Utils.ExtensibleState in xmonad-contrib
-- provides additional information and a simple interface for using this.
}
-- | XConf, the (read-only) window manager configuration. -- | XConf, the (read-only) window manager configuration.
data XConf = XConf data XConf = XConf
{ display :: Display -- ^ the X11 display { display :: Display -- ^ the X11 display
@ -343,6 +348,33 @@ data LayoutMessages = Hide -- ^ sent when a layout becomes non-visi
instance Message LayoutMessages instance Message LayoutMessages
-- ---------------------------------------------------------------------
-- Extensible state
--
-- | Every module must make the data it wants to store
-- an instance of this class.
--
-- Minimal complete definition: initialValue
class Typeable a => ExtensionClass a where
-- | Defines an initial value for the state extension
initialValue :: a
-- | Specifies whether the state extension should be
-- persistent. Setting this method to 'PersistentExtension'
-- will make the stored data survive restarts, but
-- requires a to be an instance of Read and Show.
--
-- It defaults to 'StateExtension', i.e. no persistence.
extensionType :: a -> StateExtension
extensionType = StateExtension
-- | Existential type to store a state extension.
data StateExtension =
forall a. ExtensionClass a => StateExtension a
-- ^ Non-persistent state extension
| forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
-- ^ Persistent extension
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- | General utilities -- | General utilities
-- --

View File

@ -15,6 +15,7 @@
module XMonad.Main (xmonad) where module XMonad.Main (xmonad) where
import Control.Arrow (second)
import Data.Bits import Data.Bits
import Data.List ((\\)) import Data.List ((\\))
import qualified Data.Map as M import qualified Data.Map as M
@ -93,7 +94,6 @@ xmonad initxmc = do
let layout = layoutHook xmc let layout = layoutHook xmc
lreads = readsLayout layout lreads = readsLayout layout
initialWinset = new layout (workspaces xmc) $ map SD xinesc initialWinset = new layout (workspaces xmc) $ map SD xinesc
maybeRead reads' s = case reads' s of maybeRead reads' s = case reads' s of
[(x, "")] -> Just x [(x, "")] -> Just x
_ -> Nothing _ -> Nothing
@ -103,6 +103,10 @@ xmonad initxmc = do
ws <- maybeRead reads s ws <- maybeRead reads s
return . W.ensureTags layout (workspaces xmc) return . W.ensureTags layout (workspaces xmc)
$ W.mapLayout (fromMaybe layout . maybeRead lreads) ws $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
extState = fromMaybe M.empty $ do
("--resume" : _ : dyns : _) <- return args
vals <- maybeRead reads dyns
return . M.fromList . map (second Left) $ vals
cf = XConf cf = XConf
{ display = dpy { display = dpy
@ -114,12 +118,14 @@ xmonad initxmc = do
, buttonActions = mouseBindings xmc xmc , buttonActions = mouseBindings xmc xmc
, mouseFocused = False , mouseFocused = False
, mousePosition = Nothing } , mousePosition = Nothing }
st = XState
{ windowset = initialWinset
, mapped = S.empty
, waitingUnmap = M.empty
, dragging = Nothing }
st = XState
{ windowset = initialWinset
, mapped = S.empty
, waitingUnmap = M.empty
, dragging = Nothing
, extensibleState = extState
}
allocaXEvent $ \e -> allocaXEvent $ \e ->
runX cf st $ do runX cf st $ do

View File

@ -68,7 +68,7 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
where i = W.tag $ W.workspace $ W.current ws where i = W.tag $ W.workspace $ W.current ws
mh <- asks (manageHook . config) mh <- asks (manageHook . config)
g <- fmap appEndo $ userCodeDef (Endo id) (runQuery mh w) g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
windows (g . f) windows (g . f)
-- | unmanage. A window no longer exists, remove it from the window -- | unmanage. A window no longer exists, remove it from the window
@ -413,9 +413,13 @@ restart :: String -> Bool -> X ()
restart prog resume = do restart prog resume = do
broadcastMessage ReleaseResources broadcastMessage ReleaseResources
io . flush =<< asks display io . flush =<< asks display
args <- if resume then gets (("--resume":) . return . showWs . windowset) else return [] let wsData = show . W.mapLayout show . windowset
maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
maybeShow (t, Left str) = Just (t, str)
maybeShow _ = Nothing
extState = return . show . catMaybes . map maybeShow . M.toList . extensibleState
args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return []
catchIO (executeFile prog True args Nothing) catchIO (executeFile prog True args Nothing)
where showWs = show . W.mapLayout show
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Floating layer support -- | Floating layer support