Support for extensible state in contrib modules.

Ignore-this: d04ee1989313ed5710c94f9d7fda3f2a

darcs-hash:20091106115050-7f603-c88ce5e468856afd9e4d458ed3b0a2cfa39e63b3.gz

5 files changed, 61 insertions, 18 deletions

diff --git a/Main.hs b/Main.hs
index af44564..cce6868 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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 ()
diff --git a/XMonad/Config.hs b/XMonad/Config.hs
index 28bb493..4744179 100644
--- a/XMonad/Config.hs
+++ b/XMonad/Config.hs
@@ -264,4 +264,5 @@ defaultConfig = XConfig
     , XMonad.mouseBindings      = mouseBindings
     , XMonad.manageHook         = manageHook
     , XMonad.handleEventHook    = handleEventHook
-    , XMonad.focusFollowsMouse  = focusFollowsMouse }
+    , XMonad.focusFollowsMouse  = focusFollowsMouse
+    }
\ No newline at end of file
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 1b7b70a..23394f6 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -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,20 +52,24 @@ 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
 
 -- | 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 (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
@@ -344,6 +349,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
 --
 -- Lift an 'IO' action into the 'X' monad
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index 499be54..e7fc768 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -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 }
 
+        st = XState
+            { windowset       = initialWinset
+            , mapped          = S.empty
+            , waitingUnmap    = M.empty
+            , dragging        = Nothing
+            , extensibleState = extState
+            }
     allocaXEvent $ \e ->
         runX cf st $ do
 
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index fe124f3..f4a6bed 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -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