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
case args of
[] -> launch
["--resume", _] -> launch
("--resume":_) -> launch
["--help"] -> usage
["--recompile"] -> recompile True >>= flip unless exitFailure
["--restart"] -> sendRestart >> return ()

View File

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

View File

@ -24,6 +24,7 @@ module XMonad.Core (
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,
@ -51,9 +52,8 @@ import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable
import Data.List ((\\))
import Data.Maybe (isJust)
import Data.Maybe (isJust,fromMaybe)
import Data.Monoid
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
@ -63,8 +63,13 @@ 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 ())) }
, 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.
data XConf = XConf
{ display :: Display -- ^ the X11 display
@ -343,6 +348,33 @@ data LayoutMessages = Hide -- ^ sent when a layout becomes non-visi
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
--

View File

@ -15,6 +15,7 @@
module XMonad.Main (xmonad) where
import Control.Arrow (second)
import Data.Bits
import Data.List ((\\))
import qualified Data.Map as M
@ -93,7 +94,6 @@ xmonad initxmc = do
let layout = layoutHook xmc
lreads = readsLayout layout
initialWinset = new layout (workspaces xmc) $ map SD xinesc
maybeRead reads' s = case reads' s of
[(x, "")] -> Just x
_ -> Nothing
@ -103,6 +103,10 @@ xmonad initxmc = do
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 . map (second Left) $ vals
cf = XConf
{ display = dpy
@ -114,12 +118,14 @@ xmonad initxmc = do
, buttonActions = mouseBindings xmc xmc
, mouseFocused = False
, mousePosition = Nothing }
st = XState
{ windowset = initialWinset
, mapped = S.empty
, waitingUnmap = M.empty
, dragging = Nothing }
, dragging = Nothing
, extensibleState = extState
}
allocaXEvent $ \e ->
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
mh <- asks (manageHook . config)
g <- fmap appEndo $ userCodeDef (Endo id) (runQuery mh w)
g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
windows (g . f)
-- | unmanage. A window no longer exists, remove it from the window
@ -413,9 +413,13 @@ restart :: String -> Bool -> X ()
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
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)
where showWs = show . W.mapLayout show
------------------------------------------------------------------------
-- | Floating layer support