diff options
Diffstat (limited to 'XMonad')
| -rw-r--r-- | XMonad/Config.hs | 3 | ||||
| -rw-r--r-- | XMonad/Core.hs | 46 | ||||
| -rw-r--r-- | XMonad/Main.hsc | 18 | ||||
| -rw-r--r-- | XMonad/Operations.hs | 10 |
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 |