aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad
diff options
context:
space:
mode:
Diffstat (limited to 'XMonad')
-rw-r--r--XMonad/Config.hs3
-rw-r--r--XMonad/Core.hs46
-rw-r--r--XMonad/Main.hsc18
-rw-r--r--XMonad/Operations.hs10
4 files changed, 60 insertions, 17 deletions
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