packages feed

xmonad-contrib 0.9.2 → 0.10

raw patch · 177 files changed

+8757/−1782 lines, 177 filesdep ~basedep ~xmonad

Dependency ranges changed: base, xmonad

Files

+ XMonad/Actions/BluetileCommands.hs view
@@ -0,0 +1,83 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.BluetileCommands+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- This is a list of selected commands that can be made available using+-- "XMonad.Hooks.ServerMode" to allow external programs to control+-- the window manager. Bluetile (<http://projects.haskell.org/bluetile/>)+-- uses this to enable its dock application to do things like changing+-- workspaces and layouts.+--+-----------------------------------------------------------------------------++module XMonad.Actions.BluetileCommands (+    -- * Usage+    -- $usage+    bluetileCommands+    ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutCombinators+import System.Exit++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Hooks.ServerMode+-- >    import XMonad.Actions.BluetileCommands+--+-- Then edit your @handleEventHook@:+--+-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands }+--+-- See the documentation of "XMonad.Hooks.ServerMode" for details on+-- how to actually invoke the commands from external programs.++workspaceCommands :: Int -> X [(String, X ())]+workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return+                            [(("greedyView" ++ show i),+                                activateScreen sid >> windows (W.greedyView i))+                                | i <- spaces ]++layoutCommands :: Int -> [(String, X ())]+layoutCommands sid = [ ("layout floating"    , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Floating"))+                     , ("layout tiled1"      , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Tiled1"))+                     , ("layout tiled2"      , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Tiled2"))+                     , ("layout fullscreen"  , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Fullscreen"))+                     ]++masterAreaCommands :: Int -> [(String, X ())]+masterAreaCommands sid = [ ("increase master n", activateScreen sid >>+                                                    sendMessage (IncMasterN 1))+                         , ("decrease master n", activateScreen sid >>+                                                    sendMessage (IncMasterN (-1)))+                         ]++quitCommands :: [(String, X ())]+quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))+               , ("quit bluetile and start metacity", restart "metacity" False)+               ]++bluetileCommands :: X [(String, X ())]+bluetileCommands = do+    let restartCommand = [ ("restart bluetile", restart "bluetile" True) ]+    wscmds0 <- workspaceCommands 0+    wscmds1 <- workspaceCommands 1+    return $ restartCommand+                ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands+                ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands++activateScreen :: Int -> X ()+activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view)
XMonad/Actions/CopyWindow.hs view
@@ -26,7 +26,6 @@  import XMonad import Control.Arrow ((&&&))-import Control.Monad import qualified Data.List as L  import XMonad.Actions.WindowGo@@ -146,7 +145,9 @@       delFromAllButCurrent w ss = foldr ($) ss $                                   map (delWinFromWorkspace w . W.tag) $                                   W.hidden ss ++ map W.workspace (W.visible ss)-      delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid+      delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))++      viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss  -- | A list of hidden workspaces containing a copy of the focused window. wsContainingCopies :: X [WorkspaceId]
XMonad/Actions/CycleWS.hs view
@@ -46,6 +46,7 @@                                 -- * Toggling the previous workspace                                 -- $toggling                               , toggleWS+                              , toggleWS'                               , toggleOrView                                  -- * Moving between screens (xinerama)@@ -65,6 +66,7 @@                                , shiftTo                               , moveTo+                              , doTo                                  -- * The mother-combinator @@ -72,6 +74,8 @@                               , toggleOrDoSkip                               , skipTags +                              , screenBy+                              ) where  import Control.Monad ( unless )@@ -147,10 +151,17 @@  -- | Toggle to the workspace displayed previously. toggleWS :: X ()-toggleWS = do-    hs <- gets (hidden . windowset)-    unless (null hs) (windows . view . tag $ head hs)+toggleWS = toggleWS' [] +-- | Toggle to the previous workspace while excluding some workspaces.+--+-- > -- Ignore the scratchpad workspace while toggling:+-- > ("M-b", toggleWS' ["NSP"])+toggleWS' :: [WorkspaceId] -> X ()+toggleWS' skips = do+    hs' <- cleanHiddens skips+    unless (null hs') (windows . view . tag $ head hs')+ -- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view -- the previously displayed workspace ala weechat. Change @greedyView@ to -- @toggleOrView@ in your workspace bindings as in the 'XMonad.StackSet.view'@@ -159,9 +170,8 @@ toggleOrView :: WorkspaceId -> X () toggleOrView = toggleOrDoSkip [] greedyView --- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\") while--- finding the previously displayed workspace, or choice of different actions,--- like view, shift, etc.  For example:+-- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\"), and+-- running other actions such as view, shift, etc.  For example: -- -- > import qualified XMonad.StackSet as W -- > import XMonad.Actions.CycleWS@@ -174,9 +184,9 @@ toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)                                   -> WorkspaceId -> X () toggleOrDoSkip skips f toWS = do-    ws <- gets windowset-    let hs' = hidden ws `skipTags` skips-    if toWS == (tag . workspace $ current ws)+    hs' <- cleanHiddens skips+    cur <- gets (currentTag . windowset)+    if toWS == cur         then unless (null hs') (windows . f . tag $ head hs')         else windows (f toWS) @@ -185,6 +195,9 @@ skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a] skipTags wss ids = filter ((`notElem` ids) . tag) wss +cleanHiddens :: [WorkspaceId] -> X [WindowSpace]+cleanHiddens skips =  gets $ (flip skipTags) skips . hidden . windowset+ switchWorkspace :: Int -> X () switchWorkspace d = wsBy d >>= windows . greedyView @@ -218,6 +231,10 @@             | HiddenWS    -- ^ cycle through non-visible workspaces             | HiddenNonEmptyWS  -- ^ cycle through non-empty non-visible workspaces             | AnyWS       -- ^ cycle through all workspaces+            | WSTagGroup Char+                          -- ^ cycle through workspaces in the same group, the+                          --   group name is all characters up to the first+                          --   separator character or the end of the tag             | WSIs (X (WindowSpace -> Bool))                           -- ^ cycle through workspaces satisfying                           --   an arbitrary predicate@@ -232,18 +249,26 @@                                     hi <- wsTypeToPred HiddenWS                                     return (\w -> hi w && ne w) wsTypeToPred AnyWS      = return (const True)+wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset+                                   return $ (cur ==).groupName+                                   where groupName = takeWhile (/=sep).tag wsTypeToPred (WSIs p)   = p  -- | View the next workspace in the given direction that satisfies --   the given condition. moveTo :: Direction1D -> WSType -> X ()-moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView+moveTo dir t = doTo dir t getSortByIndex (windows . greedyView)  -- | Move the currently focused window to the next workspace in the --   given direction that satisfies the given condition. shiftTo :: Direction1D -> WSType -> X ()-shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift+shiftTo dir t = doTo dir t getSortByIndex (windows . shift) +-- | Using the given sort, find the next workspace in the given+-- direction of the given type, and perform the given action on it.+doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()+doTo dir t srt act = findWorkspace srt dir t 1 >>= act+ -- | Given a function @s@ to sort workspaces, a direction @dir@, a --   predicate @p@ on workspaces, and an integer @n@, find the tag of --   the workspace which is @n@ away from the current workspace in@@ -300,6 +325,17 @@                          Nothing -> return ()                          Just ws -> windows (view ws) +{- | Get the 'ScreenId' /d/ places over. Example usage is a variation of the+the default screen keybindings:++>     -- mod-{w,e}, Switch to previous/next Xinerama screen+>     -- mod-shift-{w,e}, Move client to previous/next Xinerama screen+>     --+>     [((m .|. modm, key), sc >>= screenWorkspace >>= flip whenJust (windows . f))+>         | (key, sc) <- zip [xK_w, xK_e] [(screenBy (-1)),(screenBy 1)]+>         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]++-} screenBy :: Int -> X (ScreenId) screenBy d = do ws <- gets windowset                 --let ss = sortBy screen (screens ws)
XMonad/Actions/CycleWindows.hs view
@@ -226,8 +226,10 @@            (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)  -- $generic--- Generic list rotations+-- Generic list rotations such that @rotUp [1..4]@ is equivalent to+-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are+-- @id@ for null or singleton lists. rotUp :: [a] -> [a]-rotUp   l = tail l ++ [head l]+rotUp   l = drop 1 l ++ take 1 l rotDown :: [a] -> [a]-rotDown l = last l : init l+rotDown = reverse . rotUp . reverse
+ XMonad/Actions/DynamicWorkspaceGroups.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DeriveDataTypeable #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DynamicWorkspaceGroups+-- Copyright   :  (c) Brent Yorgey 2009+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  experimental+-- Portability :  unportable+--+-- Dynamically manage \"workspace groups\", sets of workspaces being+-- used together for some common task or purpose, to allow switching+-- between workspace groups in a single action.  Note that this only+-- makes sense for multi-head setups.+--+-----------------------------------------------------------------------------++module XMonad.Actions.DynamicWorkspaceGroups+    ( -- * Usage+      -- $usage++      WSGroupId++    , addWSGroup+    , addCurrentWSGroup+    , forgetWSGroup+    , viewWSGroup++    , promptWSGroupView+    , promptWSGroupAdd+    , promptWSGroupForget++    , WSGPrompt+    ) where++import Data.List (find)+import Control.Arrow ((&&&))+import qualified Data.Map as M++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Prompt+import qualified XMonad.Util.ExtensibleState as XS++-- $usage+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+--+-- > import XMonad.Actions.DynamicWorkspaceGroups+--+-- Then add keybindings like the following (this example uses+-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):+--+-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")+-- >    , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")+-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")+--++type WSGroup = [(ScreenId,WorkspaceId)]++type WSGroupId = String++data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }+  deriving (Typeable, Read, Show)++withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage+withWSG f = WSG . f . unWSG++instance ExtensionClass WSGroupStorage where+  initialValue = WSG $ M.empty+  extensionType = PersistentExtension++-- | Add a new workspace group with the given name.+addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()+addWSGroup name wids = withWindowSet $ \w -> do+  let wss  = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w+      wmap = mapM (strength . (flip lookup wss &&& id)) wids+  case wmap of+    Just ps -> XS.modify . withWSG . M.insert name $ ps+    Nothing -> return ()+ where strength (ma, b) = ma >>= \a -> return (a,b)++-- | Give a name to the current workspace group.+addCurrentWSGroup :: WSGroupId -> X ()+addCurrentWSGroup name = withWindowSet $ \w ->+  addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w)++-- | Delete the named workspace group from the list of workspace+--   groups.  Note that this has no effect on the workspaces involved;+--   it simply forgets the given name.+forgetWSGroup :: WSGroupId -> X ()+forgetWSGroup = XS.modify . withWSG . M.delete++-- | View the workspace group with the given name.+viewWSGroup :: WSGroupId -> X ()+viewWSGroup name = do+  WSG m <- XS.get+  case M.lookup name m of+    Just grp -> mapM_ (uncurry viewWS) grp+    Nothing -> return ()++-- | View the given workspace on the given screen.+viewWS :: ScreenId -> WorkspaceId -> X ()+viewWS sid wid = do+  mw <- findScreenWS sid+  case mw of+    Just w -> do+      windows $ W.view w+      windows $ W.greedyView wid+    Nothing -> return ()++-- | Find the workspace which is currently on the given screen.+findScreenWS :: ScreenId -> X (Maybe WorkspaceId)+findScreenWS sid = withWindowSet $+  return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens++data WSGPrompt = WSGPrompt String++instance XPrompt WSGPrompt where+  showXPrompt (WSGPrompt s) = s++-- | Prompt for a workspace group to view.+promptWSGroupView :: XPConfig -> String -> X ()+promptWSGroupView xp s = do+  gs <- fmap (M.keys . unWSG) XS.get+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup++-- | Prompt for a name for the current workspace group.+promptWSGroupAdd :: XPConfig -> String -> X ()+promptWSGroupAdd xp s =+  mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup++-- | Prompt for a workspace group to forget.+promptWSGroupForget :: XPConfig -> String -> X ()+promptWSGroupForget xp s = do+  gs <- fmap (M.keys . unWSG) XS.get+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
+ XMonad/Actions/DynamicWorkspaceOrder.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE DeriveDataTypeable #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DynamicWorkspaceOrder+-- Copyright   :  (c) Brent Yorgey 2009+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  experimental+-- Portability :  unportable+--+-- Remember a dynamically updateable ordering on workspaces, together+-- with tools for using this ordering with "XMonad.Actions.CycleWS"+-- and "XMonad.Hooks.DynamicLog".+--+-----------------------------------------------------------------------------++module XMonad.Actions.DynamicWorkspaceOrder+    ( -- * Usage+      -- $usage++      getWsCompareByOrder+    , getSortByOrder+    , swapWith++    , moveTo+    , moveToGreedy+    , shiftTo++    ) where++import XMonad+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS++import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)++import qualified Data.Map as M+import qualified Data.Set as S+import Data.Maybe (fromJust, fromMaybe)+import Data.Ord (comparing)++-- $usage+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+--+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO+--+-- Then add keybindings to swap the order of workspaces (these+-- examples use "XMonad.Util.EZConfig" emacs-style keybindings):+--+-- >        , ("M-C-<R>",   DO.swapWith Next NonEmptyWS)+-- >        , ("M-C-<L>",   DO.swapWith Prev NonEmptyWS)+--+-- See "XMonad.Actions.CycleWS" for information on the possible+-- arguments to 'swapWith'.+--+-- However, by itself this will do nothing; 'swapWith' does not change+-- the actual workspaces in any way.  It simply keeps track of an+-- auxiliary ordering on workspaces.  Anything which cares about the+-- order of workspaces must be updated to use the auxiliary ordering.+--+-- To change the order in which workspaces are displayed by+-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your+-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:+--+-- >   ... dynamicLogWithPP $ byorgeyPP {+-- >     ...+-- >     , ppSort = DO.getSortByOrder+-- >     ...+-- >   }+--+-- To use workspace cycling commands like those from+-- "XMonad.Actions.CycleWS", use the versions of 'moveTo',+-- 'moveToGreedy', and 'shiftTo' exported by this module.  For example:+--+-- >     , ("M-S-<R>",   DO.shiftTo Next HiddenNonEmptyWS)+-- >     , ("M-S-<L>",   DO.shiftTo Prev HiddenNonEmptyWS)+-- >     , ("M-<R>",     DO.moveTo Next HiddenNonEmptyWS)+-- >     , ("M-<L>",     DO.moveTo Prev HiddenNonEmptyWS)+--+-- For slight variations on these, use the source for examples and+-- tweak as desired.++-- | Extensible state storage for the workspace order.+data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }+  deriving (Typeable, Read, Show)++instance ExtensionClass WSOrderStorage where+  initialValue = WSO Nothing+  extensionType = PersistentExtension++-- | Lift a Map function to a function on WSOrderStorage.+withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)+           -> (WSOrderStorage -> WSOrderStorage)+withWSO f = WSO . fmap f . unWSO++-- | Update the ordering storage: initialize if it doesn't yet exist;+-- add newly created workspaces at the end as necessary.+updateOrder :: X ()+updateOrder = do+  WSO mm <- XS.get+  case mm of+    Nothing -> do+      -- initialize using ordering of workspaces from the user's config+      ws <- asks (workspaces . config)+      XS.put . WSO . Just . M.fromList $ zip ws [0..]+    Just m -> do+      -- check for new workspaces and add them at the end+      curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset)+      let mappedWs  = M.keysSet m+          newWs     = curWs `S.difference` mappedWs+          nextIndex = 1 + maximum (-1 : M.elems m)+          newWsIxs  = zip (S.toAscList newWs) [nextIndex..]+      XS.modify . withWSO . M.union . M.fromList $ newWsIxs++-- | A comparison function which orders workspaces according to the+-- stored dynamic ordering.+getWsCompareByOrder :: X WorkspaceCompare+getWsCompareByOrder = do+  updateOrder+  -- after the call to updateOrder we are guaranteed that the dynamic+  -- workspace order is initialized and contains all existing+  -- workspaces.+  WSO (Just m) <- XS.get+  return $ comparing (fromMaybe 1000 . flip M.lookup m)++-- | Sort workspaces according to the stored dynamic ordering.+getSortByOrder :: X WorkspaceSort+getSortByOrder = mkWsSort getWsCompareByOrder++-- | Swap the current workspace with another workspace in the stored+-- dynamic order.+swapWith :: Direction1D -> WSType -> X ()+swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent++-- | Swap the given workspace with the current one.+swapWithCurrent :: WorkspaceId -> X ()+swapWithCurrent w = do+  cur <- gets (W.currentTag . windowset)+  swapOrder w cur++-- | Swap the two given workspaces in the dynamic order.+swapOrder :: WorkspaceId -> WorkspaceId -> X ()+swapOrder w1 w2 = do+  io $ print (w1,w2)+  WSO (Just m) <- XS.get+  let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]+  XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))+  windows id  -- force a status bar update++-- | View the next workspace of the given type in the given direction,+-- where \"next\" is determined using the dynamic workspace order.+moveTo :: Direction1D -> WSType -> X ()+moveTo dir t = doTo dir t getSortByOrder (windows . W.view)++-- | Same as 'moveTo', but using 'greedyView' instead of 'view'.+moveToGreedy :: Direction1D -> WSType -> X ()+moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)++-- | Shift the currently focused window to the next workspace of the+-- given type in the given direction, using the dynamic workspace order.+shiftTo :: Direction1D -> WSType -> X ()+shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
XMonad/Actions/DynamicWorkspaces.hs view
@@ -8,15 +8,18 @@ -- Stability   :  unstable -- Portability :  unportable ----- Provides bindings to add and delete workspaces.  Note that you may only--- delete a workspace that is already empty.+-- Provides bindings to add and delete workspaces. -- -----------------------------------------------------------------------------  module XMonad.Actions.DynamicWorkspaces (                                          -- * Usage                                          -- $usage-                                         addWorkspace, removeWorkspace,+                                         addWorkspace, addWorkspacePrompt,+                                         removeWorkspace,+                                         removeEmptyWorkspace,+                                         removeEmptyWorkspaceAfter,+                                         removeEmptyWorkspaceAfterExcept,                                          addHiddenWorkspace,                                          withWorkspace,                                          selectWorkspace, renameWorkspace,@@ -25,14 +28,18 @@  import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter, modify, delete)-import XMonad.Prompt.Workspace-import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )+import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )+import XMonad.Prompt ( XPConfig, mkXPrompt ) import XMonad.Util.WorkspaceCompare ( getSortByIndex )+import Data.List (find)+import Data.Maybe (isNothing)+import Control.Monad (when)  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaces+-- > import XMonad.Actions.CopyWindow(copy) -- -- Then add keybindings like the following: --@@ -50,14 +57,10 @@ -- >    zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) -- -- For detailed instructions on editing your key bindings, see--- "XMonad.Doc.Extending#Editing_key_bindings".+-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for+-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'defaultXPConfig'.  -data Wor = Wor String--instance XPrompt Wor where-    showXPrompt (Wor x) = x- mkCompl :: [String] -> String -> IO [String] mkCompl l s = return $ filter (\x -> take (length s) x == s) l @@ -97,25 +100,68 @@                             then windows $ greedyView w                             else addWorkspace w --- | Add a new workspace with the given name.+-- | Add a new workspace with the given name, or do nothing if a+--   workspace with the given name already exists; then switch to the+--   newly created workspace. addWorkspace :: String -> X () addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag) +-- | Prompt for the name of a new workspace, add it if it does not+--   already exist, and switch to it.+addWorkspacePrompt :: XPConfig -> X ()+addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace --- | Add a new hidden workspace with the given name.+-- | Add a new hidden workspace with the given name, or do nothing if+--   a workspace with the given name already exists. addHiddenWorkspace :: String -> X ()-addHiddenWorkspace newtag = do l <- asks (layoutHook . config)-                               windows (addHiddenWorkspace' newtag l)+addHiddenWorkspace newtag =+  whenX (gets (not . tagMember newtag . windowset)) $ do+    l <- asks (layoutHook . config)+    windows (addHiddenWorkspace' newtag l)  -- | Remove the current workspace if it contains no windows.+removeEmptyWorkspace :: X ()+removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag++-- | Remove the current workspace. removeWorkspace :: X ()-removeWorkspace = do s <- gets windowset-                     case s of-                       StackSet { current = Screen { workspace = torem }-                                , hidden = (w:_) }-                           -> do windows $ view (tag w)-                                 windows (removeWorkspace' (tag torem))-                       _ -> return ()+removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag++-- | Remove workspace with specific tag if it contains no windows. Only works+--   on the current or the last workspace.+removeEmptyWorkspaceByTag :: String -> X ()+removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t++-- | Remove workspace with specific tag. Only works on the current or the last workspace.+removeWorkspaceByTag :: String -> X ()+removeWorkspaceByTag torem = do+    s <- gets windowset+    case s of+        StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do+                when (torem==tag cur) $ windows $ view $ tag w+                windows $ removeWorkspace' torem+        _ -> return ()++-- | Remove the current workspace after an operation if it is empty and hidden.+--   Can be used to remove a workspace if it is empty when leaving it. The+--   operation may only change workspace once, otherwise the workspace will not+--   be removed.+removeEmptyWorkspaceAfter :: X () -> X ()+removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []++-- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,+--   whose entries will never be removed.+removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()+removeEmptyWorkspaceAfterExcept sticky f = do+    before <- gets (currentTag . windowset)+    f+    after <- gets (currentTag . windowset)+    when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before++isEmpty :: String -> X Bool+isEmpty t = do wsl <- gets $ workspaces . windowset+               let mws = find (\ws -> tag ws == t) wsl+               return $ maybe True (isNothing . stack) mws  addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }
XMonad/Actions/FlexibleManipulate.hs view
@@ -23,6 +23,8 @@ ) where  import XMonad+import qualified Prelude as P+import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)  -- $usage -- First, add this import to your @~\/.xmonad\/xmonad.hs@:@@ -84,7 +86,7 @@      let uv = (pointer - wpos) / wsize         fc = mapP f uv-        mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle+        mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle         atl = ((1, 1) - fc) * mul         abr = fc * mul     mouseDrag (\ex ey -> io $ do@@ -121,14 +123,13 @@ minP :: Ord a => (a,a) -> (a,a) -> (a,a) minP = zipP min -instance Num Pnt where-    (+) = zipP (+)-    (-) = zipP (-)-    (*) = zipP (*)-    abs = mapP abs-    signum = mapP signum-    fromInteger = const undefined+infixl 6  +, -+infixl 7  *, / -instance Fractional Pnt where-    fromRational = const undefined-    recip = mapP recip+(+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a)+(+) = zipP (P.+)+(-) = zipP (P.-)+(*) = zipP (P.*)+(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)+(/) = zipP (P./)+
XMonad/Actions/FlexibleResize.hs view
@@ -20,6 +20,7 @@ ) where  import XMonad+import XMonad.Util.XUtils (fi) import Foreign.C.Types  -- $usage@@ -76,6 +77,3 @@                       Just True ->  (0, (fi k + fi p -).fi, (fi k + fi p -).fi)                       Nothing ->    (k `div` 2, const p, const $ fi k)                       Just False -> (k, const p, subtract (fi p) . fi)--fi :: (Num b, Integral a) => a -> b-fi = fromIntegral
XMonad/Actions/FloatKeys.hs view
@@ -17,7 +17,9 @@                 keysMoveWindow,                 keysMoveWindowTo,                 keysResizeWindow,-                keysAbsResizeWindow) where+                keysAbsResizeWindow,+                P, G,+                ) where  import XMonad
XMonad/Actions/GridSelect.hs view
@@ -28,7 +28,6 @@     -- * Configuration     GSConfig(..),     defaultGSConfig,-    NavigateMap,     TwoDPosition,     buildDefaultGSConfig, @@ -38,6 +37,7 @@     withSelectedWindow,     bringSelected,     goToSelected,+    gridselectWorkspace,     spawnSelected,     runSelectedAction, @@ -45,13 +45,35 @@     HasColorizer(defaultColorizer),     fromClassName,     stringColorizer,-    colorRangeFromClassName+    colorRangeFromClassName, +    -- * Navigation Mode assembly+    TwoD,+    makeXEventhandler,+    shadowWithKeymap,++    -- * Built-in Navigation Mode+    defaultNavigation,+    substringSearch,+    navNSearch,++    -- * Navigation Components+    setPos,+    move,+    moveNext, movePrev,+    select,+    cancel,+    transformSearchString,+     -- * Screenshots     -- $screenshots++    -- * Types+    TwoDState,     ) where import Data.Maybe import Data.Bits+import Data.Char import Control.Applicative import Control.Monad.State import Control.Arrow@@ -92,13 +114,13 @@ -- > {-# LANGUAGE NoMonomorphismRestriction #-} -- > import XMonad -- > ...--- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellWidth = 100 }+-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 } -- -- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig' -- in order to specify a custom colorizer is @gsconfig2@ (found in -- "XMonad.Actions.GridSelect#Colorizers"): ----- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellWidth = 100 }+-- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 } -- -- > -- | A green monochrome colorizer based on window class -- > greenColorizer = colorRangeFromClassName@@ -117,45 +139,48 @@  -- $keybindings ----- Adding more keybindings for gridselect to listen to is similar:------ At the top of your config:+-- You can build you own navigation mode and submodes by combining the+-- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'. ----- > {-# LANGAUGE NoMonomorphismRestriction #-}--- > import XMonad--- > import qualified Data.Map as M+-- > myNavigation :: TwoD a (Maybe a)+-- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler+-- >  where navKeyMap = M.fromList [+-- >           ((0,xK_Escape), cancel)+-- >          ,((0,xK_Return), select)+-- >          ,((0,xK_slash) , substringSearch myNavigation)+-- >          ,((0,xK_Left)  , move (-1,0)  >> myNavigation)+-- >          ,((0,xK_h)     , move (-1,0)  >> myNavigation)+-- >          ,((0,xK_Right) , move (1,0)   >> myNavigation)+-- >          ,((0,xK_l)     , move (1,0)   >> myNavigation)+-- >          ,((0,xK_Down)  , move (0,1)   >> myNavigation)+-- >          ,((0,xK_j)     , move (0,1)   >> myNavigation)+-- >          ,((0,xK_Up)    , move (0,-1)  >> myNavigation)+-- >          ,((0,xK_y)     , move (-1,-1) >> myNavigation)+-- >          ,((0,xK_i)     , move (1,-1)  >> myNavigation)+-- >          ,((0,xK_n)     , move (-1,1)  >> myNavigation)+-- >          ,((0,xK_m)     , move (1,-1)  >> myNavigation)+-- >          ,((0,xK_space) , setPos (0,0) >> myNavigation)+-- >          ]+-- >        -- The navigation handler ignores unknown key symbols+-- >        navDefaultHandler = const myNavigation ----- Then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:+-- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@: -- -- > gsconfig3 = defaultGSConfig -- >    { gs_cellheight = 30 -- >    , gs_cellwidth = 100--- >    , gs_navigate = M.unions--- >            [reset--- >            ,nethackKeys--- >            ,gs_navigate                               -- get the default navigation bindings--- >                $ defaultGSConfig `asTypeOf` gsconfig3 -- needed to fix an ambiguous type variable--- >            ]+-- >    , gs_navigate = myNavigation -- >    }--- >   where addPair (a,b) (x,y) = (a+x,b+y)--- >         nethackKeys = M.map addPair $ M.fromList--- >                               [((0,xK_y),(-1,-1))--- >                               ,((0,xK_i),(1,-1))--- >                               ,((0,xK_n),(-1,1))--- >                               ,((0,xK_m),(1,1))--- >                               ]--- >         -- jump back to the center with the spacebar, regardless of the current position.--- >         reset = M.singleton (0,xK_space) (const (0,0))  -- $screenshots -- -- Selecting a workspace: ----- <<http://haskell.org/sitewiki/images/a/a9/Xmonad-gridselect-workspace.png>>+-- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>> -- -- Selecting a window by title: ----- <<http://haskell.org/sitewiki/images/3/35/Xmonad-gridselect-window-aavogt.png>>+-- <<http://haskell.org/wikiupload/3/35/Xmonad-gridselect-window-aavogt.png>>  data GSConfig a = GSConfig {       gs_cellheight :: Integer,@@ -163,7 +188,7 @@       gs_cellpadding :: Integer,       gs_colorizer :: a -> Bool -> X (String, String),       gs_font :: String,-      gs_navigate :: NavigateMap,+      gs_navigate :: TwoD a (Maybe a),       gs_originFractX :: Double,       gs_originFractY :: Double }@@ -193,21 +218,29 @@ defaultGSConfig :: HasColorizer a => GSConfig a defaultGSConfig = buildDefaultGSConfig defaultColorizer -type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition)- type TwoDPosition = (Integer, Integer)  type TwoDElementMap a = [(TwoDPosition,(String,a))]  data TwoDState a = TwoDState { td_curpos :: TwoDPosition-                             , td_elementmap :: TwoDElementMap a+                             , td_availSlots :: [TwoDPosition]+                             , td_elements :: [(String,a)]                              , td_gsconfig :: GSConfig a                              , td_font :: XMonadFont                              , td_paneX :: Integer                              , td_paneY :: Integer                              , td_drawingWin :: Window+                             , td_searchString :: String                              } +td_elementmap :: TwoDState a -> [(TwoDPosition,(String,a))]+td_elementmap s =+  let positions = td_availSlots s+      elements = L.filter (((td_searchString s) `isSubstringOf`) . fst) (td_elements s)+  in zipWith (,) positions elements+  where sub `isSubstringOf` string = or [ (upper sub) `isPrefixOf` t | t <- tails (upper string) ]+        upper = map toUpper+ newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }     deriving (Monad,Functor,MonadState (TwoDState a)) @@ -221,14 +254,16 @@ evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a evalTwoD m s = flip evalStateT s $ unTwoD m -diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]--- FIXME remove nub-diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]-        in nub $ ul ++ (map (negate *** id) ul) ++-           (map (negate *** negate) ul) ++-           (map (id *** negate) ul)+diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)]+diamondLayer 0 = [(0,0)]+diamondLayer n =+  -- tr = top right+  --  r = ur ++ 90 degree clock-wise rotation of ur+  let tr = [ (x,n-x) | x <- [0..n-1] ]+      r  = tr ++ (map (\(x,y) -> (y,-x)) tr)+  in r ++ (map (negate *** negate) r) -diamond :: (Enum a, Num a) => [(a, a)]+diamond :: (Enum a, Num a, Eq a) => [(a, a)] diamond = concatMap diamondLayer [0..]  diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]@@ -237,9 +272,6 @@   map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .   take 1000 $ diamond -tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)-tupadd (a,b) (c,d) = (a+c,b+d)- findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) @@ -268,11 +300,23 @@ updateAllElements :: TwoD a () updateAllElements =     do-      TwoDState { td_elementmap = els } <- get-      updateElements els+      s <- get+      updateElements (td_elementmap s) +grayoutAllElements :: TwoD a ()+grayoutAllElements =+    do+      s <- get+      updateElementsWithColorizer grayOnly (td_elementmap s)+    where grayOnly _ _ = return ("#808080", "#808080")+ updateElements :: TwoDElementMap a -> TwoD a () updateElements elementmap = do+      s <- get+      updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap++updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()+updateElementsWithColorizer colorizer elementmap = do     TwoDState { td_curpos = curpos,                 td_drawingWin = win,                 td_gsconfig = gsconfig,@@ -284,7 +328,7 @@         paneX' = div (paneX-cellwidth) 2         paneY' = div (paneY-cellheight) 2         updateElement (pos@(x,y),(text, element)) = liftX $ do-            colors <- gs_colorizer gsconfig element (pos == curpos)+            colors <- colorizer element (pos == curpos)             drawWinBox win font                        colors                        cellheight@@ -295,53 +339,181 @@                        (gs_cellpadding gsconfig)     mapM_ updateElement elementmap -eventLoop :: TwoD a (Maybe a)-eventLoop = do-  (keysym,string,event) <- liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do-                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e-                             ev <- getEvent e-                             (ks,s) <- if ev_event_type ev == keyPress-                                       then lookupString $ asKeyEvent e-                                       else return (Nothing, "")-                             return (ks,s,ev)-  handle (fromMaybe xK_VoidSymbol keysym,string) event--handle ::  (KeySym, t) -> Event -> TwoD a (Maybe a)-handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m })-    | t == keyPress && ks == xK_Escape = return Nothing-    | t == keyPress && ks == xK_Return = do-       (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get-       return $ fmap (snd . snd) $ findInElementMap pos elmap-    | t == keyPress = do-        m' <- liftX (cleanMask m)-        keymap <- gets (gs_navigate . td_gsconfig)-        maybe eventLoop diffAndRefresh . M.lookup (m',ks) $ keymap-  where diffAndRefresh diff = do-          state <- get-          let elmap = td_elementmap state-              oldPos = td_curpos state-              newPos = diff oldPos-              newSelectedEl = findInElementMap newPos elmap-          when (isJust newSelectedEl) $ do-                                put state { td_curpos =  newPos }-                                updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])-          eventLoop--handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })+stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)+stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop     | t == buttonRelease = do-        (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,-                     td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get+        s @  TwoDState { td_paneX = px, td_paneY = py,+                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) } <- get         let gridX = (fi x - (px - cw) `div` 2) `div` cw             gridY = (fi y - (py - ch) `div` 2) `div` ch-        case lookup (gridX,gridY) elmap of+        case lookup (gridX,gridY) (td_elementmap s) of              Just (_,el) -> return (Just el)-             Nothing -> eventLoop-    | otherwise = eventLoop+             Nothing -> contEventloop+    | otherwise = contEventloop -handle _ (ExposeEvent { }) = updateAllElements >> eventLoop+stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop -handle _ _ = eventLoop+stdHandle _ contEventloop = contEventloop +-- | Embeds a key handler into the X event handler that dispatches key+-- events to the key handler, while non-key event go to the standard+-- handler.+makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)+makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do+                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e+                             ev <- getEvent e+                             if ev_event_type ev == keyPress+                               then do+                                  (ks,s) <- lookupString $ asKeyEvent e+                                  return $ do+                                      mask <- liftX $ cleanMask (ev_state ev)+                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)+                               else+                                  return $ stdHandle ev me++-- | When the map contains (KeySym,KeyMask) tuple for the given event,+-- the associated action in the map associated shadows the default key+-- handler+shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a+shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap)++-- Helper functions to use for key handler functions++-- | Closes gridselect returning the element under the cursor+select :: TwoD a (Maybe a)+select = do+  s <- get+  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)++-- | Closes gridselect returning no element.+cancel :: TwoD a (Maybe a)+cancel = return Nothing++-- | Sets the absolute position of the cursor.+setPos :: (Integer, Integer) -> TwoD a ()+setPos newPos = do+  s <- get+  let elmap = td_elementmap s+      newSelectedEl = findInElementMap newPos (td_elementmap s)+      oldPos = td_curpos s+  when (isJust newSelectedEl && newPos /= oldPos) $ do+    put s { td_curpos = newPos }+    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])++-- | Moves the cursor by the offsets specified+move :: (Integer, Integer) -> TwoD a ()+move (dx,dy) = do+  s <- get+  let (x,y) = td_curpos s+      newPos = (x+dx,y+dy)+  setPos newPos++moveNext :: TwoD a ()+moveNext = do+  position <- gets td_curpos+  elems <- gets td_elementmap+  let n = length elems+      m = case findIndex (\p -> fst p == position) elems of+               Nothing -> Nothing+               Just k | k == n-1 -> Just 0+                      | otherwise -> Just (k+1)+  whenJust m $ \i ->+      setPos (fst $ elems !! i)++movePrev :: TwoD a ()+movePrev = do+  position <- gets td_curpos+  elems <- gets td_elementmap+  let n = length elems+      m = case findIndex (\p -> fst p == position) elems of+               Nothing -> Nothing+               Just 0  -> Just (n-1)+               Just k  -> Just (k-1)+  whenJust m $ \i ->+      setPos (fst $ elems !! i)++-- | Apply a transformation function the current search string+transformSearchString :: (String -> String) -> TwoD a ()+transformSearchString f = do+          s <- get+          let oldSearchString = td_searchString s+              newSearchString = f oldSearchString+          when (newSearchString /= oldSearchString) $ do+            -- FIXME: grayoutAllElements + updateAllElements paint some fields twice causing flickering+            --        we would need a much smarter update strategy to fix that+            when (length newSearchString > length oldSearchString) grayoutAllElements+            -- FIXME curpos might end up outside new bounds+            put s { td_searchString = newSearchString }+            updateAllElements++-- | By default gridselect used the defaultNavigation action, which+-- binds left,right,up,down and vi-style h,l,j,k navigation. Return+-- quits gridselect, returning the selected element, while Escape+-- cancels the selection. Slash enters the substring search mode. In+-- substring search mode, every string-associated keystroke is+-- added to a search string, which narrows down the object+-- selection. Substring search mode comes back to regular navigation+-- via Return, while Escape cancels the search. If you want that+-- navigation style, add 'defaultNavigation' as 'gs_navigate' to your+-- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically.+defaultNavigation :: TwoD a (Maybe a)+defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler+  where navKeyMap = M.fromList [+           ((0,xK_Escape)     , cancel)+          ,((0,xK_Return)     , select)+          ,((0,xK_slash)      , substringSearch defaultNavigation)+          ,((0,xK_Left)       , move (-1,0) >> defaultNavigation)+          ,((0,xK_h)          , move (-1,0) >> defaultNavigation)+          ,((0,xK_Right)      , move (1,0) >> defaultNavigation)+          ,((0,xK_l)          , move (1,0) >> defaultNavigation)+          ,((0,xK_Down)       , move (0,1) >> defaultNavigation)+          ,((0,xK_j)          , move (0,1) >> defaultNavigation)+          ,((0,xK_Up)         , move (0,-1) >> defaultNavigation)+          ,((0,xK_k)          , move (0,-1) >> defaultNavigation)+          ,((0,xK_Tab)        , moveNext >> defaultNavigation)+          ,((0,xK_n)          , moveNext >> defaultNavigation)+          ,((shiftMask,xK_Tab), movePrev >> defaultNavigation)+          ,((0,xK_p)          , movePrev >> defaultNavigation)+          ]+        -- The navigation handler ignores unknown key symbols, therefore we const+        navDefaultHandler = const defaultNavigation++-- | This navigation style combines navigation and search into one mode at the cost of losing vi style+-- navigation. With this style, there is no substring search submode,+-- but every typed character is added to the substring search.+navNSearch :: TwoD a (Maybe a)+navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler+  where navNSearchKeyMap = M.fromList [+           ((0,xK_Escape)     , cancel)+          ,((0,xK_Return)     , select)+          ,((0,xK_Left)       , move (-1,0) >> navNSearch)+          ,((0,xK_Right)      , move (1,0) >> navNSearch)+          ,((0,xK_Down)       , move (0,1) >> navNSearch)+          ,((0,xK_Up)         , move (0,-1) >> navNSearch)+          ,((0,xK_Tab)        , moveNext >> navNSearch)+          ,((shiftMask,xK_Tab), movePrev >> navNSearch)+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)+          ]+        -- The navigation handler ignores unknown key symbols, therefore we const+        navNSearchDefaultHandler (_,s,_) = do+          transformSearchString (++ s)+          navNSearch++-- | Navigation submode used for substring search. It returns to the+-- first argument navigation style when the user hits Return.+substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)+substringSearch returnNavigation = fix $ \me ->+  let searchKeyMap = M.fromList [+           ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)+          ,((0,xK_Return)   , returnNavigation)+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)+          ]+      searchDefaultHandler (_,s,_) = do+          transformSearchString (++ s)+          me+  in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler++ -- FIXME probably move that into Utils? -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)@@ -418,7 +590,8 @@ -- | Brings up a 2D grid of elements in the center of the screen, and one can -- select an element with cursors keys. The selected element is returned. gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)-gridselect gsconfig elmap =+gridselect _ [] = return Nothing+gridselect gsconfig elements =  withDisplay $ \dpy -> do     rootw <- asks theRoot     s <- gets $ screenRect . W.screenDetail . W.current . windowset@@ -438,16 +611,16 @@                                 originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX                                 originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY                                 coords = diamondRestrict restrictX restrictY originPosX originPosY-                                elmap' = zip coords elmap -                            evalTwoD (updateAllElements >> eventLoop)-                                (TwoDState (head coords)-                                            elmap'-                                            gsconfig-                                            font-                                            screenWidth-                                            screenHeight-                                            win)+                            evalTwoD (updateAllElements >> (gs_navigate gsconfig)) TwoDState { td_curpos = (head coords),+                                                                                  td_availSlots = coords,+                                                                                  td_elements = elements,+                                                                                  td_gsconfig = gsconfig,+                                                                                  td_font = font,+                                                                                  td_paneX = screenWidth,+                                                                                  td_paneY = screenHeight,+                                                                                  td_drawingWin = win,+                                                                                  td_searchString = "" }                       else                           return Nothing     liftIO $ do@@ -484,19 +657,7 @@  -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2)--defaultGSNav :: NavigateMap-defaultGSNav = M.map tupadd $ M.fromList-    [((0,xK_Left) ,(-1,0))-    ,((0,xK_h)    ,(-1,0))-    ,((0,xK_Right),(1,0))-    ,((0,xK_l)    ,(1,0))-    ,((0,xK_Down) ,(0,1))-    ,((0,xK_j)    ,(0,1))-    ,((0,xK_Up)   ,(0,-1))-    ,((0,xK_k)    ,(0,-1))-    ]+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation (1/2) (1/2)  borderColor :: String borderColor = "white"@@ -523,3 +684,15 @@     case selectedActionM of         Just selectedAction -> selectedAction         Nothing -> return ()++-- | Select a workspace and view it using the given function+-- (normally 'W.view' or 'W.greedyView')+--+-- Another option is to shift the current window to the selected workspace:+--+-- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws)+gridselectWorkspace :: GSConfig WorkspaceId ->+                          (WorkspaceId -> WindowSet -> WindowSet) -> X ()+gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do+    let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws)+    gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc)
+ XMonad/Actions/GroupNavigation.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE DeriveDataTypeable #-}++----------------------------------------------------------------------+-- |+-- Module      : XMonad.Actions.GroupNavigation+-- Copyright   : (c) nzeh@cs.dal.ca+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : nzeh@cs.dal.ca+-- Stability   : unstable+-- Portability : unportable+--+-- Provides methods for cycling through groups of windows across+-- workspaces, ignoring windows that do not belong to this group.  A+-- group consists of all windows matching a user-provided boolean+-- query.+--+-- Also provides a method for jumping back to the most recently used+-- window in any given group.+--+----------------------------------------------------------------------++module XMonad.Actions.GroupNavigation ( -- * Usage  +                                        -- $usage+                                        Direction (..)+                                      , nextMatch+                                      , nextMatchOrDo+                                      , nextMatchWithThis+                                      , historyHook+                                      ) where++import Control.Monad.Reader+import Data.Foldable as Fold+import Data.Map as Map+import Data.Sequence as Seq+import Data.Set as Set+import Graphics.X11.Types+import Prelude hiding (concatMap, drop, elem, filter, null, reverse)+import XMonad.Core+import XMonad.ManageHook+import XMonad.Operations (windows, withFocused)+import qualified XMonad.StackSet as SS+import qualified XMonad.Util.ExtensibleState as XS++{- $usage++Import the module into your @~\/.xmonad\/xmonad.hs@:++> import XMonad.Actions,GroupNavigation++To support cycling forward and backward through all xterm windows, add+something like this to your keybindings:++> , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))+> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))++These key combinations do nothing if there is no xterm window open.+If you rather want to open a new xterm window if there is no open+xterm window, use 'nextMatchOrDo' instead:++> , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))+> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))++You can use 'nextMatchWithThis' with an arbitrary query to cycle+through all windows for which this query returns the same value as the+current window.  For example, to cycle through all windows in the same+window class as the current window use:++> , ((modm , xK_f), nextMatchWithThis Forward  className)+> , ((modm , xK_b), nextMatchWithThis Backward className)++Finally, you can define keybindings to jump to the most recent window+matching a certain Boolean query.  To do this, you need to add+'historyHook' to your logHook:++> main = xmonad $ defaultConfig { logHook = historyHook }++Then the following keybindings, for example, allow you to return to+the most recent xterm or emacs window or to simply to the most recent+window:++> , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))+> , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))+> , ((modm                , xK_BackSpace), nextMatch History (return True))++Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want+to execute an action if no window matching the query exists. -}++--- Basic cyclic navigation based on queries -------------------------++-- | The direction in which to look for the next match+data Direction = Forward  -- ^ Forward from current window or workspace+               | Backward -- ^ Backward from current window or workspace+               | History  -- ^ Backward in history++-- | Focuses the next window for which the given query produces the+-- same result as the currently focused window.  Does nothing if there+-- is no focused window (i.e., the current workspace is empty).+nextMatchWithThis :: Eq a => Direction -> Query a -> X ()+nextMatchWithThis dir qry = withFocused $ \win -> do+  prop <- runQuery qry win+  nextMatch dir (qry =? prop)++-- | Focuses the next window that matches the given boolean query.+-- Does nothing if there is no such window.  This is the same as+-- 'nextMatchOrDo' with alternate action @return ()@.+nextMatch :: Direction -> Query Bool -> X ()+nextMatch dir qry = nextMatchOrDo dir qry (return ())++-- | Focuses the next window that matches the given boolean query.  If+-- there is no such window, perform the given action instead.+nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()+nextMatchOrDo dir qry act = orderedWindowList dir +                            >>= focusNextMatchOrDo qry act++-- Produces the action to perform depending on whether there's a+-- matching window+focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()+focusNextMatchOrDo qry act = findM (runQuery qry) +                             >=> maybe act (windows . SS.focusWindow)++-- Returns the list of windows ordered by workspace as specified in+-- ~/.xmonad/xmonad.hs+orderedWindowList :: Direction -> X (Seq Window)+orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get+orderedWindowList dir     = withWindowSet $ \ss -> do+  wsids <- asks (Seq.fromList . workspaces . config)+  let wspcs = orderedWorkspaceList ss wsids+      wins  = dirfun dir +              $ Fold.foldl' (><) Seq.empty+              $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs+      cur   = SS.peek ss+  return $ maybe wins (rotfun wins) cur+  where+    dirfun Backward = Seq.reverse+    dirfun _        = id+    rotfun wins x   = rotate $ rotateTo (== x) wins++-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs+orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace+orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'+    where+      wspcs      = SS.workspaces ss+      wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs+      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids+      isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)++--- History navigation, requires a layout modifier -------------------++-- The state extension that holds the history information+data HistoryDB = HistoryDB (Maybe Window) -- currently focused window +                           (Seq Window)   -- previously focused windows+               deriving (Read, Show, Typeable)++instance ExtensionClass HistoryDB where++    initialValue  = HistoryDB Nothing Seq.empty+    extensionType = PersistentExtension++-- | Action that needs to be executed as a logHook to maintain the+-- focus history of all windows as the WindowSet changes.+historyHook :: X ()+historyHook = XS.get >>= updateHistory >>= XS.put++-- Updates the history in response to a WindowSet change+updateHistory :: HistoryDB -> X HistoryDB+updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do+  let newcur   = SS.peek ss+      wins     = Set.fromList $ SS.allWindows ss+      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)+  return $ HistoryDB newcur (del newcur newhist)+  where+    ins x xs = maybe xs (<| xs) x+    del x xs = maybe xs (\x' -> flt (/= x') xs) x++--- Two replacements for Seq.filter and Seq.breakl available only in+--- containers-0.3.0.0, which only ships with ghc 6.12.  Once we+--- decide to no longer support ghc < 6.12, these should be replaced+--- with Seq.filter and Seq.breakl.++flt :: (a -> Bool) -> Seq a -> Seq a+flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty++brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)+brkl p xs = flip Seq.splitAt xs +            $ snd +            $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs+  where+    l = Seq.length xs+    +--- Some sequence helpers --------------------------------------------++-- Rotates the sequence by one position+rotate :: Seq a -> Seq a+rotate xs = rotate' (viewl xs)+  where+    rotate' EmptyL      = Seq.empty+    rotate' (x' :< xs') = xs' |> x'++-- Rotates the sequence until an element matching the given condition+-- is at the beginning of the sequence.+rotateTo :: (a -> Bool) -> Seq a -> Seq a+rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs++--- A monadic find ---------------------------------------------------++-- Applies the given action to every sequence element in turn until+-- the first element is found for which the action returns true.  The+-- remaining elements in the sequence are ignored.+findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)+findM cond xs = findM' cond (viewl xs)+  where+    findM' _   EmptyL      = return Nothing+    findM' qry (x' :< xs') = do+      isMatch <- qry x'+      if isMatch+        then return (Just x')+        else findM qry xs'
+ XMonad/Actions/KeyRemap.hs view
@@ -0,0 +1,156 @@+ {-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.KeyRemap+-- Copyright   :  (c) Christian Dietrich+-- License     :  BSD-style (as xmonad)+--+-- Maintainer  :  stettberger@dokucde.de+-- Stability   :  unstable+-- Portability :  unportable+--+-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift +-- is left us Layout+--+-----------------------------------------------------------------------------++module XMonad.Actions.KeyRemap (+  -- * Usage+  -- $usage+  setKeyRemap,+  buildKeyRemapBindings,+  setDefaultKeyRemap,++  KeymapTable (KeymapTable),+  emptyKeyRemap,+  dvorakProgrammerKeyRemap+  ) where++import XMonad+import XMonad.Util.Paste+import Data.List++import qualified XMonad.Util.ExtensibleState as XS+import Control.Monad+++data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)++instance ExtensionClass KeymapTable where+   initialValue = KeymapTable []++-- $usage+-- Provides the possibility to remap parts of the keymap to generate different keys+--+-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout +--   after all+--+-- First, you must add all possible keybindings for all layout you want to use:+--+-- >   keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap]+--+-- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the+-- empty keyremap (no remapping is done) as default after startup):+--+-- > myStartupHook :: X()+-- > myStartupHook = do+-- >   setWMName "LG3D"+-- >   setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap]+--+-- Then you add keybindings for changing keyboard layouts;+--+-- > , ((0                    , xK_F1    ), setKeyRemap emptyKeyRemap)+-- > , ((0                    , xK_F2    ), setKeyRemap dvorakProgrammerKeyRemap)+--+-- When defining your own keymappings, please be aware of:+--+-- * If you want to emulate a key that is shifted on us you must emulate that keypress:+--+-- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%'+-- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5'+--+-- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate+--   the KeymapTable+--+-- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap+--   are nessesary++doKeyRemap :: KeyMask -> KeySym -> X()+doKeyRemap mask sym = do+  table <- XS.get+  let (insertMask, insertSym) = extractKeyMapping table mask sym+  sendKey insertMask insertSym++-- | Using this in the keybindings to set the actual Key Translation table+setKeyRemap :: KeymapTable -> X()+setKeyRemap table = do+  let KeymapTable newtable = table+  KeymapTable oldtable <- XS.get+  XConf { display = dpy, theRoot = rootw } <- ask++  let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync+  let ungrab kc m = io $ ungrabKey dpy kc m rootw++  forM_ oldtable $ \((mask, sym), _) -> do+    kc <- io $ keysymToKeycode dpy sym+    -- "If the specified KeySym is not defined for any KeyCode,+    -- XKeysymToKeycode() returns zero."+    when (kc /= 0) $ ungrab kc mask++  forM_ newtable $ \((mask, sym), _) -> do+    kc <- io $ keysymToKeycode dpy sym+    -- "If the specified KeySym is not defined for any KeyCode,+    -- XKeysymToKeycode() returns zero."+    when (kc /= 0) $ grab kc mask++  XS.put table++-- | Adding this to your startupHook, to select your default Key Translation table.+--   You also must give it all the KeymapTables you are willing to use+setDefaultKeyRemap  :: KeymapTable -> [KeymapTable] -> X()+setDefaultKeyRemap dflt keyremaps = do+  XS.put (KeymapTable mappings)+  setKeyRemap dflt+  where+    mappings = nub (keyremaps >>= \(KeymapTable table) -> table)++extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym)+extractKeyMapping (KeymapTable table) mask sym =+  insertKey filtered+  where filtered = filter (\((m, s),_) -> m == mask && s == sym) table+        insertKey [] = (mask, sym)+        insertKey ((_, to):_) = to++-- | Append the output of this function to your keybindings with +++buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]+buildKeyRemapBindings keyremaps =+  [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]+  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)+        bindings = nub (map (\binding -> fst binding) mappings)+++-- Here come the Keymappings+-- | The empty KeymapTable, does no translation+emptyKeyRemap :: KeymapTable+emptyKeyRemap = KeymapTable []++-- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers+dvorakProgrammerKeyRemap :: KeymapTable+dvorakProgrammerKeyRemap =+  KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |+               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]+  where++    layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]+    layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./"  :: [KeySym]+    layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"++    layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym]++    layoutDvorakShift = map getShift layoutDvorak+    layoutDvorakKey   = map getKey layoutDvorak+    getKey  char = let Just index = elemIndex char layoutUs+                    in layoutUsKey !! index+    getShift char = let Just index = elemIndex char layoutUs+                    in layoutUsShift !! index+    charToMask char = if [char] == "0" then 0 else shiftMask
XMonad/Actions/MessageFeedback.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.MessageFeedback--- Copyright    : (c) Quentin Moser <quentin.moser@unifr.ch>+-- Copyright    : (c) Quentin Moser <moserq@gmail.com> -- License      : BSD3 ----- Maintainer   : None+-- Maintainer   : orphaned -- Stability    : unstable -- Portability  : unportable --
XMonad/Actions/MouseResize.hs view
@@ -23,12 +23,8 @@     , MouseResize (..)     ) where -import Control.Monad-import Data.Maybe- import XMonad import XMonad.Layout.Decoration-import XMonad.Layout.LayoutModifier  import XMonad.Layout.WindowArranger import XMonad.Util.XUtils@@ -114,6 +110,11 @@     Just tr  -> withDisplay $ \d -> do                   tw <- mkInputWindow d tr                   io $ selectInput d tw (exposureMask .|. buttonPressMask)++                  cursor <- io $ createFontCursor d xC_bottom_right_corner+                  io $ defineCursor d tw cursor+                  io $ freeCursor d cursor+                   showWindow tw                   return ((w,r), Just tw)     Nothing ->    return ((w,r), Nothing)
XMonad/Actions/OnScreen.hs view
@@ -15,18 +15,138 @@ module XMonad.Actions.OnScreen (     -- * Usage     -- $usage-    onScreen+      onScreen+    , onScreen'+    , Focus(..)     , viewOnScreen     , greedyViewOnScreen     , onlyOnScreen+    , toggleOnScreen+    , toggleGreedyOnScreen     ) where -import XMonad.StackSet-import Control.Monad(guard)-import Data.List-import Data.Maybe(fromMaybe)-import Data.Function(on)+import XMonad+import XMonad.StackSet hiding (new) +import Control.Monad (guard)+-- import Control.Monad.State.Class (gets)+import Data.Maybe (fromMaybe)+++-- | Focus data definitions+data Focus = FocusNew                       -- ^ always focus the new screen+           | FocusCurrent                   -- ^ always keep the focus on the current screen+           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack+           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack+++-- | Run any function that modifies the stack on a given screen. This function+-- will also need to know which Screen to focus after the function has been+-- run.+onScreen :: (WindowSet -> WindowSet) -- ^ function to run+         -> Focus                    -- ^ what to do with the focus+         -> ScreenId                 -- ^ screen id+         -> WindowSet                -- ^ current stack+         -> WindowSet+onScreen f foc sc st = fromMaybe st $ do+    ws <- lookupWorkspace sc st++    let fStack      = f $ view ws st++    return $ setFocus foc st fStack+++-- set focus for new stack+setFocus :: Focus+         -> WindowSet -- ^ old stack+         -> WindowSet -- ^ new stack+         -> WindowSet+setFocus FocusNew _ new             = new+setFocus FocusCurrent old new        =+    case lookupWorkspace (screen $ current old) new of+         Nothing -> new+         Just i -> view i new+setFocus (FocusTag i) _ new         = view i new+setFocus (FocusTagVisible i) old new =+    if i `elem` map (tag . workspace) (visible old)+       then setFocus (FocusTag i) old new+       else setFocus FocusCurrent old new++-- | A variation of @onScreen@ which will take any @X ()@ function and run it+-- on the given screen.+-- Warning: This function will change focus even if the function it's supposed+-- to run doesn't succeed.+onScreen' :: X ()       -- ^ X function to run+          -> Focus      -- ^ focus+          -> ScreenId   -- ^ screen id+          -> X ()+onScreen' x foc sc = do+    st <- gets windowset+    case lookupWorkspace sc st of+         Nothing -> return ()+         Just ws -> do+             windows $ view ws+             x+             windows $ setFocus foc st+++-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to+-- switch focus to the workspace @i@.+viewOnScreen :: ScreenId    -- ^ screen id+             -> WorkspaceId -- ^ index of the workspace+             -> WindowSet   -- ^ current stack+             -> WindowSet+viewOnScreen sid i =+    onScreen (view i) (FocusTag i) sid++-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@+-- to switch the current workspace with workspace @i@.+greedyViewOnScreen :: ScreenId    -- ^ screen id+                   -> WorkspaceId -- ^ index of the workspace+                   -> WindowSet   -- ^ current stack+                   -> WindowSet+greedyViewOnScreen sid i =+    onScreen (greedyView i) (FocusTagVisible i) sid++-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.+onlyOnScreen :: ScreenId    -- ^ screen id+             -> WorkspaceId -- ^ index of the workspace+             -> WindowSet   -- ^ current stack+             -> WindowSet+onlyOnScreen sid i =+    onScreen (view i) FocusCurrent sid++-- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view+toggleOnScreen :: ScreenId    -- ^ screen id+               -> WorkspaceId -- ^ index of the workspace+               -> WindowSet   -- ^ current stack+               -> WindowSet+toggleOnScreen sid i =+    onScreen (toggleOrView' view i) FocusCurrent sid++-- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView+toggleGreedyOnScreen :: ScreenId    -- ^ screen id+                     -> WorkspaceId -- ^ index of the workspace+                     -> WindowSet   -- ^ current stack+                     -> WindowSet+toggleGreedyOnScreen sid i =+    onScreen (toggleOrView' greedyView i) FocusCurrent sid+++-- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip+toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet)   -- ^ function to run+              -> WorkspaceId                               -- ^ tag to look for+              -> WindowSet                                 -- ^ current stackset+              -> WindowSet+toggleOrView' f i st = fromMaybe (f i st) $ do+    let st' = hidden st+    -- make sure we actually have to do something+    guard $ i == (tag . workspace $ current st)+    guard $ not (null st')+    -- finally, toggle!+    return $ f (tag . head $ st') st++ -- $usage -- -- This module provides an easy way to control, what you see on other screens in@@ -60,56 +180,9 @@ -- -- A more basic version inside the default keybindings would be: ----- >        , ((modm .|. controlMask, xK_1) windows (viewOnScreen 0 "1"))+-- >        , ((modm .|. controlMask, xK_1), windows (viewOnScreen 0 "1")) ----- where 0 is the first screen and "1" the workspace with the tag "1".+-- where 0 is the first screen and \"1\" the workspace with the tag \"1\". -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings".---- | Switch to the (hidden) workspace with index 'i' on the screen 'sc'.--- A default function (for example 'view' or 'greedyView') will be run if 'sc' is--- the current screen, no valid screen id or workspace 'i' is already visible.-onScreen :: (Eq sid, Eq i)-          => (i -> StackSet i l a sid sd -> StackSet i l a sid sd) -- ^ default action-          -> sid                      -- ^ screen id-          -> i                        -- ^ index of the workspace-          -> StackSet i l a sid sd    -- ^ current stack-          -> StackSet i l a sid sd-onScreen defFunc sc i st = fromMaybe (defFunc i st) $ do-    -- on unfocused current screen-    guard $ screen (current st) /= sc-    x <- find ((i==) . tag    ) (hidden  st)-    s <- find ((sc==) . screen) (screens st)-    o <- find ((sc==) . screen) (visible st)-    let newScreen = s { workspace = x }-    return st { visible   = newScreen : deleteBy ((==) `on` screen) newScreen (visible st)-              , hidden    = workspace o : deleteBy ((==) `on` tag) x (hidden st)-              }---- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'greedyView'--- to switch the current workspace with workspace 'i'.-greedyViewOnScreen :: (Eq sid, Eq i)-    => sid                          -- ^ screen id-    -> i                            -- ^ index of the workspace-    -> StackSet i l a sid sd        -- ^ current stack-    -> StackSet i l a sid sd-greedyViewOnScreen = onScreen greedyView---- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'view' to--- switch focus to the workspace 'i'.-viewOnScreen :: (Eq sid, Eq i)-    => sid                          -- ^ screen id-    -> i                            -- ^ index of the workspace-    -> StackSet i l a sid sd        -- ^ current stack-    -> StackSet i l a sid sd-viewOnScreen = onScreen view---- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible do nothing.-onlyOnScreen :: (Eq sid, Eq i)-    => sid                          -- ^ screen id-    -> i                            -- ^ index of the workspace-    -> StackSet i l a sid sd        -- ^ current stack-    -> StackSet i l a sid sd-onlyOnScreen = onScreen doNothing-  where doNothing _ st = st
XMonad/Actions/PerWorkspaceKeys.hs view
@@ -21,7 +21,6 @@  import XMonad import XMonad.StackSet as S-import Data.List (find)  -- $usage --@@ -42,9 +41,9 @@ -- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied. bindOn :: [(String, X())] -> X() bindOn bindings = chooseAction chooser where-    chooser ws = case find ((ws==).fst) bindings of-        Just (_, action) -> action-        Nothing -> case find ((""==).fst) bindings of-            Just (_, action) -> action+    chooser ws = case lookup ws bindings of+        Just action -> action+        Nothing -> case lookup "" bindings of+            Just action -> action             Nothing -> return ()
XMonad/Actions/PhysicalScreens.hs view
@@ -19,15 +19,14 @@                                       , getScreen                                       , viewScreen                                       , sendToScreen+                                      , onNextNeighbour+                                      , onPrevNeighbour                                       ) where  import XMonad import qualified XMonad.StackSet as W -import qualified Graphics.X11.Xlib as X-import Graphics.X11.Xinerama--import Data.List (sortBy)+import Data.List (sortBy,findIndex) import Data.Function (on)  {- $usage@@ -44,6 +43,11 @@  > import XMonad.Actions.PhysicalSCreens +> , ((modMask, xK_a), onPrevNeighbour W.view)+> , ((modMask, xK_o), onNextNeighbour W.view)+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)+ > -- > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3 > -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3@@ -61,12 +65,12 @@  -- | Translate a physical screen index to a "ScreenId" getScreen :: PhysicalScreen -> X (Maybe ScreenId)-getScreen (P i) = withDisplay $ \dpy -> do-                    screens <- io $ getScreenInfo dpy-                    if i >= length screens-                     then return Nothing-                     else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..]-                          in return $ Just $ snd $ ss !! i+getScreen (P i) = do w <- gets windowset+                     let screens = W.current w : W.visible w+                     if i<0 || i >= length screens+                      then return Nothing+                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens+                           in return $ Just $ W.screen $ ss !! i  -- | Switch to a given physical screen viewScreen :: PhysicalScreen -> X ()@@ -85,4 +89,27 @@ -- | Compare two screens by their top-left corners, ordering -- | top-to-bottom and then left-to-right. cmpScreen :: Rectangle -> Rectangle -> Ordering-cmpScreen  (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)+cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)+++-- | Get ScreenId for neighbours of the current screen based on position offset.+getNeighbour :: Int -> X ScreenId+getNeighbour d = do w <- gets windowset+                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w+                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss+                        pos = (curPos + d) `mod` length ss+                    return $ ss !! pos++neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()+neighbourWindows d f = do s <- getNeighbour d+                          w <- screenWorkspace s+                          whenJust w $ windows . f++-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.+onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()+onNextNeighbour = neighbourWindows 1++-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.+onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()+onPrevNeighbour = neighbourWindows (-1)+
XMonad/Actions/Search.hs view
@@ -44,26 +44,32 @@                                  lucky,                                  maps,                                  mathworld,+                                 openstreetmap,                                  scholar,                                  thesaurus,                                  wayback,                                  wikipedia,                                  wiktionary,                                  youtube,-                                 multi+                                 multi,                                   -- * Use case: searching with a submap                                   -- $tip++                                  -- * Types+                                 Browser, Site, Query, Name, Search                           ) where -import Data.Char (chr, ord, isAlpha, isMark, isDigit)+import Codec.Binary.UTF8.String (encode)+import Data.Char (isAlphaNum, isAscii) import Data.List (isPrefixOf)-import Numeric (showIntAtBase)+import Text.Printf import XMonad (X(), MonadIO, liftIO)-import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletionP)+import XMonad.Prompt (XPrompt(showXPrompt, nextCompletion, commandToComplete), mkXPrompt, XPConfig(), historyCompletionP, getNextCompletion) import XMonad.Prompt.Shell (getBrowser) import XMonad.Util.Run (safeSpawn) import XMonad.Util.XSelection (getSelection) + {- $usage     This module is intended to allow easy access to databases on the@@ -120,6 +126,8 @@  * 'mathworld' -- Wolfram MathWorld search. +* 'openstreetmap' -- OpenStreetMap free wiki world map.+ * 'scholar' -- Google scholar academic search.  * 'thesaurus' -- thesaurus.reference.com search.@@ -194,32 +202,19 @@ data Search = Search Name instance XPrompt Search where     showXPrompt (Search name)= "Search [" ++ name ++ "]: "+    nextCompletion _ = getNextCompletion+    commandToComplete _ c = c --- | Escape the search string so search engines understand it.--- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'--- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.+-- | Escape the search string so search engines understand it. Only+-- digits and ASCII letters are not encoded. All non ASCII characters+-- which are encoded as UTF8 escape :: String -> String-escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)-         where -- Copied from Network.URI.-           escapeURIString ::-               (Char -> Bool)      -- a predicate which returns 'False' if should escape-               -> String           -- the string to process-               -> String           -- the resulting URI string-           escapeURIString = concatMap . escapeURIChar-           escapeURIChar :: (Char->Bool) -> Char -> String-           escapeURIChar p c-               | p c       = [c]-               | otherwise = '%' : myShowHex (ord c) ""-               where-                 myShowHex :: Int -> ShowS-                 myShowHex n r =  case showIntAtBase 16 toChrHex n r of-                                    []  -> "00"-                                    [ch] -> ['0',ch]-                                    cs  -> cs-                 toChrHex d-                   | d < 10    = chr (ord '0' + fromIntegral d)-                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))+escape = concatMap escapeURIChar +escapeURIChar :: Char -> String+escapeURIChar c | isAscii c && isAlphaNum c = [c]+                | otherwise                 = concatMap (printf "%%%02X") $ encode [c]+ type Browser      = FilePath type Query        = String type Site         = String -> String@@ -258,8 +253,8 @@    inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.  > searchFunc :: String -> String-> searchFunc s | s `isPrefixOf` "wiki:"   = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)->              | s `isPrefixOf` "http://" = s+> searchFunc s | "wiki:"   `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)+>              | "http://" `isPrefixOf` s = s >              | otherwise               = (use google) s > myNewEngine = searchEngineF "mymulti" searchFunc @@ -276,36 +271,34 @@  -- The engines. amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,-  images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary,+  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary,   youtube :: SearchEngine-amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="-alpha      = searchEngine "alpha"      "http://www.wolframalpha.com/input/?i="-codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="-deb        = searchEngine "deb"        "http://packages.debian.org/"-debbts     = searchEngine "debbts"     "http://bugs.debian.org/"-debpts     = searchEngine "debpts"     "http://packages.qa.debian.org/"-dictionary = searchEngine "dict"       "http://dictionary.reference.com/browse/"-google     = searchEngine "google"     "http://www.google.com/search?num=100&q="-hackage    = searchEngine "hackage"    "http://hackage.haskell.org/package/"-hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="-images     = searchEngine "images"     "http://images.google.fr/images?q="-imdb       = searchEngine "imdb"       "http://www.imdb.com/Find?select=all&for="-isohunt    = searchEngine "isohunt"    "http://isohunt.com/torrents/?ihq="-lucky      = searchEngine "lucky"      "http://www.google.com/search?btnI&q="-maps       = searchEngine "maps"       "http://maps.google.com/maps?q="-mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="-scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="-thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="-wikipedia  = searchEngine "wiki"       "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="-wiktionary = searchEngine "wikt"      "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="-youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="-{- This doesn't seem to work, but nevertheless, it seems to be the official-   method at <http://web.archive.org/collections/web/advanced.html> to get the-   latest backup. -}-wayback   = searchEngine "wayback" "http://web.archive.org/"+amazon        = searchEngine "amazon"        "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="+alpha         = searchEngine "alpha"         "http://www.wolframalpha.com/input/?i="+codesearch    = searchEngine "codesearch"    "http://www.google.com/codesearch?q="+deb           = searchEngine "deb"           "http://packages.debian.org/"+debbts        = searchEngine "debbts"        "http://bugs.debian.org/"+debpts        = searchEngine "debpts"        "http://packages.qa.debian.org/"+dictionary    = searchEngine "dict"          "http://dictionary.reference.com/browse/"+google        = searchEngine "google"        "http://www.google.com/search?num=100&q="+hackage       = searchEngine "hackage"       "http://hackage.haskell.org/package/"+hoogle        = searchEngine "hoogle"        "http://www.haskell.org/hoogle/?q="+images        = searchEngine "images"        "http://images.google.fr/images?q="+imdb          = searchEngine "imdb"          "http://www.imdb.com/find?s=all&q="+isohunt       = searchEngine "isohunt"       "http://isohunt.com/torrents/?ihq="+lucky         = searchEngine "lucky"         "http://www.google.com/search?btnI&q="+maps          = searchEngine "maps"          "http://maps.google.com/maps?q="+mathworld     = searchEngine "mathworld"     "http://mathworld.wolfram.com/search/?query="+openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="+scholar       = searchEngine "scholar"       "http://scholar.google.com/scholar?q="+thesaurus     = searchEngine "thesaurus"     "http://thesaurus.reference.com/search?q="+wikipedia     = searchEngine "wiki"          "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="+wiktionary    = searchEngine "wikt"          "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="+youtube       = searchEngine "youtube"       "http://www.youtube.com/results?search_type=search_videos&search_query="+wayback       = searchEngineF "wayback"      ("http://web.archive.org/web/*/"++)  multi :: SearchEngine-multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]+multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]  {- | This function wraps up a search engine and creates a new one, which works    like the argument, but goes directly to a URL if one is given rather than@@ -334,14 +327,14 @@   \"mathworld:integral\" will search mathworld, and everything else will fall back to   google. The use of intelligent will make sure that URLs are opened directly. -} (!>) :: SearchEngine -> SearchEngine -> SearchEngine-(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `isPrefixOf` (name1++":") then site1 (removeColonPrefix s) else site2 s)+(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)  {- | Makes a search engine prefix-aware. Especially useful together with '!>'.    It will automatically remove the prefix from a query so that you don\'t end      up searching for google:xmonad if google is your fallback engine and you      explicitly add the prefix. -} prefixAware :: SearchEngine -> SearchEngine-prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `isPrefixOf` (name++":") then site $ removeColonPrefix s else site s)+prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s)  {- | Changes search engine's name -} namedEngine :: Name -> SearchEngine -> SearchEngine
XMonad/Actions/SpawnOn.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Actions.SpawnOn@@ -18,7 +19,6 @@     -- * Usage     -- $usage     Spawner,-    mkSpawner,     manageSpawn,     spawnHere,     spawnOn,@@ -28,7 +28,6 @@ ) where  import Data.List (isInfixOf)-import Data.IORef import System.Posix.Types (ProcessID)  import XMonad@@ -37,6 +36,7 @@ import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell+import qualified XMonad.Util.ExtensibleState as XS  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -44,17 +44,16 @@ -- >    import XMonad.Actions.SpawnOn -- -- >    main = do--- >      sp <- mkSpawner -- >      xmonad defaultConfig { -- >         ...--- >         manageHook = manageSpawn sp <+> manageHook defaultConfig+-- >         manageHook = manageSpawn <+> manageHook defaultConfig -- >         ... -- >      } -- -- To ensure that application appears on a workspace it was launched at, add keybindings like: ----- >  , ((mod1Mask,xK_o), spawnHere sp "urxvt")--- >  , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig)+-- >  , ((mod1Mask,xK_o), spawnHere "urxvt")+-- >  , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig) -- -- The module can also be used to apply other manage hooks to the window of -- the spawned application(e.g. float or resize it).@@ -62,26 +61,29 @@ -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]}+newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable +instance ExtensionClass Spawner where+    initialValue = Spawner []+ maxPids :: Int maxPids = 5 --- | Create 'Spawner' which then has to be passed to other functions.-mkSpawner :: (Functor m, MonadIO m) => m Spawner-mkSpawner = io . fmap Spawner $ newIORef []+-- | Get the current Spawner or create one if it doesn't exist.+modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()+modifySpawner f = XS.modify (Spawner . f . pidsRef)  -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc.-manageSpawn :: Spawner -> ManageHook-manageSpawn sp = do-    pids <- io . readIORef $ pidsRef sp+manageSpawn :: ManageHook+manageSpawn = do+    Spawner pids <- liftX XS.get     mp <- pid     case flip lookup pids =<< mp of-        Nothing -> doF id+        Nothing -> idHook         Just mh  -> do             whenJust mp $ \p ->-                io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst)+                liftX . modifySpawner $ filter ((/= p) . fst)             mh  mkPrompt :: (String -> X ()) -> XPConfig -> X ()@@ -91,32 +93,31 @@  -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on current workspace.-shellPromptHere :: Spawner -> XPConfig -> X ()-shellPromptHere sp = mkPrompt (spawnHere sp)+shellPromptHere :: XPConfig -> X ()+shellPromptHere = mkPrompt spawnHere  -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on given workspace.-shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X ()-shellPromptOn sp ws = mkPrompt (spawnOn sp ws)+shellPromptOn :: WorkspaceId -> XPConfig -> X ()+shellPromptOn ws = mkPrompt (spawnOn ws)  -- | Replacement for 'spawn' which launches -- application on current workspace.-spawnHere :: Spawner -> String -> X ()-spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd+spawnHere :: String -> X ()+spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd  -- | Replacement for 'spawn' which launches -- application on given workspace.-spawnOn :: Spawner -> WorkspaceId -> String -> X ()-spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd+spawnOn :: WorkspaceId -> String -> X ()+spawnOn ws cmd = spawnAndDo (doShift ws) cmd  -- | Spawn an application and apply the manage hook when it opens.-spawnAndDo :: Spawner -> ManageHook -> String -> X ()-spawnAndDo sp mh cmd = do+spawnAndDo :: ManageHook -> String -> X ()+spawnAndDo mh cmd = do     p <- spawnPID $ mangle cmd-    io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :))+    modifySpawner $ (take maxPids . ((p,mh) :))  where     -- TODO this is silly, search for a better solution     mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs               | otherwise = "exec " ++ xs     metaChars = "&|;"-
XMonad/Actions/Submap.hs view
@@ -76,6 +76,7 @@             else return (m, keysym)     -- Remove num lock mask and Xkb group state bits     m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)-    maybe def id (M.lookup (m', s) keys)      io $ ungrabKeyboard d currentTime++    maybe def id (M.lookup (m', s) keys)
XMonad/Actions/SwapWorkspaces.hs view
@@ -25,7 +25,6 @@ import XMonad (windows, X()) import XMonad.StackSet import XMonad.Actions.CycleWS-import XMonad.Util.Types import XMonad.Util.WorkspaceCompare
XMonad/Actions/TagWindows.hs view
@@ -22,17 +22,23 @@                  focusDownTagged, focusDownTaggedGlobal,                  shiftHere, shiftToScreen,                  tagPrompt,-                 tagDelPrompt+                 tagDelPrompt,+                 TagPrompt,                  ) where -import Data.List (nub,concat,sortBy)+import Prelude hiding (catch)+import Data.List (nub,sortBy) import Control.Monad+import Control.Exception  import XMonad.StackSet hiding (filter)  import XMonad.Prompt import XMonad hiding (workspaces) +econst :: Monad m => a -> IOException -> m a+econst = const . return+ -- $usage -- -- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:@@ -79,7 +85,7 @@     io $ catch (internAtom d "_XMONAD_TAGS" False >>=                 getTextProperty d w >>=                 wcTextPropertyToTextList d)-               (\_ -> return [[]])+               (econst [[]])     >>= return . words . unwords  -- | check a window for the given tag
XMonad/Actions/TopicSpace.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Actions.TopicSpace@@ -21,8 +22,10 @@    Topic   , Dir   , TopicConfig(..)+  , defaultTopicConfig   , getLastFocusedTopics   , setLastFocusedTopic+  , reverseLastFocusedTopics   , pprWindowSet   , topicActionWithPrompt   , topicAction@@ -39,13 +42,12 @@ import XMonad  import Data.List-import Data.Maybe (fromMaybe, isNothing, listToMaybe)+import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust) import Data.Ord import qualified Data.Map as M-import Control.Monad ((=<<),liftM2,when,unless,replicateM_)+import Control.Monad (liftM2,when,unless,replicateM_) import System.IO -import XMonad.Operations import qualified XMonad.StackSet as W  import XMonad.Prompt@@ -56,7 +58,7 @@ import qualified XMonad.Hooks.DynamicLog as DL  import XMonad.Util.Run (spawnPipe)-import XMonad.Util.StringProp(getStringListProp,setStringListProp)+import qualified XMonad.Util.ExtensibleState as XS  -- $overview -- This module allows to organize your workspaces on a precise topic basis.  So@@ -204,20 +206,38 @@                                  -- numeric keypad.                                } +defaultTopicConfig :: TopicConfig+defaultTopicConfig = TopicConfig { topicDirs = M.empty+                                 , topicActions = M.empty+                                 , defaultTopicAction = const (ask >>= spawn . terminal . config)+                                 , defaultTopic = "1"+                                 , maxTopicHistory = 10+                                 }++newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)+instance ExtensionClass PrevTopics where+    initialValue = PrevTopics []+    extensionType = PersistentExtension+ -- | Returns the list of last focused workspaces the empty list otherwise.--- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES. getLastFocusedTopics :: X [String]-getLastFocusedTopics = asks display >>= flip getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"+getLastFocusedTopics = XS.gets getPrevTopics  -- | Given a 'TopicConfig', the last focused topic, and a predicate that will -- select topics that one want to keep, this function will set the property -- of last focused topics.-setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()-setLastFocusedTopic tg w predicate = do-  disp <- asks display-  setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES"-    . take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics+setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()+setLastFocusedTopic w predicate =+  XS.modify $ PrevTopics+    . seqList . nub . (w:) . filter predicate+    . getPrevTopics+  where seqList xs = length xs `seq` xs +-- | Reverse the list of "last focused topics"+reverseLastFocusedTopics :: X ()+reverseLastFocusedTopics =+  XS.modify $ PrevTopics . reverse . getPrevTopics+ -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically -- and highlighting topics with urgent windows.@@ -227,13 +247,13 @@     urgents <- readUrgents     let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset         maxDepth = maxTopicHistory tg-    setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset)-                           (`notElem` empty_workspaces)+    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)+                        (`notElem` empty_workspaces)     lastWs <- getLastFocusedTopics-    let depth topic = elemIndex topic lastWs-        add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic+    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])+        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic         pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }-        sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)+        sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)     return $ DL.pprWindowSet sortWindows urgents pp' winset  -- | Given a prompt configuration and a topic configuration, triggers the action associated with@@ -257,7 +277,7 @@   when (null wins) $ topicAction tg topic  -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.-switchNthLastFocused ::TopicConfig -> Int -> X ()+switchNthLastFocused :: TopicConfig -> Int -> X () switchNthLastFocused tg depth = do   lastWs <- getLastFocusedTopics   switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
XMonad/Actions/UpdateFocus.hs view
@@ -21,7 +21,6 @@  import XMonad import qualified XMonad.StackSet as W-import Graphics.X11.Xlib.Extras import Control.Monad (when) import Data.Monoid @@ -45,10 +44,10 @@     -- check only every 15 px to avoid excessive calls to translateCoordinates     when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do       dpy <- asks display-      Just foc <- withWindowSet $ return . W.peek+      foc <- withWindowSet $ return . W.peek       -- get the window under the pointer:       (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y)-      when (foc /= w) $ focus w+      when (foc /= Just w) $ focus w     return (All True) focusOnMouseMove _ = return (All True)
XMonad/Actions/UpdatePointer.hs view
@@ -24,6 +24,7 @@     where  import XMonad+import XMonad.Util.XUtils (fi) import Control.Monad import XMonad.StackSet (member, peek, screenDetail, current) import Data.Maybe@@ -91,8 +92,10 @@         where fraction x y = floor (x * fromIntegral y)  windowAttributesToRectangle :: WindowAttributes -> Rectangle-windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))     (fi (wa_y wa))-                                           (fi (wa_width wa)) (fi (wa_height wa))+windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))+                                           (fi (wa_y wa))+                                           (fi (wa_width wa + 2 * wa_border_width wa))+                                           (fi (wa_height wa + 2 * wa_border_width wa)) moveWithin :: Ord a => a -> a -> a -> a moveWithin now lower upper =     if now < lower@@ -100,6 +103,3 @@     else if now > upper          then upper          else now--fi :: (Num b, Integral a) => a -> b-fi = fromIntegral
XMonad/Actions/Warp.hs view
@@ -22,7 +22,6 @@                            warpToWindow                           ) where -import Data.Ratio import Data.List import XMonad import XMonad.StackSet as W
XMonad/Actions/WindowBringer.hs view
@@ -17,7 +17,9 @@ module XMonad.Actions.WindowBringer (                     -- * Usage                     -- $usage-                    gotoMenu, gotoMenu', bringMenu, windowMap,+                    gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs',+                    bringMenu, bringMenu', bringMenuArgs, bringMenuArgs',+                    windowMap,                     bringWindow                    ) where @@ -27,7 +29,7 @@ import qualified XMonad.StackSet as W import XMonad import qualified XMonad as X-import XMonad.Util.Dmenu (menuMap)+import XMonad.Util.Dmenu (menuMapArgs) import XMonad.Util.NamedWindows (getName)  -- $usage@@ -44,34 +46,66 @@ -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". +-- | Default menu command+defaultCmd :: String+defaultCmd = "dmenu"  -- | Pops open a dmenu with window titles. Choose one, and you will be --   taken to the corresponding workspace. gotoMenu :: X ()-gotoMenu = actionMenu W.focusWindow+gotoMenu = gotoMenuArgs [] +-- | Pops open a dmenu with window titles. Choose one, and you will be+--   taken to the corresponding workspace. This version takes a list of+--   arguments to pass to dmenu.+gotoMenuArgs :: [String] -> X ()+gotoMenuArgs menuArgs = gotoMenuArgs' defaultCmd menuArgs++-- | Pops open an application with window titles given over stdin. Choose one,+--   and you will be taken to the corresponding workspace. gotoMenu' :: String -> X ()-gotoMenu' menuCmd = actionMenu' menuCmd W.focusWindow+gotoMenu' menuCmd = gotoMenuArgs' menuCmd [] +-- | Pops open an application with window titles given over stdin. Choose one,+--   and you will be taken to the corresponding workspace. This version takes a+--   list of arguments to pass to dmenu.+gotoMenuArgs' :: String -> [String] -> X ()+gotoMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs W.focusWindow+ -- | Pops open a dmenu with window titles. Choose one, and it will be --   dragged, kicking and screaming, into your current workspace. bringMenu :: X ()-bringMenu = actionMenu bringWindow+bringMenu = bringMenuArgs [] +-- | Pops open a dmenu with window titles. Choose one, and it will be+--   dragged, kicking and screaming, into your current workspace. This version+--   takes a list of arguments to pass to dmenu.+bringMenuArgs :: [String] -> X ()+bringMenuArgs menuArgs = bringMenuArgs' defaultCmd menuArgs++-- | Pops open an application with window titles given over stdin. Choose one,+--   and it will be dragged, kicking and screaming, into your current+--   workspace.+bringMenu' :: String -> X ()+bringMenu' menuCmd = bringMenuArgs' menuCmd []++-- | Pops open an application with window titles given over stdin. Choose one,+--   and it will be dragged, kicking and screaming, into your current+--   workspace. This version allows arguments to the chooser to be specified.+bringMenuArgs' :: String -> [String] -> X ()+bringMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs bringWindow+ -- | Brings the specified window into the current workspace. bringWindow :: Window -> X.WindowSet -> X.WindowSet bringWindow w ws = W.shiftWin (W.currentTag ws) w ws  -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action --   if found.-actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()-actionMenu action = actionMenu' "dmenu" action--actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X()-actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)+actionMenu :: String -> [String] -> (Window -> X.WindowSet -> X.WindowSet) -> X ()+actionMenu menuCmd menuArgs action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)     where       menuMapFunction :: M.Map String a -> X (Maybe a)-      menuMapFunction selectionMap = menuMap menuCmd selectionMap+      menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs selectionMap  -- | A map from window names to Windows. windowMap :: X (M.Map String Window)
XMonad/Actions/WindowGo.hs view
@@ -80,8 +80,11 @@ ifWindow :: Query Bool -> ManageHook -> X () -> X () ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head) --- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.---   Presumably this executable is the same one that you were looking for.+{- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.+   Presumably this executable is the same one that you were looking for.+   Note that this does not go through the shell. If you wish to run an arbitrary IO action+   (such as 'spawn', which will run its String argument through the shell), then you will want to use+   'raiseMaybe' directly. -} runOrRaise :: String -> Query Bool -> X () runOrRaise = raiseMaybe . safeSpawnProg @@ -160,11 +163,11 @@ {- | If the window is found the window is focused and the third argument is called      otherwise, the first argument is called      See 'raiseMaster' for an example. -}-raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X ()+raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X () raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f     where afterRaise = ask >>= (>> idHook) . liftX . after -{- | If a window matching the second arugment is found, the window is focused and the third argument is called;+{- | If a window matching the second argument is found, the window is focused and the third argument is called;      otherwise, the first argument is called. -} runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X () runOrRaiseAndDo = raiseAndDo . safeSpawnProg
XMonad/Actions/WindowMenu.hs view
@@ -41,6 +41,14 @@ -- -- >    , ((modm,               xK_o ), windowMenu) +colorizer :: a -> Bool -> X (String, String)+colorizer _ isFg = do+    fBC <- asks (focusedBorderColor . config)+    nBC <- asks (normalBorderColor . config)+    return $ if isFg+                then (fBC, nBC)+                else (nBC, fBC)+ windowMenu :: X () windowMenu = withFocused $ \w -> do     tags <- asks (workspaces . config)@@ -48,13 +56,13 @@     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh         originFractY = (fi y - fi sy + fi ht / 2) / fi sht-        gsConfig = defaultGSConfig+        gsConfig = (buildDefaultGSConfig colorizer)                     { gs_originFractX = originFractX                     , gs_originFractY = originFractY }         actions = [ ("Cancel menu", return ())                   , ("Close"      , kill)                   , ("Maximize"   , sendMessage $ maximizeRestore w)-                  , ("Minimize"   , sendMessage $ MinimizeWin w)+                  , ("Minimize"   , minimizeWindow w)                   ] ++                   [ ("Move to " ++ tag, windows $ W.shift tag)                     | tag <- tags ]
XMonad/Actions/WindowNavigation.hs view
@@ -36,7 +36,7 @@                                        withWindowNavigationKeys,                                        WNAction(..),                                        go, swap,-                                       Direction2D(..)+                                       Direction2D(..), WNState,                                        ) where  import XMonad@@ -52,7 +52,6 @@ import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Ord (comparing) import qualified Data.Set as S-import Graphics.X11.Xlib  -- $usage --
XMonad/Actions/WithAll.hs view
@@ -18,8 +18,6 @@ import Data.Foldable hiding (foldr)  import XMonad-import XMonad.Core-import XMonad.Operations import XMonad.StackSet  -- $usage
XMonad/Actions/WorkspaceCursors.hs view
@@ -32,10 +32,13 @@      -- * Functions to pass to 'modifyLayer'     ,focusNth'-    ,noWrapUp,noWrapDown+    ,noWrapUp,noWrapDown,      -- * Todo     -- $todo++    -- * Types+    Cursors,     ) where  import qualified XMonad.StackSet as W
+ XMonad/Actions/WorkspaceNames.hs view
@@ -0,0 +1,152 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.WorkspaceNames+-- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Tomas Janousek <tomi@nomi.cz>+-- Stability   :  experimental+-- Portability :  unportable+--+-- Provides bindings to rename workspaces, show these names in DynamicLog and+-- swap workspaces along with their names. These names survive restart.+-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully+-- dynamic topic space workflow.+--+-----------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}++module XMonad.Actions.WorkspaceNames (+    -- * Usage+    -- $usage++    -- * Workspace naming+    renameWorkspace,+    workspaceNamesPP,+    getWorkspaceNames,+    setWorkspaceName,+    setCurrentWorkspaceName,++    -- * Workspace swapping+    swapTo,+    swapTo',+    swapWithCurrent,+    ) where++import XMonad+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS++import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))+import qualified XMonad.Actions.SwapWorkspaces as Swap+import XMonad.Hooks.DynamicLog (PP(..))+import XMonad.Prompt (mkXPrompt, XPConfig)+import XMonad.Prompt.Workspace (Wor(Wor))+import XMonad.Util.WorkspaceCompare (getSortByIndex)++import qualified Data.Map as M+import Data.Maybe (fromMaybe)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.WorkspaceNames+--+-- Then add keybindings like the following:+--+-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)+--+-- and apply workspaceNamesPP to your DynamicLog pretty-printer:+--+-- > myLogHook =+-- >     workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog+--+-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s+-- functionality, which may be used this way:+--+-- >   , ((modMask .|. shiftMask, xK_Left  ), swapTo Prev)+-- >   , ((modMask .|. shiftMask, xK_Right ), swapTo Next)+--+-- > [((modm .|. controlMask, k), swapWithCurrent i)+-- >     | (i, k) <- zip workspaces [xK_1 ..]]+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++++-- | Workspace names container.+newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)+    deriving (Typeable, Read, Show)++instance ExtensionClass WorkspaceNames where+    initialValue = WorkspaceNames M.empty+    extensionType = PersistentExtension++-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for+-- workspaces with a name, and to @\"t\"@ otherwise.+getWorkspaceNames :: X (WorkspaceId -> String)+getWorkspaceNames = do+    WorkspaceNames m <- XS.get+    return $ \wks -> case M.lookup wks m of+        Nothing -> wks+        Just s  -> wks ++ ":" ++ s++-- | Sets the name of a workspace. Empty string makes the workspace unnamed+-- again.+setWorkspaceName :: WorkspaceId -> String -> X ()+setWorkspaceName w name = do+    WorkspaceNames m <- XS.get+    XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m+    refresh++-- | Sets the name of the current workspace. See 'setWorkspaceName'.+setCurrentWorkspaceName :: String -> X ()+setCurrentWorkspaceName name = do+    current <- gets (W.currentTag . windowset)+    setWorkspaceName current name++-- | Prompt for a new name for the current workspace and set it.+renameWorkspace :: XPConfig -> X ()+renameWorkspace conf = do+    mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName+    where pr = Wor "Workspace name: "++-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show+-- workspace names as well.+workspaceNamesPP :: PP -> X PP+workspaceNamesPP pp = do+    names <- getWorkspaceNames+    return $+        pp {+            ppCurrent         = ppCurrent         pp . names,+            ppVisible         = ppVisible         pp . names,+            ppHidden          = ppHidden          pp . names,+            ppHiddenNoWindows = ppHiddenNoWindows pp . names,+            ppUrgent          = ppUrgent          pp . names+        }++-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.+swapTo :: Direction1D -> X ()+swapTo dir = swapTo' dir AnyWS++-- | Swap with the previous or next workspace of the given type.+swapTo' :: Direction1D -> WSType -> X ()+swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent++-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the+-- same with names.+swapWithCurrent :: WorkspaceId -> X ()+swapWithCurrent t = do+    current <- gets (W.currentTag . windowset)+    swapNames t current+    windows $ Swap.swapWorkspaces t current++-- | Swap names of the two workspaces.+swapNames :: WorkspaceId -> WorkspaceId -> X ()+swapNames w1 w2 = do+    WorkspaceNames m <- XS.get+    let getname w = fromMaybe "" $ M.lookup w m+        set w name m' = if null name then M.delete w m' else M.insert w name m'+    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
XMonad/Config/Arossato.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE NoMonomorphismRestriction #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Config.Arossato
XMonad/Config/Azerty.hs view
@@ -38,7 +38,7 @@ -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c } -azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c }+azertyConfig = defaultConfig { keys = azertyKeys <+> keys defaultConfig }  azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
+ XMonad/Config/Bluetile.hs view
@@ -0,0 +1,217 @@+{-# OPTIONS -fno-warn-missing-signatures #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Bluetile+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- This is the default configuration of Bluetile+-- (<http://projects.haskell.org/bluetile/>). If you+-- are migrating from Bluetile to xmonad or want to create+-- a similar setup, then this will give you pretty much+-- the same thing, except for Bluetile's helper applications+-- such as the dock.+--+-----------------------------------------------------------------------------++module XMonad.Config.Bluetile (+    -- * Usage+    -- $usage+    bluetileConfig+    ) where++import XMonad hiding ( (|||) )++import XMonad.Layout.BorderResize+import XMonad.Layout.BoringWindows+import XMonad.Layout.ButtonDecoration+import XMonad.Layout.Decoration+import XMonad.Layout.DecorationAddons+import XMonad.Layout.DraggingVisualizer+import XMonad.Layout.LayoutCombinators+import XMonad.Layout.Maximize+import XMonad.Layout.Minimize+import XMonad.Layout.MouseResizableTile+import XMonad.Layout.Named+import XMonad.Layout.NoBorders+import XMonad.Layout.PositionStoreFloat+import XMonad.Layout.WindowSwitcherDecoration++import XMonad.Actions.BluetileCommands+import XMonad.Actions.CycleWS+import XMonad.Actions.WindowMenu++import XMonad.Hooks.CurrentWorkspaceOnTop+import XMonad.Hooks.EwmhDesktops+import XMonad.Hooks.ManageDocks+import XMonad.Hooks.ManageHelpers+import XMonad.Hooks.PositionStoreHooks+import XMonad.Hooks.Minimize+import XMonad.Hooks.ServerMode+import XMonad.Hooks.WorkspaceByPos++import XMonad.Config.Gnome++import qualified XMonad.StackSet as W+import qualified Data.Map as M++import System.Exit+import Data.Monoid+import Control.Monad(when)++-- $usage+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Config.Bluetile+-- > import XMonad.Util.Replace+-- >+-- > main = replace >> xmonad bluetileConfig+--+-- The invocation of 'replace' will replace a currently running+-- window manager. This is the default behaviour of Bluetile as well.+-- See "XMonad.Util.Replace" for more information.++bluetileWorkspaces :: [String]+bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]++bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())+bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $+    -- launching and killing programs+    [ ((modMask'              , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal+    , ((modMask',               xK_p     ), gnomeRun)    --  %! Launch Gnome "Run application" dialog+    , ((modMask' .|. shiftMask, xK_c     ), kill) -- %! Close the focused window++    , ((modMask',               xK_F5 ), refresh) -- %! Resize viewed windows to the correct size+    , ((modMask' .|. shiftMask, xK_F5 ), setLayout $ XMonad.layoutHook conf) -- %!  Reset the layouts on the current workspace to default++    , ((modMask',               xK_o ), windowMenu)++    -- move focus up or down the window stack+    , ((modMask',               xK_Tab   ), focusDown) -- %! Move focus to the next window+    , ((modMask' .|. shiftMask, xK_Tab   ), focusUp) -- %! Move focus to the previous window+    , ((modMask',               xK_j     ), focusDown) -- %! Move focus to the next window+    , ((modMask',               xK_k     ), focusUp) -- %! Move focus to the previous window+    , ((modMask',               xK_space ), focusMaster) -- %! Move focus to the master window++    -- modifying the window order+    , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window+    , ((modMask' .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window+    , ((modMask' .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window++    -- resizing the master/slave ratio+    , ((modMask',               xK_h     ), sendMessage Shrink) -- %! Shrink the master area+    , ((modMask',               xK_l     ), sendMessage Expand) -- %! Expand the master area+    , ((modMask',               xK_u     ), sendMessage ShrinkSlave) -- %! Shrink a slave area+    , ((modMask',               xK_i     ), sendMessage ExpandSlave) -- %! Expand a slave area++    -- floating layer support+    , ((modMask',               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling+    , ((modMask' .|. shiftMask, xK_t     ), withFocused $ float ) -- %! Float window++    -- increase or decrease number of windows in the master area+    , ((modMask'              , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area+    , ((modMask'              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area++    -- quit, or restart+    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit+    , ((modMask'              , xK_q     ), restart "xmonad" True) -- %! Restart++    -- Metacity-like workspace switching+    , ((mod1Mask .|. controlMask, xK_Left), prevWS)+    , ((mod1Mask .|. controlMask, xK_Right), nextWS)+    , ((mod1Mask .|. controlMask .|. shiftMask,   xK_Left), shiftToPrev >> prevWS)+    , ((mod1Mask .|. controlMask .|. shiftMask,   xK_Right), shiftToNext >> nextWS)++    -- more Metacity keys+    , ((mod1Mask             , xK_F2), gnomeRun)+    , ((mod1Mask             , xK_F4), kill)++    -- Switching to layouts+    , ((modMask'              , xK_a), sendMessage $ JumpToLayout "Floating")+    , ((modMask'              , xK_s), sendMessage $ JumpToLayout "Tiled1")+    , ((modMask'              , xK_d), sendMessage $ JumpToLayout "Tiled2")+    , ((modMask'              , xK_f), sendMessage $ JumpToLayout "Fullscreen")++    -- Maximizing+    , ((modMask'              , xK_z), withFocused (sendMessage . maximizeRestore))++    -- Minimizing+    , ((modMask',               xK_m     ), withFocused minimizeWindow)+    , ((modMask' .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)+    ]+    +++    -- mod-[1..9] ++ [0] %! Switch to workspace N+    -- mod-shift-[1..9] ++ [0] %! Move client to workspace N+    [((m .|. modMask', k), windows $ f i)+        | (i, k) <- zip (XMonad.workspaces conf) ([xK_1 .. xK_9] ++ [xK_0])+        , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+    +++    -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3+    -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3+    [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f))+        | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]+        , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]++bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())+bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $+    -- mod-button1 %! Move a floated window by dragging+    [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $+                                focus w >> mouseMoveWindow w >> windows W.shiftMaster))+    -- mod-button2 %! Switch to next and first layout+    , ((modMask', button2), (\_ -> sendMessage NextLayout))+    , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))+    -- mod-button3 %! Resize a floated window by dragging+    , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $+                                focus w >> mouseResizeWindow w >> windows W.shiftMaster))+    ]++isFloating :: Window -> X (Bool)+isFloating w = do+    ws <- gets windowset+    return $ M.member w (W.floating ws)++bluetileManageHook :: ManageHook+bluetileManageHook = composeAll+               [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons)+                , className =? "MPlayer" --> doFloat+                , isFullscreen --> doFullFloat+                , manageDocks]++bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (+                        named "Floating" floating |||+                        named "Tiled1" tiled1 |||+                        named "Tiled2" tiled2 |||+                        named "Fullscreen" fullscreen+                        )+        where+            floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat+            tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored+            tiled2 = tilingDeco $ maximize $ mouseResizableTile+            fullscreen = tilingDeco $ maximize $ smartBorders Full++            tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)+            floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l++bluetileConfig =+    defaultConfig+        { modMask = mod4Mask,   -- logo key+          manageHook = bluetileManageHook,+          layoutHook = bluetileLayoutHook,+          logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,+          handleEventHook = ewmhDesktopsEventHook+                                `mappend` fullscreenEventHook+                                `mappend` minimizeEventHook+                                `mappend` serverModeEventHook' bluetileCommands+                                `mappend` positionStoreEventHook,+          workspaces = bluetileWorkspaces,+          keys = bluetileKeys,+          mouseBindings = bluetileMouseBindings,+          focusFollowsMouse = False,+          focusedBorderColor = "#000000",+          terminal = "gnome-terminal"+        }
XMonad/Config/Desktop.hs view
@@ -54,7 +54,6 @@     ) where  import XMonad-import XMonad.Config (defaultConfig) import XMonad.Hooks.ManageDocks import XMonad.Hooks.EwmhDesktops import XMonad.Util.Cursor@@ -127,7 +126,7 @@ -- To add to the logHook while still sending workspace and window information -- to DE apps use something like: ----- >  , logHook = myLogHook >> logHook desktopConfig+-- >  , logHook = myLogHook <+> logHook desktopConfig -- -- Or for more elaborate logHooks you can use @do@: --@@ -139,25 +138,23 @@  -- $eventHook -- To customize xmonad's event handling while still having it respond--- to EWMH events from pagers, task bars, etc. add to your imports:------ > import Data.Monoid------ and use 'Data.Monoid.mappend' to combine event hooks (right to left application like @\<+\>@)+-- to EWMH events from pagers, task bars: ----- >  , handleEventHook = mappend myEventHooks (handleEventHook desktopConfig)+-- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig ----- or 'Data.Monoid.mconcat' (like @composeAll@)+-- or 'mconcat' if you write a list event of event hooks -- -- >  , handleEventHook = mconcat -- >        [ myMouseHandler -- >        , myMessageHandler -- >        , handleEventHook desktopConfig ] --+-- Note that the event hooks are run left to right (in contrast to+-- 'ManageHook'S which are right to left)  -- $startupHook -- To run the desktop startupHook, plus add further actions to be run each--- time xmonad starts or restarts, use '>>' to combine actions as in the+-- time xmonad starts or restarts, use '<+>' to combine actions as in the -- logHook example, or something like: -- -- >  , startupHook = do@@ -170,7 +167,7 @@     { startupHook     = setDefaultCursor xC_left_ptr     , layoutHook      = desktopLayoutModifiers $ layoutHook defaultConfig     , manageHook      = manageHook defaultConfig <+> manageDocks-    , keys            = \c -> desktopKeys c `M.union` keys defaultConfig c }+    , keys            = desktopKeys <+> keys defaultConfig }  desktopKeys (XConfig {modMask = modm}) = M.fromList $     [ ((modm, xK_b), sendMessage ToggleStruts) ]
XMonad/Config/Droundy.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}+{-# LANGUAGE PatternGuards #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (c) Spencer Janssen 2007@@ -10,7 +11,6 @@  import XMonad hiding (keys, config, (|||)) import qualified XMonad (keys)-import XMonad.Config ( defaultConfig )  import qualified XMonad.StackSet as W import qualified Data.Map as M
XMonad/Config/Gnome.hs view
@@ -41,7 +41,7 @@  gnomeConfig = desktopConfig     { terminal = "gnome-terminal"-    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c+    , keys     = gnomeKeys <+> keys desktopConfig     , startupHook = gnomeRegister >> startupHook desktopConfig }  gnomeKeys (XConfig {modMask = modm}) = M.fromList $
XMonad/Config/Kde.hs view
@@ -40,11 +40,11 @@  kdeConfig = desktopConfig     { terminal = "konsole"-    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }+    , keys     = kdeKeys <+> keys desktopConfig }  kde4Config = desktopConfig     { terminal = "konsole"-    , keys     = \c -> kde4Keys c `M.union` keys desktopConfig c }+    , keys     = kde4Keys <+> keys desktopConfig }  kdeKeys (XConfig {modMask = modm}) = M.fromList $     [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")
XMonad/Config/Sjanssen.hs view
@@ -1,60 +1,64 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-module XMonad.Config.Sjanssen (sjanssenConfig, sjanssenConfigXmobar) where+module XMonad.Config.Sjanssen (sjanssenConfig) where  import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W import XMonad.Actions.CopyWindow import XMonad.Layout.Tabbed import XMonad.Layout.HintedTile-import XMonad.Config (defaultConfig) import XMonad.Layout.NoBorders-import XMonad.Hooks.DynamicLog hiding (xmobar)+import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat) import XMonad.Hooks.EwmhDesktops import XMonad.Prompt import XMonad.Actions.SpawnOn+import XMonad.Util.SpawnOnce  import XMonad.Layout.LayoutScreens import XMonad.Layout.TwoPane  import qualified Data.Map as M -sjanssenConfigXmobar = statusBar "exec xmobar" sjanssenPP strutkey =<< sjanssenConfig- where-    strutkey (XConfig {modMask = modm}) = (modm, xK_b)--sjanssenConfig = do-    sp <- mkSpawner-    return . ewmh $ defaultConfig+sjanssenConfig =+    ewmh $ defaultConfig         { terminal = "exec urxvt"         , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]         , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $                 [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))                 , ((modm, button2), (\w -> focus w >> windows W.swapMaster))                 , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]-        , keys = \c -> mykeys sp c `M.union` keys defaultConfig c+        , keys = \c -> mykeys c `M.union` keys defaultConfig c+        , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog         , layoutHook  = modifiers layouts         , manageHook  = composeAll [className =? x --> doShift w                                     | (x, w) <- [ ("Firefox", "web")                                                 , ("Ktorrent", "7")                                                 , ("Amarokapp", "7")]]-                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp+                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn                         <+> (isFullscreen --> doFullFloat)+        , startupHook = mapM_ spawnOnce spawns         }  where     tiled     = HintedTile 1 0.03 0.5 TopLeft     layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme-    modifiers = smartBorders+    modifiers = avoidStruts . smartBorders -    mykeys sp (XConfig {modMask = modm}) = M.fromList $-        [((modm,               xK_p     ), shellPromptHere sp myPromptConfig)-        ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config))+    spawns = [ "xmobar"+             , "xset -b", "xset s off", "xset dpms 0 600 1200"+             , "nitrogen --set-tiled wallpaper/wallpaper.jpg"+             , "trayer --transparent true --expand true --align right "+               ++ "--edge bottom --widthtype request" ]++    mykeys (XConfig {modMask = modm}) = M.fromList $+        [((modm,               xK_p     ), shellPromptHere myPromptConfig)+        ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))         ,((modm .|. shiftMask, xK_c     ), kill1)         ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)         ,((modm .|. shiftMask, xK_0     ), windows $ copyToAll)         ,((modm,               xK_z     ), layoutScreens 2 $ TwoPane 0.5 0.5)         ,((modm .|. shiftMask, xK_z     ), rescreen)+        , ((modm             , xK_b     ), sendMessage ToggleStruts)         ]      myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
XMonad/Config/Xfce.hs view
@@ -36,7 +36,7 @@  xfceConfig = desktopConfig     { terminal = "Terminal"-    , keys     = \c -> xfceKeys c `M.union` keys desktopConfig c }+    , keys     = xfceKeys <+> keys desktopConfig }  xfceKeys (XConfig {modMask = modm}) = M.fromList $     [ ((modm,               xK_p), spawn "xfrun4")
XMonad/Doc/Developing.hs view
@@ -256,6 +256,9 @@ * Code should be compilable with "ghc-options: -Wall -Werror" set in the xmonad-contrib.cabal file. There should be no warnings. +* Code should be free of any warnings or errors from the Hlint tool; use your+  best judgement on some warnings like eta-reduction or bracket removal, though.+ * Partial functions should be avoided: the window manager should not   crash, so never call 'error' or 'undefined'.
XMonad/Doc/Extending.hs view
@@ -382,13 +382,17 @@ * "XMonad.Hooks.ManageHelpers": provide helper functions to be used   in @manageHook@. +* "XMonad.Hooks.Minimize":+    Handles window manager hints to minimize and restore windows. Use+    this with XMonad.Layout.Minimize.+ * "XMonad.Hooks.Place":     Automatic placement of floating windows.  * "XMonad.Hooks.RestoreMinimized":-    Lets you restore minimized windows (see "XMonad.Layout.Minimize")-    by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW-    and WM_CHANGE_STATE).+    (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized+    windows (see "XMonad.Layout.Minimize") by selecting them on a+    taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).  * "XMonad.Hooks.Script":     Provides a simple interface for running a ~\/.xmonad\/hooks script with the@@ -932,16 +936,18 @@  and provide an appropriate definition of @myKeys@, such as: -> myKeys conf@(XConfig {XMonad.modMask = modm}) =+> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList >             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) >             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig) >             ]  This particular definition also requires importing "XMonad.Prompt",-"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":+"XMonad.Prompt.Shell", "XMonad.Prompt.XMonad", and "Data.Map": -> import XMonadPrompt-> import ...  -- and so on+> import qualified Data.Map as M+> import XMonad.Prompt+> import XMonad.Prompt.Shell+> import XMonad.Prompt.XMonad  For a list of the names of particular keys (such as xK_F12, and so on), see@@ -977,7 +983,7 @@ For instance, if you have defined some additional key bindings like these: ->    myKeys conf@(XConfig {XMonad.modMask = modm}) =+>    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList >             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) >             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig) >             ]@@ -985,13 +991,19 @@ then you can create a new key bindings map by joining the default one with yours: ->    newKeys x  = M.union (keys defaultConfig x) (M.fromList (myKeys x))+>    newKeys x  = myKeys x `M.union` keys defaultConfig x  Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field of the configuration:  >    main = xmonad $ defaultConfig { keys = newKeys } +Alternatively, the '<+>' operator can be used which in this usage does exactly+the same as the explicit usage of 'M.union' and propagation of the config+argument, thanks to appropriate instances in "Data.Monoid".++>    main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }+ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:  @@ -1006,11 +1018,9 @@ >    import XMonad.Prompt.XMonad > >    main :: IO ()->    main = xmonad $ defaultConfig { keys = newKeys }->->    newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x))+>    main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig } >->    myKeys conf@(XConfig {XMonad.modMask = modm}) =+>    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList >             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) >             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig) >             ]@@ -1034,10 +1044,10 @@ to define @newKeys@ as a 'Data.Map.difference' between the default map and the map of the key bindings you want to remove.  Like so: ->    newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x)+>    newKeys x = keys defaultConfig x `M.difference` keysToRemove x >->    keysToRemove :: XConfig Layout ->    [((KeyMask, KeySym),X ())]->    keysToRemove x =+>    keysToRemove :: XConfig Layout ->    M.Map (KeyMask, KeySym) (X ())+>    keysToRemove x = M.fromList >             [ ((modm              , xK_q ), return ()) >             , ((modm .|. shiftMask, xK_q ), return ()) >             ]@@ -1164,7 +1174,7 @@  Then we create the combination of layouts we need: ->    mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion+>    mylayoutHook = Full ||| tabbed shrinkText defaultTheme ||| Accordion   Now, all we need to do is change the 'XMonad.Core.layoutHook'@@ -1178,11 +1188,11 @@ 'XMonad.Layout.NoBorders.noBorders' layout modifier, from the "XMonad.Layout.NoBorders" module (which must be imported): ->    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion)+>    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTheme ||| Accordion)  If we want only the tabbed layout without borders, then we may write: ->    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion  Our @~\/.xmonad\/xmonad.hs@ will now look like this: @@ -1192,7 +1202,7 @@ >    import XMonad.Layout.Accordion >    import XMonad.Layout.NoBorders >->    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion > >    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
+ XMonad/Hooks/CurrentWorkspaceOnTop.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveDataTypeable #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.CurrentWorkspaceOnTop+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- Ensures that the windows of the current workspace are always in front+-- of windows that are located on other visible screens. This becomes important+-- if you use decoration and drag windows from one screen to another. Using this+-- module, the dragged window will always be in front of other windows.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.CurrentWorkspaceOnTop (+    -- * Usage+    -- $usage+    currentWorkspaceOnTop+    ) where++import XMonad+import qualified XMonad.StackSet as S+import qualified XMonad.Util.ExtensibleState as XS+import Control.Monad(when)+import qualified Data.Map as M++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.CurrentWorkspaceOnTop+-- >+-- > main = xmonad $ defaultConfig {+-- >    ...+-- >    logHook = currentWorkspaceOnTop+-- >    ...+-- >  }+--++data CWOTState = CWOTS String deriving Typeable++instance ExtensionClass CWOTState where+  initialValue = CWOTS ""++currentWorkspaceOnTop :: X ()+currentWorkspaceOnTop = withDisplay $ \d -> do+    ws <- gets windowset+    (CWOTS lastTag) <- XS.get+    let curTag = S.tag . S.workspace . S.current $ ws+    when (curTag /= lastTag) $ do+        -- the following is more or less a reimplementation of what's happening in "XMonad.Operation"+        let s = S.current ws+            wsp = S.workspace s+            viewrect = screenRect $ S.screenDetail s+            tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)+        (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect+        updateLayout curTag ml'+        let this = S.view curTag ws+            fltWins = filter (flip M.member (S.floating ws)) $ S.index this+            wins = fltWins ++ (map fst rs)  -- order: first all floating windows, then the order the layout returned+        -- end of reimplementation++        when (not . null $ wins) $ do+            io $ raiseWindow d (head wins)  -- raise first window of current workspace to the very top,+            io $ restackWindows d wins      -- then use restackWindows to let all other windows from the workspace follow+        XS.put(CWOTS curTag)
+ XMonad/Hooks/DebugKeyEvents.hs view
@@ -0,0 +1,107 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.DebugKeyEvents+-- Copyright    : (c) 2011 Brandon S Allbery <allbery.b@gmail.com>+-- License      : BSD+--+-- Maintainer   : Brandon S Allbery <allbery.b@gmail.com>+-- Stability    : unstable+-- Portability  : unportable+--+-- A debugging module to track key events, useful when you can't tell whether+-- xmonad is processing some or all key events.+-----------------------------------------------------------------------------++module XMonad.Hooks.DebugKeyEvents (-- * Usage+                                    -- $usage+                                    debugKeyEvents+                                   ) where++import           XMonad.Core+import           XMonad.Operations               (cleanMask)++import           Graphics.X11.Xlib+import           Graphics.X11.Xlib.Extras++import           Control.Monad.State             (gets)+import           Data.Bits+import           Data.List                       (intercalate)+import           Data.Monoid+import           Numeric                         (showHex)+import           System.IO                       (hPutStrLn+                                                 ,stderr)++-- $usage+-- Add this to your handleEventHook to print received key events to the+-- log (the console if you use @startx@/@xinit@, otherwise usually+-- @~/.xsession-errors@).+--+-- >      , handleEventHook = debugKeyEvents+--+-- If you already have a handleEventHook then you should append it:+--+-- >      , handleEventHook = ... <+> debugKeyEvents+--+-- Logged key events look like:+--+-- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@+-- +-- The @mask@ and @clean@ indicate the modifiers pressed along with+-- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after+-- sanitizing it (removing @numberLockMask@, etc.)+--+-- For more detailed instructions on editing the logHook see:+--+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"++-- | Print key events to stderr for debugging+debugKeyEvents :: Event -> X All+debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})+  | t == keyPress =+      withDisplay $ \dpy -> do+        sym <- io $ keycodeToKeysym dpy code 0+        msk <- cleanMask m+        nl <- gets numberlockMask+        io $ hPutStrLn stderr $ intercalate " " ["keycode"+                                                ,show code+                                                ,"sym"+                                                ,show sym+                                                ," ("+                                                ,hex sym+                                                ," \""+                                                ,keysymToString sym+                                                ,"\") mask"+                                                ,hex m+                                                ,"(" ++ vmask nl m ++ ")"+                                                ,"clean"+                                                ,hex msk+                                                ,"(" ++ vmask nl msk ++ ")"+                                                ]+        return (All True)+debugKeyEvents _ = return (All True)++-- | Convenient showHex variant+hex :: (Integral n, Show n) => n -> String+hex v = "0x" ++ showHex v ""++-- | Convert a modifier mask into a useful string+vmask                 :: KeyMask -> KeyMask -> String+vmask numLockMask msk =  intercalate " " $+                         reverse $+                         fst $+                         foldr vmask' ([],msk) masks+    where+      masks = map (\m -> (m,show m)) [0..toEnum (bitSize msk - 1)] +++              [(numLockMask,"num"  )+              ,(   lockMask,"lock" )+              ,(controlMask,"ctrl" )+              ,(  shiftMask,"shift")+              ,(   mod5Mask,"mod5" )+              ,(   mod4Mask,"mod4" )+              ,(   mod3Mask,"mod3" )+              ,(   mod2Mask,"mod2" )+              ,(   mod1Mask,"mod1" )+              ]+      vmask'   _   a@( _,0)                = a+      vmask' (m,s)   (ss,v) | v .&. m == m = (s:ss,v .&. complement m)+      vmask'   _        r                  = r
XMonad/Hooks/DynamicHooks.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.DynamicHooks@@ -15,20 +16,18 @@ module XMonad.Hooks.DynamicHooks (   -- * Usage   -- $usage-  initDynamicHooks-  ,dynamicMasterHook+  dynamicMasterHook   ,addDynamicHook   ,updateDynamicHook   ,oneShotHook   ) where  import XMonad-import System.IO+import qualified XMonad.Util.ExtensibleState as XS  import Data.List import Data.Maybe (listToMaybe) import Data.Monoid-import Data.IORef  -- $usage -- Provides two new kinds of 'ManageHooks' that can be defined at runtime.@@ -40,68 +39,46 @@ -- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@! -- If you want them to last, you should create them as normal in your @xmonad.hs@. ----- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@:------ > dynHooksRef <- initDynamicHooks------ and then pass this value to the other functions in this module.------ You also need to add the base 'ManageHook':+-- To use this module, add 'dynamicMasterHook' to your 'manageHook': ----- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef }+-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook } ----- You must include this @dynHooksRef@ value when using the functions in this--- module:+-- You can then use the supplied functions in your keybindings: ----- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList--- >                   [((modm, xK_i), oneShotHook dynHooksRef--- >                    "FFlaunchHook" (className =? "firefox") (doShift "3")--- >                    >> spawn "firefox")--- >                   ,((modm, xK_u), addDynamicHook dynHooksRef--- >                     (className =? "example" --> doFloat))--- >                   ,((modm, xK_y), updatePermanentHook dynHooksRef--- >                     (const idHook))) ]  -- resets the permanent hook.+-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat) --  data DynamicHooks = DynamicHooks     { transients :: [(Query Bool, ManageHook)]     , permanent  :: ManageHook }----- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.-initDynamicHooks :: IO (IORef DynamicHooks)-initDynamicHooks = newIORef (DynamicHooks { transients = [],-                                            permanent = idHook })+                    deriving Typeable +instance ExtensionClass DynamicHooks where+    initialValue = DynamicHooks [] idHook --- this hook is always executed, and the IORef's contents checked.+-- this hook is always executed, and the contents of the stored hooks checked. -- note that transient hooks are run second, therefore taking precedence -- over permanent ones on matters such as which workspace to shift to. -- doFloat and doIgnore are idempotent. -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.-dynamicMasterHook :: IORef DynamicHooks -> ManageHook-dynamicMasterHook ref = return True -->-                  (ask >>= \w -> liftX (do-  dh <- io $ readIORef ref+dynamicMasterHook :: ManageHook+dynamicMasterHook = (ask >>= \w -> liftX (do+  dh <- XS.get   (Endo f)  <- runQuery (permanent dh) w   ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)   let (ts',nts) = partition fst ts   gs <- mapM (flip runQuery w . snd . snd) ts'   let (Endo g) = maybe (Endo id) id $ listToMaybe gs-  io $ writeIORef ref $ dh { transients = map snd nts }+  XS.put $ dh { transients = map snd nts }   return $ Endo $ f . g                                        ))- -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.-addDynamicHook :: IORef DynamicHooks -> ManageHook -> X ()-addDynamicHook ref m = updateDynamicHook ref (<+> m)-+addDynamicHook :: ManageHook -> X ()+addDynamicHook m = updateDynamicHook (<+> m)  -- | Modifies the permanent 'ManageHook' with an arbitrary function.-updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X ()-updateDynamicHook ref f =-    io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) }-+updateDynamicHook :: (ManageHook -> ManageHook) -> X ()+updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) }  -- | Creates a one-shot 'ManageHook'. Note that you have to specify the two -- parts of the 'ManageHook' separately. Where you would usually write:@@ -112,11 +89,5 @@ -- -- > oneShotHook dynHooksRef (className =? "example) doFloat ---oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X ()-oneShotHook ref q a =-  io $ modifyIORef ref-         $ \dh -> dh { transients = (q,a):(transients dh) }----+oneShotHook :: Query Bool -> ManageHook -> X ()+oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }
XMonad/Hooks/DynamicLog.hs view
@@ -29,6 +29,9 @@     dynamicLog,     dynamicLogXinerama, +    xmonadPropLog',+    xmonadPropLog,+     -- * Build your own formatter     dynamicLogWithPP,     dynamicLogString,@@ -51,24 +54,26 @@    ) where --- -- Useful imports----import XMonad-import Control.Monad-import Data.Char ( isSpace )++import Codec.Binary.UTF8.String (encodeString)+import Control.Monad (liftM2)+import Data.Char ( isSpace, ord )+import Data.List (intersperse, isPrefixOf, sortBy) import Data.Maybe ( isJust, catMaybes )-import Data.List-import qualified Data.Map as M import Data.Ord ( comparing )+import qualified Data.Map as M import qualified XMonad.StackSet as S-import System.IO++import Foreign.C (CChar)++import XMonad+ import XMonad.Util.WorkspaceCompare import XMonad.Util.NamedWindows import XMonad.Util.Run  import XMonad.Layout.LayoutModifier-import XMonad.Util.Font import XMonad.Hooks.UrgencyHook import XMonad.Hooks.ManageDocks @@ -204,6 +209,24 @@  where     keys' = (`M.singleton` sendMessage ToggleStruts) . k +-- | Write a string to a property on the root window.  This property is of+-- type UTF8_STRING. The string must have been processed by encodeString+-- (dynamicLogString does this).+xmonadPropLog' :: String -> String -> X ()+xmonadPropLog' prop msg = do+    d <- asks display+    r <- asks theRoot+    xlog <- getAtom prop+    ustring <- getAtom "UTF8_STRING"+    io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)+ where+    encodeCChar :: String -> [CChar]+    encodeCChar = map (fromIntegral . ord)++-- | Write a string to the _XMONAD_LOG property on the root window.+xmonadPropLog :: String -> X ()+xmonadPropLog = xmonadPropLog' "_XMONAD_LOG"+ -- | -- Helper function which provides ToggleStruts keybinding --@@ -251,9 +274,9 @@     wt <- maybe (return "") (fmap show . getName) . S.peek $ winset      -- run extra loggers, ignoring any that generate errors.-    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp+    extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp -    return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $+    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $                         [ ws                         , ppLayout pp ld                         , ppTitle  pp wt@@ -270,9 +293,9 @@          visibles = map (S.tag . S.workspace) (S.visible s)           fmt w = printer pp (S.tag w)-          where printer | S.tag w == this                                               = ppCurrent+          where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = ppUrgent+                        | S.tag w == this                                               = ppCurrent                         | S.tag w `elem` visibles                                       = ppVisible-                        | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = \ppC -> ppUrgent ppC . ppHidden ppC                         | isJust (S.stack w)                                            = ppHidden                         | otherwise                                                     = ppHiddenNoWindows @@ -284,10 +307,15 @@ -- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively, -- and 2 and 7 are non-visible, non-empty workspaces. ----- Unfortunately, at the present time, the current layout and window title--- are not shown, and there is no way to incorporate the xinerama--- workspace format shown above with 'dynamicLogWithPP'.  Hopefully this--- will change soon.+-- At the present time, the current layout and window title+-- are not shown.  The xinerama workspace format shown above can be (mostly) replicated+-- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from+-- "XMonad.Util.WorkspaceCompare".  For example,+--+-- > defaultPP { ppCurrent = dzenColor "red" "#efebe7"+-- >           , ppVisible = wrap "[" "]"+-- >           , ppSort    = getSortByXineramaRule+-- >           } dynamicLogXinerama :: X () dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama @@ -318,7 +346,7 @@ -- | Limit a string to a certain length, adding "..." if truncated. shorten :: Int -> String -> String shorten n xs | length xs < n = xs-             | otherwise     = (take (n - length end) xs) ++ end+             | otherwise     = take (n - length end) xs ++ end  where     end = "..." @@ -345,11 +373,7 @@ dzenEscape :: String -> String dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x]) --- | Strip dzen formatting or commands. Useful to remove ppHidden---   formatting in ppUrgent field. For example:------ >     , ppHidden          = dzenColor "gray20" "" . wrap "(" ")"--- >     , ppUrgent          = dzenColor "dark orange" "" .  dzenStrip+-- | Strip dzen formatting or commands. dzenStrip :: String -> String dzenStrip = strip [] where     strip keep x@@ -370,11 +394,7 @@  -- ??? add an xmobarEscape function? --- | Strip xmobar markup. Useful to remove ppHidden color from ppUrgent---   field. For example:------ >     , ppHidden          = xmobarColor "gray20" "" . wrap "<" ">"--- >     , ppUrgent          = xmobarColor "dark orange" "" .  xmobarStrip+-- | Strip xmobar markup. xmobarStrip :: String -> String xmobarStrip = strip [] where     strip keep x@@ -400,8 +420,6 @@                -- ^ how to print tags of empty hidden workspaces              , ppUrgent :: WorkspaceId -> String                -- ^ format to be applied to tags of urgent workspaces.-               -- NOTE that 'ppUrgent' is applied /in addition to/-               -- 'ppHidden'!              , ppSep :: String                -- ^ separator to use between different log sections                -- (window name, layout, workspaces)@@ -457,32 +475,31 @@                , ppExtras          = []                } --- | Settings to emulate dwm's statusbar, dzen only. Uses dzenStrip in--- ppUrgent.+-- | Settings to emulate dwm's statusbar, dzen only. dzenPP :: PP dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad-                     , ppVisible  = dzenColor "black" "#999999" . pad-                     , ppHidden   = dzenColor "black" "#cccccc" . pad-                     , ppHiddenNoWindows = const ""-                     , ppUrgent   = dzenColor "red" "yellow" . dzenStrip-                     , ppWsSep    = ""-                     , ppSep      = ""-                     , ppLayout   = dzenColor "black" "#cccccc" .-                                    (\ x -> case x of-                                              "TilePrime Horizontal" -> " TTT "-                                              "TilePrime Vertical"   -> " []= "-                                              "Hinted Full"          -> " [ ] "-                                              _                      -> pad x-                                    )-                     , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape-                     }+                   , ppVisible  = dzenColor "black" "#999999" . pad+                   , ppHidden   = dzenColor "black" "#cccccc" . pad+                   , ppHiddenNoWindows = const ""+                   , ppUrgent   = dzenColor "red" "yellow" . pad+                   , ppWsSep    = ""+                   , ppSep      = ""+                   , ppLayout   = dzenColor "black" "#cccccc" .+                                  (\ x -> pad $ case x of+                                            "TilePrime Horizontal" -> "TTT"+                                            "TilePrime Vertical"   -> "[]="+                                            "Hinted Full"          -> "[ ]"+                                            _                      -> x+                                  )+                   , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape+                   }  -- | Some nice xmobar defaults. xmobarPP :: PP xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"                      , ppTitle   = xmobarColor "green"  "" . shorten 40                      , ppVisible = wrap "(" ")"-                     , ppUrgent = xmobarColor "red" "yellow"+                     , ppUrgent  = xmobarColor "red" "yellow"                      }  -- | The options that sjanssen likes to use with xmobar, as an@@ -498,7 +515,7 @@ byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces                       , ppHidden  = dzenColor "black"  "#a8a3f7" . pad                       , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad-                      , ppUrgent  = dzenColor "red"    "yellow"+                      , ppUrgent  = dzenColor "red"    "yellow"  . pad                       , ppSep     = " | "                       , ppWsSep   = ""                       , ppTitle   = shorten 70@@ -507,4 +524,3 @@   where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']                                        then pad wsId                                        else ""-
XMonad/Hooks/EwmhDesktops.hs view
@@ -19,7 +19,8 @@     ewmhDesktopsStartup,     ewmhDesktopsLogHook,     ewmhDesktopsLogHookCustom,-    ewmhDesktopsEventHook+    ewmhDesktopsEventHook,+    fullscreenEventHook     ) where  import Codec.Binary.UTF8.String (encode)@@ -32,7 +33,9 @@ import qualified XMonad.StackSet as W  import XMonad.Hooks.SetWMName+import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare+import XMonad.Util.WindowProperties (getProp32)  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -132,14 +135,14 @@        a_cw <- getAtom "_NET_CLOSE_WINDOW"        a_ignore <- mapM getAtom ["XMONAD_TIMER"]        if  mt == a_cd then do-               let n = fromIntegral (head d)-               if 0 <= n && n < length ws then-                       windows $ W.view (W.tag (ws !! n))+               let n = head d+               if 0 <= n && fi n < length ws then+                       windows $ W.view (W.tag (ws !! fi n))                  else  trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n         else if mt == a_d then do-               let n = fromIntegral (head d)-               if 0 <= n && n < length ws then-                       windows $ W.shiftWin (W.tag (ws !! n)) w+               let n = head d+               if 0 <= n && fi n < length ws then+                       windows $ W.shiftWin (W.tag (ws !! fi n)) w                  else  trace $ "Bad _NET_DESKTOP with data[0]="++show n         else if mt == a_aw then do                windows $ W.focusWindow w@@ -153,6 +156,36 @@           return () handle _ = return () +-- |+-- An event hook to handle applications that wish to fullscreen using the+-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()+-- function, such as Totem, Evince and OpenOffice.org.+fullscreenEventHook :: Event -> X All+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do+  state <- getAtom "_NET_WM_STATE"+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"+  wstate <- fromMaybe [] `fmap` getProp32 state win++  let isFull = fromIntegral fullsc `elem` wstate++      -- Constants for the _NET_WM_STATE protocol:+      remove = 0+      add = 1+      toggle = 2+      ptype = 4 -- The atom property type for changeProperty+      chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)++  when (typ == state && fi fullsc `elem` dats) $ do+    when (action == add || (action == toggle && not isFull)) $ do+      chWstate (fi fullsc:)+      windows $ W.float win $ W.RationalRect 0 0 1 1+    when (action == remove || (action == toggle && isFull)) $ do+      chWstate $ delete (fi fullsc)+      windows $ W.sink win++  return $ All True++fullscreenEventHook _ = return $ All True  setNumberOfDesktops :: (Integral a) => a -> X () setNumberOfDesktops n = withDisplay $ \dpy -> do
XMonad/Hooks/FadeInactive.hs view
@@ -44,7 +44,7 @@ -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps> -- or something similar for this to do anything ----- For more detailed instructions on editing the layoutHook see:+-- For more detailed instructions on editing the logHook see: -- -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" --
+ XMonad/Hooks/FadeWindows.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.FadeWindows+-- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com>+-- License     :  BSD+--+-- Maintainer  :  Brandon S Allbery KF8NH+-- Stability   :  unstable+-- Portability :  unportable+--+-- A more flexible and general compositing interface than FadeInactive.+-- Windows can be selected and opacity specified by means of FadeHooks,+-- which are very similar to ManageHooks and use the same machinery.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.FadeWindows (-- * Usage+                                 -- $usage++                                 -- * The 'logHook' for window fading+                                 fadeWindowsLogHook++                                 -- * The 'FadeHook'+                                ,FadeHook+                                ,Opacity+                                ,idFadeHook++                                 -- * Predefined 'FadeHook's+                                ,opaque+                                ,solid+                                ,transparent+                                ,invisible+                                ,transparency+                                ,translucence+                                ,fadeBy+                                ,opacity+                                ,fadeTo++                                -- * 'handleEventHook' for mapped/unmapped windows+                                ,fadeWindowsEventHook++                                -- * 'doF' for simple hooks+                                ,doS++                                -- * Useful 'Query's for 'FadeHook's+                                ,isFloating+                                ,isUnfocused+                                ) where++import           XMonad.Core+import           XMonad.ManageHook                       (liftX)+import qualified XMonad.StackSet             as W++import           XMonad.Hooks.FadeInactive               (setOpacity+                                                         ,isUnfocused+                                                         )++import           Control.Monad                           (forM_)+import           Control.Monad.Reader                    (ask+                                                         ,asks)+import           Control.Monad.State                     (gets)+import qualified Data.Map                    as M+import           Data.Monoid++import           Graphics.X11.Xlib.Extras                (Event(..))++-- $usage+-- To use this module, make sure your @xmonad@ core supports generalized+-- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then+-- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your+-- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook':+--+-- >     , logHook = fadeWindowsLogHook myFadeHook+-- >     , handleEventHook = fadeWindowsEventHook+-- >     {- ... -}+-- >+-- > myFadeHook = composeAll [isUnfocused --> transparency 0.2+-- >                         ,                opaque+-- >                         ]+--+-- The above is like FadeInactive with a fade value of 0.2.+--+-- FadeHooks do not accumulate; instead, they compose from right to+-- left like 'ManageHook's, so the above example @myFadeHook@ will+-- render unfocused windows at 4/5 opacity and the focused window+-- as opaque.  The 'opaque' hook above is optional, by the way, as any+-- unmatched window will be opaque by default.+--+-- This module is best used with "XMonad.Hooks.MoreManageHelpers", which+-- exports a number of Queries that can be used in either @ManageHook@+-- or @FadeHook@.+--+-- Note that you need a compositing manager such as @xcompmgr@,+-- @dcompmgr@, or @cairo-compmgr@ for window fading to work.  If you+-- aren't running a compositing manager, the opacity will be recorded+-- but won't take effect until a compositing manager is started.+--+-- For more detailed instructions on editing the 'logHook' see:+--+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"+--+-- For more detailed instructions on editing the 'handleEventHook',+-- see:+--+-- "XMonad.Doc.Extending#Editing_the_event_hook"+-- (which sadly doesnt exist at the time of writing...)+-- +-- /WARNING:/  This module is very good at triggering bugs in+-- compositing managers.  Symptoms range from windows not being+-- repainted until the compositing manager is restarted or the+-- window is unmapped and remapped, to the machine becoming sluggish+-- until the compositing manager is restarted (at which point a+-- popup/dialog will suddenly appear; apparently it's getting into+-- a tight loop trying to fade the popup in).  I find it useful to+-- have a key binding to restart the compositing manager; for example,+--+-- main = xmonad $ defaultConfig {+--                   {- ... -}+--                 }+--                 `additionalKeysP`+--                 [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")]+--                 {- ... -}+--                 ]+--+-- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.)++-- a window opacity to be carried in a Query.  OEmpty is sort of a hack+-- to make it obay the monoid laws+data Opacity = Opacity Rational | OEmpty++instance Monoid Opacity where+  mempty                  = OEmpty+  r      `mappend` OEmpty = r+  _      `mappend` r      = r++-- | A FadeHook is similar to a ManageHook, but records window opacity.+type FadeHook = Query Opacity++-- | Render a window fully opaque.+opaque :: FadeHook+opaque =  doS (Opacity 1)++-- | Render a window fully transparent.+transparent :: FadeHook+transparent =  doS (Opacity 0)++-- | Specify a window's transparency.+transparency :: Rational -- ^ The window's transparency as a fraction.+                         --   @transparency 1@ is the same as 'transparent',+                         --   whereas @transparency 0@ is the same as 'opaque'.+             -> FadeHook+transparency =  doS . Opacity . (1-) . clampRatio++-- | Specify a window's opacity; this is the inverse of 'transparency'.+opacity :: Rational -- ^ The opacity of a window as a fraction.+                    --   @opacity 1@ is the same as 'opaque',+                    --   whereas @opacity 0@ is the same as 'transparent'.+        -> FadeHook+opacity =  doS . Opacity . clampRatio++fadeTo, translucence, fadeBy :: Rational -> FadeHook+-- ^ An alias for 'transparency'.+fadeTo       = transparency+-- ^ An alias for 'transparency'.+translucence = transparency+-- ^ An alias for 'transparency'.+fadeBy       = opacity++invisible, solid :: FadeHook+-- ^ An alias for 'transparent'.+invisible    = transparent+-- ^ An alias for 'opaque'.+solid        = opaque++-- | Like 'doF', but usable with 'ManageHook'-like hooks that+-- aren't 'Query' wrapped around transforming functions ('Endo').+doS :: Monoid m => m -> Query m+doS =  return++-- | The identity 'FadeHook', which renders windows 'opaque'.+idFadeHook :: FadeHook+idFadeHook =  opaque++-- | A Query to determine if a window is floating.+isFloating :: Query Bool+isFloating =  ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset++-- boring windows can't be seen outside of a layout, so we watch messages with+-- a dummy LayoutModifier and stow them in a persistent bucket.  this is not+-- entirely reliable given that boringAuto still isn't observable; we just hope+-- those aren't visible and won;t be affected anyway+-- @@@ punted for now, will be a separate module.  it's still slimy, though++-- | A 'logHook' to fade windows under control of a 'FadeHook', which is+--   similar to but not identical to 'ManageHook'.+fadeWindowsLogHook   :: FadeHook -> X ()+fadeWindowsLogHook h =  withWindowSet $ \s -> do+  let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) +++                    concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)+  forM_ visibleWins $ \w -> do+    o <- userCodeDef (Opacity 1) (runQuery h w)+    setOpacity w $ case o of+                     OEmpty    -> 0.93+                     Opacity r -> r++-- | A 'handleEventHook' to handle fading and unfading of newly mapped+--   or unmapped windows; this avoids problems with layouts such as+--   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may+--   also be useful with "XMonad.Hooks.FadeInactive".+fadeWindowsEventHook                     :: Event -> X All+fadeWindowsEventHook (MapNotifyEvent {}) =+  -- we need to run the fadeWindowsLogHook.  only one way...+  asks config >>= logHook >> return (All True)+fadeWindowsEventHook _                   =  return (All True)++-- A utility to clamp opacity fractions to the range (0,1)+clampRatio   :: Rational         -> Rational+clampRatio r |  r >= 0 && r <= 1 =  r+             |  r < 0            =  0+             |  otherwise        =  1
XMonad/Hooks/FloatNext.hs view
@@ -1,10 +1,11 @@+{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.FloatNext--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>+-- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) ----- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>+-- Maintainer  :  orphaned -- Stability   :  unstable -- Portability :  unportable --@@ -35,40 +36,11 @@                               , willFloatAllNewPP                               , runLogHook ) where -import Prelude hiding (all)- import XMonad--import Control.Monad (join)-import Control.Applicative ((<$>))-import Control.Arrow (first, second)-import Control.Concurrent.MVar-import System.IO.Unsafe (unsafePerformIO)---{- Helper functions -}--modifyMVar2 :: MVar a -> (a -> a) -> IO ()-modifyMVar2 v f = modifyMVar_ v (return . f)--_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()-_set f b = io $ modifyMVar2 floatModeMVar (f $ const b)--_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()-_toggle f = io $ modifyMVar2 floatModeMVar (f not)--_get :: ((Bool, Bool) -> a) -> X a-_get f = io $ f <$> readMVar floatModeMVar--_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)-_pp f s st = _get f >>= \b -> if b then return $ Just $ st s else return Nothing---{- The current state is kept here -}--floatModeMVar :: MVar (Bool, Bool)-floatModeMVar = unsafePerformIO $ newMVar (False, False)+import XMonad.Hooks.ToggleHook +hookName :: String+hookName = "__float"  -- $usage -- This module provides actions (that can be set as keybindings)@@ -93,40 +65,34 @@ -- -- > , ((modm, xK_r), toggleFloatAllNew) - -- | This 'ManageHook' will selectively float windows as set -- by 'floatNext' and 'floatAllNew'. floatNextHook :: ManageHook-floatNextHook = do (next, all) <- io $ takeMVar floatModeMVar-                   io $ putMVar floatModeMVar (False, all)-                   if next || all then doFloat else idHook-+floatNextHook = toggleHook hookName doFloat  -- | @floatNext True@ arranges for the next spawned window to be -- sent to the floating layer, @floatNext False@ cancels it. floatNext :: Bool -> X ()-floatNext = _set first+floatNext = hookNext hookName  toggleFloatNext :: X ()-toggleFloatNext = _toggle first+toggleFloatNext = toggleHookNext hookName  -- | @floatAllNew True@ arranges for new windows to be -- sent to the floating layer, @floatAllNew False@ cancels it floatAllNew :: Bool -> X ()-floatAllNew = _set second+floatAllNew = hookAllNew hookName  toggleFloatAllNew :: X ()-toggleFloatAllNew = _toggle second-+toggleFloatAllNew = toggleHookAllNew hookName  -- | Whether the next window will be set floating willFloatNext :: X Bool-willFloatNext = _get fst+willFloatNext = willHookNext hookName  -- | Whether new windows will be set floating willFloatAllNew :: X Bool-willFloatAllNew = _get snd-+willFloatAllNew = willHookAllNew hookName  -- $pp -- The following functions are used to display the current@@ -148,10 +114,7 @@ -- pass them 'id'.  willFloatNextPP :: (String -> String) -> X (Maybe String)-willFloatNextPP = _pp fst "Next"+willFloatNextPP = willHookNextPP hookName  willFloatAllNewPP :: (String -> String) -> X (Maybe String)-willFloatAllNewPP = _pp snd "All"--runLogHook :: X ()-runLogHook = join $ asks $ logHook . config+willFloatAllNewPP = willHookAllNewPP hookName
+ XMonad/Hooks/ICCCMFocus.hs view
@@ -0,0 +1,57 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.ICCCMFocus+-- License      : BSD+--+-- Maintainer   : Tony Morris <haskell@tmorris.net>+--+-- Implemented in your @logHook@, Java swing applications will not misbehave+-- when it comes to taking and losing focus.+--+-- This has been done by taking the patch in <http://code.google.com/p/xmonad/issues/detail?id=177> and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@.+--+-- @+--    conf' =+--      conf {+--        logHook = takeTopFocus+--      }+-- @+-----------------------------------------------------------------------------+module XMonad.Hooks.ICCCMFocus+(+  atom_WM_TAKE_FOCUS  +, takeFocusX+, takeTopFocus+) where++import XMonad+import XMonad.Hooks.SetWMName+import qualified XMonad.StackSet as W+import Control.Monad++atom_WM_TAKE_FOCUS ::+  X Atom+atom_WM_TAKE_FOCUS =+  getAtom "WM_TAKE_FOCUS"++takeFocusX ::+  Window+  -> X ()+takeFocusX w =+  withWindowSet . const $ do+    dpy       <- asks display+    wmtakef   <- atom_WM_TAKE_FOCUS+    wmprot    <- atom_WM_PROTOCOLS+    protocols <- io $ getWMProtocols dpy w+    when (wmtakef `elem` protocols) $+      io . allocaXEvent $ \ev -> do+          setEventType ev clientMessage+          setClientMessageEvent ev w wmprot 32 wmtakef currentTime+          sendEvent dpy w False noEventMask ev++-- | The value to add to your log hook configuration.+takeTopFocus ::+  X ()+takeTopFocus =+  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"  +
XMonad/Hooks/InsertPosition.hs view
@@ -46,7 +46,7 @@ insertPosition :: Position -> Focus -> ManageHook insertPosition pos foc = Endo . g <$> ask   where-    g w = viewingWs w (updateFocus w . ins w . W.delete w)+    g w = viewingWs w (updateFocus w . ins w . W.delete' w)     ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $         case pos of             Master -> W.insertUp w . W.focusMaster
XMonad/Hooks/ManageDocks.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-} -- deriving Typeable for ghc-6.6 compatibility, which is retained in the core ----------------------------------------------------------------------------- -- |@@ -18,10 +17,17 @@     -- * Usage     -- $usage     manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,+    docksEventHook,     ToggleStruts(..),     SetStruts(..),     module XMonad.Util.Types, +#ifdef TESTING+    r2c,+    c2r,+    RectC(..),+#endif+     -- for XMonad.Actions.FloatSnap     calcGap     ) where@@ -30,10 +36,11 @@ ----------------------------------------------------------------------------- import XMonad import Foreign.C.Types (CLong)-import Control.Monad import XMonad.Layout.LayoutModifier import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s)+import XMonad.Util.XUtils (fi)+import Data.Monoid (All(..))  import qualified Data.Set as S @@ -56,6 +63,11 @@ -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) -- >                   where  tall = Tall 1 (3/100) (1/2) --+-- The third component is an event hook that causes new docks to appear+-- immediately, instead of waiting for the next focus change.+--+-- > handleEventHook = ... <+> docksEventHook+-- -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding -- similar to: --@@ -102,6 +114,14 @@         Just [r] -> return $ elem (fromIntegral r) [dock, desk]         _        -> return False +-- | Whenever a new dock appears, refresh the layout immediately to avoid the+-- new dock.+docksEventHook :: Event -> X All+docksEventHook (MapNotifyEvent {ev_window = w}) = do+    whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh+    return (All True)+docksEventHook _ = return (All True)+ -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut] getStrut w = do@@ -210,41 +230,34 @@ -- | (Initial x pixel, initial y pixel, --    final x pixel, final y pixel). -type RectC = (CLong, CLong, CLong, CLong)--fi :: (Integral a, Num b) => a -> b-fi = fromIntegral+newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show)  -- | Invertible conversion.  r2c :: Rectangle -> RectC-r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)+r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)  -- | Invertible conversion.  c2r :: RectC -> Rectangle-c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)+c2r (RectC (x1, y1, x2, y2)) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1) --- TODO: Add these QuickCheck properties to the test suite, along with--- suitable Arbitrary instances. --- prop_r2c_c2r :: RectC -> Bool--- prop_r2c_c2r r = r2c (c2r r) == r---- prop_c2r_r2c :: Rectangle -> Bool--- prop_c2r_r2c r = c2r (r2c r) == r- reduce :: RectC -> Strut -> RectC -> RectC-reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of-    L | p (y0, y1) -> (mx x0 sx0    , y0       , x1       , y1       )-    R | p (y0, y1) -> (x0           , y0       , mn x1 sx1, y1       )-    U | p (x0, x1) -> (x0           , mx y0 sy0, x1       , y1       )-    D | p (x0, x1) -> (x0           , y0       , x1       , mn y1 sy1)-    _              -> (x0           , y0       , x1       , y1       )+reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) =+ RectC $ case s of+    L | p (y0, y1) && qh x1     -> (mx x0 sx0, y0       , x1       , y1       )+    R | p (y0, y1) && qv sx1 x0 -> (x0       , y0       , mn x1 sx1, y1       )+    U | p (x0, x1) && qh y1     -> (x0       , mx y0 sy0, x1       , y1       )+    D | p (x0, x1) && qv sy1 y0 -> (x0       , y0       , x1       , mn y1 sy1)+    _                           -> (x0       , y0       , x1       , y1       )  where     mx a b = max a (b + n)     mn a b = min a (b - n)     p r = r `overlaps` (l, h)+    -- Filter out struts that cover the entire rectangle:+    qh d1 = n <= d1+    qv sd1 d0 = sd1 - n >= d0  -- | Do the two ranges overlap? --
XMonad/Hooks/ManageHelpers.hs view
@@ -28,6 +28,7 @@     Side(..),     composeOne,     (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),+    currentWs,     isInProperty,     isKDETrayWindow,     isFullscreen,@@ -44,7 +45,8 @@     doSideFloat,     doFloatAt,     doFloatDep,-    doHideIgnore+    doHideIgnore,+    Match, ) where  import XMonad@@ -117,6 +119,10 @@ p -?>> f = do     Match b m <- p     if b then fmap  Just (f m) else return Nothing++-- | Return the current workspace+currentWs :: Query WorkspaceId+currentWs = liftX (withWindowSet $ return . W.currentTag)  -- | A predicate to check whether a window is a KDE system tray icon. isKDETrayWindow :: Query Bool
+ XMonad/Hooks/Minimize.hs view
@@ -0,0 +1,53 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.Minimize+-- Copyright   :  (c) Justin Bogner 2010+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Justin Bogner <mail@justinbogner.com>+-- Stability   :  unstable+-- Portability :  not portable+--+-- Handles window manager hints to minimize and restore windows. Use+-- this with XMonad.Layout.Minimize.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.Minimize+    ( -- * Usage+      -- $usage+      minimizeEventHook+    ) where++import Data.Monoid+import Control.Monad(when)++import XMonad+import XMonad.Layout.Minimize++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.Minimize+-- > import XMonad.Layout.Minimize+-- >+-- > myHandleEventHook = minimizeEventHook+-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayout+-- >                             , handleEventHook = myHandleEventHook }++minimizeEventHook :: Event -> X All+minimizeEventHook (ClientMessageEvent {ev_window = w,+                                       ev_message_type = mt,+                                       ev_data = dt}) = do+    a_aw <- getAtom "_NET_ACTIVE_WINDOW"+    a_cs <- getAtom "WM_CHANGE_STATE"++    when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)+    when (mt == a_cs) $ do+      let message = fromIntegral . head $ dt+      when (message == normalState) $ sendMessage (RestoreMinimizedWin w)+      when (message == iconicState) $ minimizeWindow w++    return (All True)+minimizeEventHook _ = return (All True)
XMonad/Hooks/Place.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Hooks.Place--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>+-- Copyright   :  Quentin Moser <moserq@gmail.com> -- License     :  BSD-style (see LICENSE) ----- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>+-- Maintainer  :  orphaned -- Stability   :  unstable -- Portability :  unportable --@@ -38,11 +38,12 @@  import XMonad.Layout.WindowArranger import XMonad.Actions.FloatKeys+import XMonad.Util.XUtils  import qualified Data.Map as M import Data.Ratio ((%)) import Data.List (sortBy, minimumBy, partition)-import Data.Maybe (maybe, fromMaybe, catMaybes)+import Data.Maybe (fromMaybe, catMaybes) import Data.Monoid (Endo(..)) import Control.Monad (guard, join) import Control.Monad.Trans (lift)@@ -262,8 +263,6 @@ scale :: (RealFrac a, Integral b) => a -> b -> b -> b scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1 -fi :: (Integral a, Num b) => a -> b-fi = fromIntegral  r2rr :: Rectangle -> Rectangle -> S.RationalRect r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h)
+ XMonad/Hooks/PositionStoreHooks.hs view
@@ -0,0 +1,106 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.PositionStoreHooks+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- This module contains two hooks for the+-- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and+-- an EventHook.+--+-- The ManageHook can be used to fill the PositionStore with position and size+-- information about new windows. The advantage of using this hook is, that the+-- information is recorded independent of the currently active layout. So the+-- floating shape of the window can later be restored even if it was opened in a+-- tiled layout initially.+--+-- For windows, that do not request a particular position, a random position will+-- be assigned. This prevents windows from piling up exactly on top of each other.+--+-- The EventHook makes sure that windows are deleted from the PositionStore+-- when they are closed.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.PositionStoreHooks (+    -- * Usage+    -- $usage+    positionStoreManageHook,+    positionStoreEventHook+    ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Util.PositionStore+import XMonad.Hooks.ManageDocks+import XMonad.Layout.Decoration++import System.Random(randomRIO)+import Control.Applicative((<$>))+import Control.Monad(when)+import Data.Maybe+import Data.Monoid+import qualified Data.Set as S++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.PositionStoreHooks+--+-- and adding 'positionStoreManageHook' to your 'ManageHook' as well+-- as 'positionStoreEventHook' to your event hooks. To be accurate+-- about window sizes, the module needs to know if any decoration is in effect.+-- This is specified with the first argument: Supply 'Nothing' for no decoration,+-- otherwise use 'Just defaultTheme' or similar to inform the module about the+-- decoration theme used.+--+-- > myManageHook = positionStoreManageHook Nothing <+> manageHook defaultConfig+-- > myHandleEventHook = positionStoreEventHook+-- >+-- > main = xmonad defaultConfig { manageHook = myManageHook+-- >                             , handleEventHook = myHandleEventHook+-- >                             }+--++positionStoreManageHook :: Maybe Theme -> ManageHook+positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook++positionStoreInit :: Maybe Theme -> Window -> X ()+positionStoreInit mDecoTheme w  = withDisplay $ \d -> do+        let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current+                                                    -- form - makes windows smaller to make room for it+        wa <- io $ getWindowAttributes d w+        ws <- gets windowset+        arbitraryOffsetX <- randomIntOffset+        arbitraryOffsetY <- randomIntOffset+        if (wa_x wa == 0) && (wa_y wa == 0)+            then do+                let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws+                modifyPosStore (\ps -> posStoreInsert ps w+                                        (Rectangle (srX + fi arbitraryOffsetX)+                                                   (srY + fi arbitraryOffsetY)+                                                    (fi $ wa_width wa)+                                                    (decoH + fi (wa_height wa))) sr )+            else do+                sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)+                let sr = screenRect . W.screenDetail $ sc+                sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound])    -- take docks into account, accepting+                                                                                    -- a somewhat unfortunate inter-dependency+                                                                                    -- with 'XMonad.Hooks.ManageDocks'+                modifyPosStore (\ps -> posStoreInsert ps w+                                        (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)+                                            (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )+    where+        randomIntOffset :: X (Int)+        randomIntOffset = io $ randomRIO (42, 242)++positionStoreEventHook :: Event -> X All+positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do+    when (et == destroyNotify) $ do+        modifyPosStore (\ps -> posStoreRemove ps w)+    return (All True)+positionStoreEventHook _ = return (All True)
XMonad/Hooks/RestoreMinimized.hs view
@@ -8,9 +8,9 @@ -- Stability   :  unstable -- Portability :  not portable ----- Lets you restore minimized windows (see "XMonad.Layout.Minimize")--- by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW--- and WM_CHANGE_STATE).+-- (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized+-- windows (see "XMonad.Layout.Minimize") by selecting them on a+-- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE). -- -----------------------------------------------------------------------------
+ XMonad/Hooks/ScreenCorners.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.ScreenCorners+-- Copyright   :  (c) 2009 Nils Schweinsberg+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Run @X ()@ actions by touching the edge of your screen with your mouse.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.ScreenCorners+    (+    -- * Usage+    -- $usage++    -- * Adding screen corners+      ScreenCorner (..)+    , addScreenCorner+    , addScreenCorners++    -- * Event hook+    , screenCornerEventHook+    ) where++import Data.Monoid+import Data.List (find)+import XMonad+import XMonad.Util.XUtils (fi)++import qualified Data.Map as M+import qualified XMonad.Util.ExtensibleState as XS++data ScreenCorner = SCUpperLeft+                  | SCUpperRight+                  | SCLowerLeft+                  | SCLowerRight+                  deriving (Eq, Ord, Show)++++--------------------------------------------------------------------------------+-- ExtensibleState modifications+--------------------------------------------------------------------------------++newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))+    deriving Typeable++instance ExtensionClass ScreenCornerState where+    initialValue = ScreenCornerState M.empty++-- | Add one single @X ()@ action to a screen corner+addScreenCorner :: ScreenCorner -> X () -> X ()+addScreenCorner corner xF = do++    ScreenCornerState m <- XS.get+    (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of++                        Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions+                        Nothing           -> flip (,) xF `fmap` createWindowAt corner++    XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'++-- | Add a list of @(ScreenCorner, X ())@ tuples+addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()+addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)+++--------------------------------------------------------------------------------+-- Xlib functions+--------------------------------------------------------------------------------++-- "Translate" a ScreenCorner to real (x,y) Positions+createWindowAt :: ScreenCorner -> X Window+createWindowAt SCUpperLeft = createWindowAt' 0 0+createWindowAt SCUpperRight = withDisplay $ \dpy ->+    let w = displayWidth  dpy (defaultScreen dpy) - 1+    in createWindowAt' (fi w) 0++createWindowAt SCLowerLeft = withDisplay $ \dpy ->+    let h = displayHeight dpy (defaultScreen dpy) - 1+    in createWindowAt' 0 (fi h)++createWindowAt SCLowerRight = withDisplay $ \dpy ->+    let w = displayWidth  dpy (defaultScreen dpy) - 1+        h = displayHeight dpy (defaultScreen dpy) - 1+    in createWindowAt' (fi w) (fi h)++-- Create a new X window at a (x,y) Position+createWindowAt' :: Position -> Position -> X Window+createWindowAt' x y = withDisplay $ \dpy -> io $ do++    rootw <- rootWindow dpy (defaultScreen dpy)++    let+        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy+        attrmask = cWOverrideRedirect++    w <- allocaSetWindowAttributes $ \attributes -> do++        set_override_redirect attributes True+        createWindow dpy        -- display+                     rootw      -- parent window+                     x          -- x+                     y          -- y+                     1          -- width+                     1          -- height+                     0          -- border width+                     0          -- depth+                     inputOnly  -- class+                     visual     -- visual+                     attrmask   -- valuemask+                     attributes -- attributes++    -- we only need mouse entry events+    selectInput dpy w enterWindowMask+    mapWindow dpy w+    sync dpy False+    return w+++--------------------------------------------------------------------------------+-- Event hook+--------------------------------------------------------------------------------++-- | Handle screen corner events+screenCornerEventHook :: Event -> X All+screenCornerEventHook CrossingEvent { ev_window = win } = do++    ScreenCornerState m <- XS.get++    case M.lookup win m of+         Just (_, xF) -> xF+         Nothing      -> return ()++    return (All True)++screenCornerEventHook _ = return (All True)+++--------------------------------------------------------------------------------+-- $usage+--+-- This extension adds KDE-like screen corners to XMonad. By moving your cursor+-- into one of your screen corners you can trigger an @X ()@ action, for+-- example @"XMonad.Actions.GridSelect".goToSelected@ or+-- @"XMonad.Actions.CycleWS".nextWS@ etc.+--+-- To use it, import it on top of your @xmonad.hs@:+--+-- > import XMonad.Hooks.ScreenCorners+--+-- Then add your screen corners in our startup hook:+--+-- > myStartupHook = do+-- >     ...+-- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})+-- >     addScreenCorners [ (SCLowerRight, nextWS)+-- >                      , (SCLowerLeft,  prevWS)+-- >                      ]+--+-- And finally wait for screen corner events in your event hook:+--+-- > myEventHook e = do+-- >     ...+-- >     screenCornerEventHook e
XMonad/Hooks/Script.hs view
@@ -26,7 +26,6 @@ -- import XMonad -import Control.Monad.Trans import System.Directory  -- $usage
XMonad/Hooks/ServerMode.hs view
@@ -64,7 +64,6 @@     ) where  import Control.Monad (when)-import Data.List import Data.Monoid import System.IO
+ XMonad/Hooks/ToggleHook.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.ToggleHook+-- Copyright   :  Ben Boeckel <mathstuf@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Ben Boeckel <mathstuf@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Hook and keybindings for toggling hook behavior.+-----------------------------------------------------------------------------++module XMonad.Hooks.ToggleHook ( -- * Usage+                                 -- $usage++                                 -- * The hook+                                 toggleHook+                               , toggleHook'++                                 -- * Actions+                               , hookNext+                               , toggleHookNext+                               , hookAllNew+                               , toggleHookAllNew++                                 -- * Queries+                               , willHook+                               , willHookNext+                               , willHookAllNew++                                 -- * 'DynamicLog' utilities+                                 -- $pp+                               , willHookNextPP+                               , willHookAllNewPP+                               , runLogHook ) where++import Prelude hiding (all)++import XMonad+import qualified XMonad.Util.ExtensibleState as XS++import Control.Monad (join,guard)+import Control.Applicative ((<$>))+import Control.Arrow (first, second)++import Data.Map++{- Helper functions -}++_set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()+_set n f b = modify' n (f $ const b)++_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()+_toggle n f = modify' n (f not)++_get :: String -> ((Bool, Bool) -> a) -> X a+_get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks)++_pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)+_pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f++{- The current state is kept here -}++data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable)++instance ExtensionClass HookState where+    initialValue = HookState empty++modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()+modify' n f = XS.modify (HookState . setter . hooks)+    where+        setter m = insert n (f (findWithDefault (False, False) n m)) m++-- $usage+-- This module provides actions (that can be set as keybindings)+-- to be able to cause hooks to be occur on a conditional basis.+--+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.ToggleHook+--+-- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the+-- name of the hook and @hook@ is the hook to execute based on the state.+--+-- > myManageHook = toggleHook "float" doFloat <+> manageHook defaultConfig+--+-- Additionally, toggleHook' is provided to toggle between two hooks (rather+-- than on/off).+--+-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook defaultConfig+--+-- The 'hookNext' and 'toggleHookNext' functions can be used in key+-- bindings to set whether the hook is applied or not.+--+-- > , ((modm, xK_e), toggleHookNext "float")+--+-- 'hookAllNew' and 'toggleHookAllNew' are similar but float all+-- spawned windows until disabled again.+--+-- > , ((modm, xK_r), toggleHookAllNew "float")++-- | This 'ManageHook' will selectively apply a hook as set+-- by 'hookNext' and 'hookAllNew'.+toggleHook :: String -> ManageHook -> ManageHook+toggleHook n h = toggleHook' n h idHook++toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook+toggleHook' n th fh = do m <- liftX $ XS.gets hooks+                         (next, all) <- return $ findWithDefault (False, False) n m+                         liftX $ XS.put $ HookState $ insert n (False, all) m+                         if next || all then th else fh++-- | @hookNext name True@ arranges for the next spawned window to+-- have the hook @name@ applied, @hookNext name False@ cancels it.+hookNext :: String -> Bool -> X ()+hookNext n = _set n first++toggleHookNext :: String -> X ()+toggleHookNext n = _toggle n first++-- | @hookAllNew name True@ arranges for new windows to+-- have the hook @name@ applied, @hookAllNew name False@ cancels it+hookAllNew :: String -> Bool -> X ()+hookAllNew n = _set n second++toggleHookAllNew :: String -> X ()+toggleHookAllNew n = _toggle n second++-- | Query what will happen at the next ManageHook call for the hook @name@.+willHook :: String -> X Bool+willHook n = willHookNext n <||> willHookAllNew n++-- | Whether the next window will trigger the hook @name@.+willHookNext :: String -> X Bool+willHookNext n = _get n fst++-- | Whether new windows will trigger the hook @name@.+willHookAllNew :: String -> X Bool+willHookAllNew n = _get n snd++-- $pp+-- The following functions are used to display the current+-- state of 'hookNext' and 'hookAllNew' in your+-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.+-- 'willHookNextPP' and 'willHookAllNewPP' should be added+-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your+-- 'XMonad.Hooks.DynamicLog.PP'.+--+-- Use 'runLogHook' to refresh the output of your 'logHook', so+-- that the effects of a 'hookNext'/... will be visible+-- immediately:+--+-- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook)+--+-- The @String -> String@ parameters to 'willHookNextPP' and+-- 'willHookAllNewPP' will be applied to their output, you+-- can use them to set the text color, etc., or you can just+-- pass them 'id'.++willHookNextPP :: String -> (String -> String) -> X (Maybe String)+willHookNextPP n = _pp n fst "Next"++willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)+willHookAllNewPP n = _pp n snd "All"++runLogHook :: X ()+runLogHook = join $ asks $ logHook . config
XMonad/Hooks/UrgencyHook.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,+  FlexibleInstances #-}  ----------------------------------------------------------------------------- -- |@@ -64,24 +65,24 @@                                  readUrgents, withUrgents,                                  StdoutUrgencyHook(..),                                  SpawnUrgencyHook(..),-                                 UrgencyHook(urgencyHook)+                                 UrgencyHook(urgencyHook),+                                 Interval,                                  ) where  import XMonad import qualified XMonad.StackSet as W  import XMonad.Util.Dzen (dzenWithArgs, seconds)+import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.NamedWindows (getName) import XMonad.Util.Timer (TimerId, startTimer, handleTimer)  import Control.Applicative ((<$>)) import Control.Monad (when) import Data.Bits (testBit)-import Data.IORef-import Data.List (delete)+import Data.List (delete, (\\)) import Data.Maybe (listToMaybe, maybeToList) import qualified Data.Set as S-import Foreign (unsafePerformIO)  -- $usage --@@ -195,7 +196,7 @@ -- hopefully you know where to find it.  -- | This is the method to enable an urgency hook. It uses the default--- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'+-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHookC' -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>                    h -> XConfig l -> XConfig l@@ -213,6 +214,15 @@         logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf     } +data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)++onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents+onUrgents f = Urgents . f . fromUrgents++instance ExtensionClass Urgents where+    initialValue = Urgents []+    extensionType = PersistentExtension+ -- | Global configuration, applied to all types of 'UrgencyHook'. See -- 'urgencyConfig' for the defaults. data UrgencyConfig = UrgencyConfig@@ -262,25 +272,18 @@ clearUrgents :: X () clearUrgents = adjustUrgents (const []) >> adjustReminders (const []) --- | Stores the global set of all urgent windows, across workspaces. Not exported -- use--- 'readUrgents' or 'withUrgents' instead.-{-# NOINLINE urgents #-}-urgents :: IORef [Window]-urgents = unsafePerformIO (newIORef [])--- (Hey, I don't like it any more than you do.)- -- | X action that returns a list of currently urgent windows. You might use -- it, or 'withUrgents', in your custom logHook, to display the workspaces that -- contain urgent windows. readUrgents :: X [Window]-readUrgents = io $ readIORef urgents+readUrgents = XS.gets fromUrgents  -- | An HOF version of 'readUrgents', for those who prefer that sort of thing. withUrgents :: ([Window] -> X a) -> X a withUrgents f = readUrgents >>= f  adjustUrgents :: ([Window] -> [Window]) -> X ()-adjustUrgents f = io $ modifyIORef urgents f+adjustUrgents = XS.modify . onUrgents  type Interval = Rational @@ -290,18 +293,19 @@                          , window    :: Window                          , interval  :: Interval                          , remaining :: Maybe Int-                         } deriving Eq+                         } deriving (Show,Read,Eq,Typeable) +instance ExtensionClass [Reminder] where+    initialValue = []+    extensionType = PersistentExtension+ -- | Stores the list of urgency reminders.-{-# NOINLINE reminders #-}-reminders :: IORef [Reminder]-reminders = unsafePerformIO (newIORef [])  readReminders :: X [Reminder]-readReminders = io $ readIORef reminders+readReminders = XS.get  adjustReminders :: ([Reminder] -> [Reminder]) -> X ()-adjustReminders f = io $ modifyIORef reminders f+adjustReminders = XS.modify  clearUrgency :: Window -> X () clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)@@ -332,7 +336,7 @@                   callUrgencyHook wuh w                 else                   clearUrgency w-              userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified+              userCodeDef () =<< asks (logHook . config)       DestroyWindowEvent {ev_window = w} ->           clearUrgency w       _ ->@@ -369,7 +373,9 @@ shouldSuppress sw w = elem w <$> suppressibleWindows sw  cleanupUrgents :: SuppressWhen -> X ()-cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw+cleanupUrgents sw = do+    sw' <- suppressibleWindows sw+    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))  suppressibleWindows :: SuppressWhen -> X [Window] suppressibleWindows Visible  = gets $ S.toList . mapped
XMonad/Hooks/XPropManage.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module       : XMonad.Hooks.XPropManage@@ -17,14 +18,14 @@                  xPropManageHook, XPropMatch, pmX, pmP                  ) where +import Prelude hiding (catch)+import Control.Exception import Data.Char (chr)-import Data.List (concat) import Data.Monoid (mconcat, Endo(..))  import Control.Monad.Trans (lift)  import XMonad-import XMonad.ManageHook ((-->))  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -75,7 +76,7 @@  getProp :: Display -> Window -> Atom -> X ([String]) getProp d w p = do-    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])+    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])     let filt q | q == wM_COMMAND = concat . map splitAtNull                | otherwise       = id     return (filt p prop)
XMonad/Layout/Accordion.hs view
@@ -42,7 +42,7 @@ instance LayoutClass Accordion Window where     pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms      where-       ups    = W.up ws+       ups    = reverse $ W.up ws        dns    = W.down ws        (top,  allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc        (center,  bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop
XMonad/Layout/AutoMaster.hs view
@@ -18,7 +18,7 @@ module XMonad.Layout.AutoMaster (                              -- * Usage                              -- $usage-                             autoMaster+                             autoMaster, AutoMaster                             ) where import Control.Monad @@ -48,7 +48,7 @@ data AutoMaster a = AutoMaster Int Float Float     deriving (Read,Show) -instance LayoutModifier AutoMaster Window where+instance (Eq w) => LayoutModifier AutoMaster w where     modifyLayout (AutoMaster k bias _) = autoLayout k bias     pureMess = autoMess @@ -61,12 +61,12 @@           resize Shrink = AutoMaster k (max (-0.4)  $ bias-delta) delta  -- | Main layout function-autoLayout :: (LayoutClass l Window) =>+autoLayout :: (Eq w, LayoutClass l w) =>               Int ->               Float ->-              W.Workspace WorkspaceId (l Window) Window+              W.Workspace WorkspaceId (l w) w               -> Rectangle-              -> X ([(Window, Rectangle)], Maybe (l Window))+              -> X ([(w, Rectangle)], Maybe (l w)) autoLayout k bias wksp rect = do     let stack = W.stack wksp     let ws = W.integrate' stack
XMonad/Layout/BorderResize.hs view
@@ -12,8 +12,10 @@ -- This layout modifier will allow to resize windows by dragging their -- borders with the mouse. However, it only works in layouts or modified -- layouts that react to the 'SetGeometry' message.--- "XMonad.Layout.WindowArranger" can be used to create such a setup.--- BorderResize is probably most useful in floating layouts.+-- "XMonad.Layout.WindowArranger" can be used to create such a setup,+-- but it is probably must useful in a floating layout such as+-- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested.+-- See the documentation of PositionStoreFloat for a typical usage example. -- ----------------------------------------------------------------------------- @@ -22,15 +24,15 @@       -- $usage       borderResize     , BorderResize (..)+    , RectWithBorders, BorderInfo,     ) where  import XMonad import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils-import Control.Monad(when,forM)-import Control.Arrow(first)-import Control.Applicative((<$>))+import Control.Monad(when)+import qualified Data.Map as M  -- $usage -- You can use this module with the following in your@@ -41,89 +43,141 @@ -- > main = xmonad defaultConfig { layoutHook = myLayout } -- -data BorderInfo = RightSideBorder Window Rectangle-                    | LeftSideBorder Window Rectangle-                    | TopSideBorder Window Rectangle-                    | BottomSideBorder Window Rectangle+type BorderBlueprint = (Rectangle, Glyph, BorderType)++data BorderType = RightSideBorder+                    | LeftSideBorder+                    | TopSideBorder+                    | BottomSideBorder                     deriving (Show, Read, Eq)-type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo)-type BorderWithWin = (Window, BorderInfo)+data BorderInfo = BI { bWin :: Window,+                        bRect :: Rectangle,+                        bType :: BorderType+                     } deriving (Show, Read) -data BorderResize a = BR [BorderWithWin] deriving (Show, Read)+type RectWithBorders = (Rectangle, [BorderInfo]) +data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)+ brBorderOffset :: Position brBorderOffset = 5 brBorderSize :: Dimension brBorderSize = 10 -brCursorRightSide :: Glyph-brCursorRightSide = 96-brCursorLeftSide :: Glyph-brCursorLeftSide = 70-brCursorTopSide :: Glyph-brCursorTopSide = 138-brCursorBottomSide :: Glyph-brCursorBottomSide = 16- borderResize :: l a -> ModifiedLayout BorderResize l a-borderResize = ModifiedLayout (BR [])+borderResize = ModifiedLayout (BR M.empty)  instance LayoutModifier BorderResize Window where     redoLayout _       _ Nothing  wrs = return (wrs, Nothing)-    redoLayout (BR borders) _ _ wrs = do-        let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr)-        mapM_ deleteBorder borders-        newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) ->-                        first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4]-        let wrs' = concat $ map fst newBorders-            newBordersSerialized = concat $ map snd newBorders-        return (wrs', Just $ BR newBordersSerialized)+    redoLayout (BR wrsLastTime) _ _ wrs = do+            let correctOrder = map fst wrs+                wrsCurrent = M.fromList wrs+                wrsGone = M.difference wrsLastTime wrsCurrent+                wrsAppeared = M.difference wrsCurrent wrsLastTime+                wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent+            handleGone wrsGone+            wrsCreated <- handleAppeared wrsAppeared+            let wrsChanged = handleStillThere wrsStillThere+                wrsThisTime = M.union wrsChanged wrsCreated+            return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime)             -- What we return is the original wrs with the new border             -- windows inserted at the correct positions - this way, the core             -- will restack the borders correctly.             -- We also return information about our borders, so that we             -- can handle events that they receive and destroy them when             -- they are no longer needed.+        where+            testIfUnchanged entry@(rLastTime, _) rCurrent =+                if rLastTime == rCurrent+                    then (Nothing, entry)+                    else (Just rCurrent, entry) -    handleMess (BR borders) m-        | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing+    handleMess (BR wrsLastTime) m+        | Just e <- fromMessage m :: Maybe Event =+            handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing         | Just _ <- fromMessage m :: Maybe LayoutMessages =-            mapM_ deleteBorder borders >> return (Just $ BR [])+            handleGone wrsLastTime >> return (Just $ BR M.empty)     handleMess _ _ = return Nothing -prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect)-prepareBorders (w, r@(Rectangle x y wh ht)) =-    ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide     , RightSideBorder w r),-     (r, (Rectangle (x - brBorderOffset) y brBorderSize ht)         , brCursorLeftSide      , LeftSideBorder w r),-     (r, (Rectangle x (y - brBorderOffset) wh brBorderSize)         , brCursorTopSide       , TopSideBorder w r),-     (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide    , BottomSideBorder w r)-    )+compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]+compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder+                                      in concat $ map compileWr wrs -handleResize :: [BorderWithWin] -> Event -> X ()+compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)]+compileWr (w, (r, borderInfos)) =+    let borderWrs = for borderInfos $ \bi -> (bWin bi, bRect bi)+    in borderWrs ++ [(w, r)]++handleGone :: M.Map Window RectWithBorders -> X ()+handleGone wrsGone = mapM_ deleteWindow borderWins+    where+        borderWins = map bWin . concat . map snd . M.elems $ wrsGone++handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders)+handleAppeared wrsAppeared = do+    let wrs = M.toList wrsAppeared+    wrsCreated <- mapM handleSingleAppeared wrs+    return $ M.fromList wrsCreated++handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders)+handleSingleAppeared (w, r) = do+    let borderBlueprints = prepareBorders r+    borderInfos <- mapM createBorder borderBlueprints+    return (w, (r, borderInfos))++handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders+handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere++handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders+handleSingleStillThere (Nothing, entry) = entry+handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)+    where+        changedBorderBlueprints = prepareBorders rCurrent+        updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints+          -- assuming that the four borders are always in the same order++updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo+updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r }++createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))]+createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime+    where+        processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]+        processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r))++prepareBorders :: Rectangle -> [BorderBlueprint]+prepareBorders (Rectangle x y wh ht) =+    [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder),+     ((Rectangle (x - brBorderOffset) y brBorderSize ht)        , xC_left_side  , LeftSideBorder),+     ((Rectangle x (y - brBorderOffset) wh brBorderSize)        , xC_top_side   , TopSideBorder),+     ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder)+    ]++handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }     | et == buttonPress, Just edge <- lookup ew borders =     case edge of-        RightSideBorder hostWin (Rectangle hx hy _ hht) ->+        (RightSideBorder, hostWin, (Rectangle hx hy _ hht)) ->             mouseDrag (\x _ -> do                             let nwh = max 1 $ fi (x - hx)                                 rect = Rectangle hx hy nwh hht                             focus hostWin                             when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)-        LeftSideBorder hostWin (Rectangle hx hy hwh hht) ->+        (LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->             mouseDrag (\x _ -> do                             let nx = max 0 $ min (hx + fi hwh) $ x                                 nwh = max 1 $ hwh + fi (hx - x)                                 rect = Rectangle nx hy nwh hht                             focus hostWin                             when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin)-        TopSideBorder hostWin (Rectangle hx hy hwh hht) ->+        (TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->             mouseDrag (\_ y -> do                             let ny = max 0 $ min (hy + fi hht) $ y                                 nht = max 1 $ hht + fi (hy - y)                                 rect = Rectangle hx ny hwh nht                             focus hostWin                             when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin)-        BottomSideBorder hostWin (Rectangle hx hy hwh _) ->+        (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) ->             mouseDrag (\_ y -> do                             let nht = max 1 $ fi (y - hy)                                 rect = Rectangle hx hy hwh nht@@ -131,13 +185,10 @@                             when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) handleResize _ _ = return () -createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin))-createBorder (_, borderRect, borderCursor, borderInfo) = do+createBorder :: BorderBlueprint -> X (BorderInfo)+createBorder (borderRect, borderCursor, borderType) = do     borderWin <- createInputWindow borderCursor borderRect-    return ((borderWin, borderRect), (borderWin, borderInfo))--deleteBorder :: BorderWithWin -> X ()-deleteBorder (borderWin, _) = deleteWindow borderWin+    return BI { bWin = borderWin, bRect = borderRect, bType = borderType }  createInputWindow :: Glyph -> Rectangle -> X Window createInputWindow cursorGlyph r = withDisplay $ \d -> do@@ -162,3 +213,13 @@  for :: [a] -> (a -> b) -> [b] for = flip map++reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]+reorder wrs order =+    let ordered = concat $ map (pickElem wrs) order+        rest = filter (\(w, _) -> not (w `elem` order)) wrs+    in ordered ++ rest+    where+        pickElem list e = case (lookup e list) of+                                Just result -> [(e, result)]+                                Nothing -> []
XMonad/Layout/BoringWindows.hs view
@@ -6,7 +6,7 @@ -- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net> -- License     :  BSD3-style (see LICENSE) ----- Maintainer  :  none+-- Maintainer  :  Adam Vogt <vogt.adam@gmail.com> -- Stability   :  unstable -- Portability :  unportable --@@ -24,6 +24,10 @@                                    UpdateBoring(UpdateBoring),                                    BoringMessage(Replace,Merge),                                    BoringWindows()++                                   -- * Tips+                                   -- ** variant of 'Full'+                                   -- $simplest                                   ) where  import XMonad.Layout.LayoutModifier(ModifiedLayout(..),@@ -31,10 +35,8 @@ import XMonad(Typeable, LayoutClass, Message, X, fromMessage,               sendMessage, windows, withFocused, Window) import Control.Applicative((<$>))-import Control.Monad(Monad(return, (>>))) import Data.List((\\), union)-import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe,-                  maybeToList)+import Data.Maybe(fromMaybe, listToMaybe, maybeToList) import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -136,3 +138,12 @@ focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls++{- $simplest++An alternative to 'Full' is "XMonad.Layout.Simplest".  Less windows are+ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows+to be uninteresting by some other layout modifier (ex.+"XMonad.Layout.Minimize")++-}
+ XMonad/Layout/ButtonDecoration.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ButtonDecoration+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- A decoration that includes small buttons on both ends which invoke+-- various actions when clicked on: Show a window menu (see+-- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window.+--+-- Note: For maximizing and minimizing to actually work, you will need+-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your+-- setup.  See the documentation of those modules for more information.+--+-----------------------------------------------------------------------------++module XMonad.Layout.ButtonDecoration+    ( -- * Usage:+      -- $usage+      buttonDeco,+      ButtonDecoration,+    ) where++import XMonad+import XMonad.Layout.Decoration+import XMonad.Layout.DecorationAddons++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.DecorationAddons+-- > import XMonad.Layout.ButtonDecoration+--+-- Then edit your @layoutHook@ by adding the ButtonDecoration to+-- your layout:+--+-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--++buttonDeco :: (Eq a, Shrinker s) => s -> Theme+           -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a+buttonDeco s c = decoration s c $ NFD True++data ButtonDecoration a = NFD Bool deriving (Show, Read)++instance Eq a => DecorationStyle ButtonDecoration a where+    describeDeco _ = "ButtonDeco"+    decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR+    decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()
XMonad/Layout/CenteredMaster.hs view
@@ -21,7 +21,8 @@          -- $usage           centerMaster,-         topRightMaster+         topRightMaster,+         CenteredMaster, TopRightMaster,          ) where  import XMonad
XMonad/Layout/Column.hs view
@@ -61,9 +61,9 @@  mkRect :: Rectangle -> (Dimension,Position) -> Rectangle mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h-        + xn :: Int -> Rectangle -> Float -> Int -> Dimension-xn n (Rectangle _ _ _ h) q k = if q==1 then +xn n (Rectangle _ _ _ h) q k = if q==1 then                                   h `div` (fromIntegral n)                                else                                   round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n))
XMonad/Layout/ComboP.hs view
@@ -27,7 +27,7 @@ import Data.Maybe ( isJust ) import Control.Monad import XMonad hiding (focus)-import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )+import XMonad.StackSet ( Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation import XMonad.Util.WindowProperties import qualified XMonad.StackSet as W
XMonad/Layout/Decoration.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Decoration--- Copyright   :  (c) 2007 Andrea Rossato+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger -- License     :  BSD-style (see xmonad/LICENSE) -- -- Maintainer  :  andrea.rossato@unibz.it@@ -27,11 +27,13 @@     , isInStack, isVisible, isInvisible, isWithin, fi     , findWindowByDecoration     , module XMonad.Layout.LayoutModifier+    , DecorationState, OrigWin     ) where  import Control.Monad (when) import Data.Maybe import Data.List+import Foreign.C.Types(CInt)  import XMonad import qualified XMonad.StackSet as W@@ -42,6 +44,7 @@ import XMonad.Util.Invisible import XMonad.Util.XUtils import XMonad.Util.Font+import XMonad.Util.Image  -- $usage -- This module is intended for layout developers, who want to decorate@@ -65,18 +68,22 @@ -- -- For a collection of 'Theme's see "XMonad.Util.Themes" data Theme =-    Theme { activeColor         :: String    -- ^ Color of the active window-          , inactiveColor       :: String    -- ^ Color of the inactive window-          , urgentColor         :: String    -- ^ Color of the urgent window-          , activeBorderColor   :: String    -- ^ Color of the border of the active window-          , inactiveBorderColor :: String    -- ^ Color of the border of the inactive window-          , urgentBorderColor   :: String    -- ^ Color of the border of the urgent window-          , activeTextColor     :: String    -- ^ Color of the text of the active window-          , inactiveTextColor   :: String    -- ^ Color of the text of the inactive window-          , urgentTextColor     :: String    -- ^ Color of the text of the urgent window-          , fontName            :: String    -- ^ Font name-          , decoWidth           :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')-          , decoHeight          :: Dimension -- ^ Height of the decorations+    Theme { activeColor        :: String                   -- ^ Color of the active window+          , inactiveColor       :: String                   -- ^ Color of the inactive window+          , urgentColor         :: String                   -- ^ Color of the urgent window+          , activeBorderColor   :: String                   -- ^ Color of the border of the active window+          , inactiveBorderColor :: String                   -- ^ Color of the border of the inactive window+          , urgentBorderColor   :: String                   -- ^ Color of the border of the urgent window+          , activeTextColor     :: String                   -- ^ Color of the text of the active window+          , inactiveTextColor   :: String                   -- ^ Color of the text of the inactive window+          , urgentTextColor     :: String                   -- ^ Color of the text of the urgent window+          , fontName            :: String                   -- ^ Font name+          , decoWidth           :: Dimension                -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')+          , decoHeight          :: Dimension                -- ^ Height of the decorations+          , windowTitleAddons   :: [(String, Align)]       -- ^ Extra text to appear in a window's title bar.+                                                           --    Refer to for a use "XMonad.Layout.ImageButtonDecoration"+          , windowTitleIcons    :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.+                                                           --    Inner @[Bool]@ is a row in a icon bitmap.           } deriving (Show, Read)  -- | The default xmonad 'Theme'.@@ -94,6 +101,8 @@           , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"           , decoWidth           = 200           , decoHeight          = 20+          , windowTitleAddons   = []+          , windowTitleIcons    = []           }  -- | A 'Decoration' layout modifier will handle 'SetTheme', a message@@ -136,30 +145,36 @@     shrink :: ds a -> Rectangle -> Rectangle -> Rectangle     shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) -    -- | The decoration event hook, where the-    -- 'decorationMouseFocusHook' and 'decorationMouseDragHook' are-    -- called. If you reimplement it those methods will not be-    -- called.+    -- | The decoration event hook     decorationEventHook :: ds a -> DecorationState -> Event -> X ()-    decorationEventHook ds s e = do decorationMouseFocusHook  ds s e-                                    decorationMouseDragHook   ds s e+    decorationEventHook ds s e = handleMouseFocusDrag ds s e -    -- | This method is called when the user clicks the pointer over-    -- the decoration.-    decorationMouseFocusHook :: ds a -> DecorationState -> Event -> X ()-    decorationMouseFocusHook _ s e = handleMouseFocusDrag False s e+    -- | A hook that can be used to catch the cases when the user+    -- clicks on the decoration. If you return True here, the click event+    -- will be considered as dealt with and no further processing will take place.+    decorationCatchClicksHook :: ds a+                              -> Window+                              -> Int    -- ^ distance from the left where the click happened on the decoration+                              -> Int    -- ^ distance from the right where the click happened on the decoration+                              -> X Bool+    decorationCatchClicksHook _ _ _ _ = return False -    -- | This method is called when the user starts grabbing the-    -- decoration.-    decorationMouseDragHook :: ds a -> DecorationState -> Event -> X ()-    decorationMouseDragHook _ s e = handleMouseFocusDrag True s e+    -- | This hook is called while a window is dragged using the decoration.+    -- The hook can be overwritten if a different way of handling the dragging+    -- is required.+    decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y +    -- | This hoook is called after a window has been dragged using the decoration.+    decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()+    decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw+     -- | The pure version of the main method, 'decorate'.     pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle                    -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle-    pureDecoration _ _ ht _ s _ (w,Rectangle x y wh _) = if isInStack s w-                                                         then Just $ Rectangle x y wh ht-                                                         else Nothing+    pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht')+                                                             then Just $ Rectangle x y wh ht+                                                             else Nothing      -- | Given the theme's decoration width and height, the screen     -- rectangle, the windows stack, the list of windows and@@ -283,22 +298,30 @@  -- | Mouse focus and mouse drag are handled by the same function, this -- way we can start dragging unfocused windows too.-handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X ()-handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window     = ew-                                               , ev_event_type = et-                                               , ev_x_root     = ex-                                               , ev_y_root     = ey }+handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X ()+handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window     = ew+                                                , ev_event_type = et+                                                , ev_x_root     = ex+                                                , ev_y_root     = ey }     | et == buttonPress-    , Just ((mainw,r),_) <- lookFor ew dwrs = do-                              focus mainw-                              when b $ mouseDrag (\x y -> do-                                                    let rect = Rectangle (x - (fi ex - rect_x r))-                                                                         (y - (fi ey - rect_y r))-                                                                         (rect_width  r)-                                                                         (rect_height r)-                                                    sendMessage (SetGeometry rect)) (return ())+    , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do+        let Just (Rectangle dx _ dwh _) = decoRectM+            distFromLeft = ex - fi dx+            distFromRight = fi dwh - (ex - fi dx)+        dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)+        when (not dealtWith) $ do+            mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)+                        (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return () +handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+handleDraggingInProgress ex ey (_, r) x y = do+    let rect = Rectangle (x - (fi ex - rect_x r))+                         (y - (fi ey - rect_y r))+                         (rect_width  r)+                         (rect_height r)+    sendMessage $ SetGeometry rect+ -- | Given a window and the state, if a matching decoration is in the -- state return it with its ('Maybe') 'Rectangle'. lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))@@ -345,7 +368,7 @@                        createNewWindow r mask (inactiveColor t) True  showDecos :: [DecoWin] -> X ()-showDecos = showWindows . catMaybes . map fst+showDecos = showWindows . catMaybes . map fst . filter (isJust . snd)  hideDecos :: [DecoWin] -> X () hideDecos = hideWindows . catMaybes . map fst@@ -374,7 +397,11 @@   let s = shrinkIt sh   name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n                                   return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)-  paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name+  let als = AlignCenter : map snd (windowTitleAddons t)+      strs = name : map fst (windowTitleAddons t)+      i_als = map snd (windowTitleIcons t)+      icons = map fst (windowTitleIcons t)+  paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w updateDeco _ _ _ _ = return ()
+ XMonad/Layout/DecorationAddons.hs view
@@ -0,0 +1,123 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationAddons+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- Various stuff that can be added to the decoration. Most of it+-- is intended to be used by other modules. See+-- "XMonad.Layout.ButtonDecoration" for a module that makes use of this.+--+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationAddons (+                                    titleBarButtonHandler+                                   ,defaultThemeWithButtons+                                   ,handleScreenCrossing+                                   ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Layout.Decoration+import XMonad.Actions.WindowMenu+import XMonad.Layout.Minimize+import XMonad.Layout.Maximize+import XMonad.Hooks.ManageDocks+import XMonad.Util.Font+import XMonad.Util.PositionStore++import Control.Applicative((<$>))+import Data.Maybe+import qualified Data.Set as S++minimizeButtonOffset :: Int+minimizeButtonOffset = 48++maximizeButtonOffset :: Int+maximizeButtonOffset = 25++closeButtonOffset :: Int+closeButtonOffset = 10++buttonSize :: Int+buttonSize = 10++-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration.+-- It will intercept clicks on the buttons of the decoration and invoke the associated action.+-- To actually see the buttons, you will need to use a theme that includes them.+-- See 'defaultThemeWithButtons' below.+titleBarButtonHandler :: Window -> Int -> Int -> X Bool+titleBarButtonHandler mainw distFromLeft distFromRight = do+    let action = if (fi distFromLeft <= 3 * buttonSize)+                        then focus mainw >> windowMenu >> return True+                  else if (fi distFromRight >= closeButtonOffset &&+                           fi distFromRight <= closeButtonOffset + buttonSize)+                              then focus mainw >> kill >> return True+                  else if (fi distFromRight >= maximizeButtonOffset &&+                           fi distFromRight <= maximizeButtonOffset + (2 * buttonSize))+                             then focus mainw >> sendMessage (maximizeRestore mainw) >> return True+                  else if (fi distFromRight >= minimizeButtonOffset &&+                           fi distFromRight <= minimizeButtonOffset + buttonSize)+                             then focus mainw >> minimizeWindow mainw >> return True+                  else return False+    action++-- | Intended to be used together with 'titleBarButtonHandler'. See above.+defaultThemeWithButtons :: Theme+defaultThemeWithButtons = defaultTheme {+                            windowTitleAddons = [ (" (M)", AlignLeft)+                                                , ("_"   , AlignRightOffset minimizeButtonOffset)+                                                , ("[]"  , AlignRightOffset maximizeButtonOffset)+                                                , ("X"   , AlignRightOffset closeButtonOffset)+                                                ]+                            }++-- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration.+-- It will check if the window has been dragged onto another screen and shift it there.+-- The PositionStore is also updated accordingly, as this is designed to be used together+-- with "XMonad.Layout.PositionStoreFloat".+handleScreenCrossing :: Window -> Window -> X Bool+handleScreenCrossing w decoWin = withDisplay $ \d -> do+    root <- asks theRoot+    (_, _, _, px, py, _, _, _) <- io $ queryPointer d root+    ws <- gets windowset+    sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py)+    maybeWksp <- screenWorkspace $ W.screen sc+    let targetWksp = maybeWksp >>= \wksp ->+                        W.findTag w ws >>= \currentWksp ->+                        if (currentWksp /= wksp)+                            then Just wksp+                            else Nothing+    case targetWksp of+        Just wksp -> do+                        -- find out window under cursor on target workspace+                        -- apparently we have to switch to the workspace first+                        -- to make this work, which unforunately introduces some flicker+                        windows $ \ws' -> W.view wksp ws'+                        (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root++                        -- adjust PositionStore+                        let oldScreenRect = screenRect . W.screenDetail $ W.current ws+                            newScreenRect = screenRect . W.screenDetail $ sc+                        {-- somewhat ugly hack to get proper ScreenRect,+                            creates unwanted inter-dependencies+                            TODO: get ScreenRects in a proper way --}+                        oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound])+                        newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound])+                        wa <- io $ getWindowAttributes d decoWin+                        modifyPosStore (\ps ->+                            posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa)+                                oldScreenRect' newScreenRect')++                        -- set focus correctly so the window will be inserted+                        -- at the correct position on the target workspace+                        -- and then shift the window+                        windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws'++                        -- return True to signal that screen crossing has taken place+                        return True+        Nothing -> return False
XMonad/Layout/DecorationMadness.hs view
@@ -94,7 +94,6 @@  import XMonad.Layout.Accordion import XMonad.Layout.Circle-import XMonad.Layout.ResizeScreen import XMonad.Layout.WindowArranger import XMonad.Layout.SimpleFloat
XMonad/Layout/Dishes.hs view
@@ -21,7 +21,6 @@                               Dishes (..)                             ) where -import Data.List import XMonad import XMonad.StackSet (integrate) import Control.Monad (ap)
+ XMonad/Layout/DraggingVisualizer.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DraggingVisualizer+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- A helper module to visualize the process of dragging a window by+-- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration"+-- for a module that makes use of this.+--+-----------------------------------------------------------------------------++module XMonad.Layout.DraggingVisualizer+    ( draggingVisualizer,+      DraggingVisualizerMsg (..),+      DraggingVisualizer,+    ) where++import XMonad+import XMonad.Layout.LayoutModifier++data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show )+draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window+draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing++data DraggingVisualizerMsg = DraggingWindow Window Rectangle+                                | DraggingStopped+                                deriving ( Typeable, Eq )+instance Message DraggingVisualizerMsg++instance LayoutModifier DraggingVisualizer Window where+    modifierDescription (DraggingVisualizer _) = "DraggingVisualizer"+    pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs =+            if draggedWin `elem` (map fst wrs)+                then (dragged : rest, Nothing)+                else (wrs, Just $ DraggingVisualizer Nothing)+        where+            rest = filter (\(w, _) -> w /= draggedWin) wrs+    pureModifier _ _ _ wrs = (wrs, Nothing)++    pureMess (DraggingVisualizer _) m = case fromMessage m of+        Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect)+        Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing+        _ -> Nothing
+ XMonad/Layout/Drawer.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Drawer+-- Copyright   :  (c) 2009 Max Rabkin+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  max.rabkin@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier that puts some windows in a "drawer" which retracts and+-- expands depending on whether any window in it has focus.+--+-- Useful for music players, tool palettes, etc.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Drawer+    ( -- * Usage+      -- $usage++      -- * Drawers+      simpleDrawer+    , drawer++      -- * Placing drawers+      -- The drawer can be placed on any side of the screen with these functions+    , onLeft, onTop, onRight, onBottom++    , module XMonad.Util.WindowProperties++    , Drawer, Reflected+    ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Util.WindowProperties+import XMonad.StackSet as S+import XMonad.Layout.Reflect++-- $usage+-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Drawer+--+-- > myLayout = drawer `onTop` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout...+-- >     where+-- >         drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat")+-- >+-- > main = xmonad defaultConfig { layoutHook = myLayout }+--+-- This will place the Rhythmbox and Xchat windows in at the top of the screen+-- only when using the 'Tall' layout.  See "XMonad.Util.WindowProperties" for+-- more information on selecting windows.++data Drawer l a = Drawer Rational Rational Property (l a)+    deriving (Read, Show)++-- | filter : filterM :: partition : partitionM+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])+partitionM _ [] = return ([], [])+partitionM f (x:xs) = do+    b <- f x+    (ys, zs) <- partitionM f xs+    return $ if b+                then (x:ys, zs)+                else (ys, x:zs)++instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where+    modifyLayout (Drawer rs rb p l) ws rect =+        case stack ws of+            Nothing -> runLayout ws rect+            Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do+                    (upD, upM) <- partitionM (hasProperty p) up_+                    (downD, downM) <- partitionM (hasProperty p) down_+                    b <- hasProperty p w+                    focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset)++                    let rectD = if b && Just w == focusedWindow then rectB else rectS++                    let (stackD, stackM) = if b+                                            then ( Just $ stk { up=upD, down=downD }+                                                 , mkStack upM downM )+                                            else ( mkStack upD downD+                                                 , Just $ stk { up=upM, down=downM } )++                    (winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD+                    (winsM, u') <- runLayout (ws { stack=stackM }) rectM+                    return (winsD ++ winsM, u')+      where+        mkStack [] [] = Nothing+        mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys })+        mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys })++        rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb }+        rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) }+        rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs)+                     , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) }++type Reflected l = ModifiedLayout Reflect l++-- | Construct a drawer with a simple layout of the windows inside+simpleDrawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed+              -> Rational   -- ^ The portion of the screen taken up by the drawer when open+              -> Property   -- ^ Which windows to put in the drawer+              -> Drawer Tall a+simpleDrawer rs rb p = Drawer rs rb p vertical+    where+        vertical = Tall 0 0 0++-- Export a synonym for the constructor as a Haddock workaround+-- | Construct a drawer with an arbitrary layout for windows inside+drawer ::    Rational   -- ^ The portion of the screen taken up by the drawer when closed+          -> Rational   -- ^ The portion of the screen taken up by the drawer when open+          -> Property   -- ^ Which windows to put in the drawer+          -> (l a)      -- ^ The layout of windows in the drawer+          -> Drawer l a+drawer = Drawer++onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a+onLeft = ModifiedLayout++onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a+onRight d = reflectHoriz . onLeft d . reflectHoriz++onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a+onTop d = Mirror . onLeft d . Mirror++onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a+onBottom d = reflectVert . onTop d . reflectVert
+ XMonad/Layout/Fullscreen.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Decoration+-- Copyright   :  (c) 2010 Audun Skaugen+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  audunskaugen@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Hooks for sending messages about fullscreen windows to layouts, and+-- a few example layout modifier that implement fullscreen windows.+-----------------------------------------------------------------------------+module XMonad.Layout.Fullscreen+    ( -- * Usage:+      -- $usage+     fullscreenFull+    ,fullscreenFocus+    ,fullscreenFullRect+    ,fullscreenFocusRect+    ,fullscreenFloat+    ,fullscreenFloatRect+    ,fullscreenEventHook+    ,fullscreenManageHook+    ,fullscreenManageHookWith+    ,FullscreenMessage(..)+     -- * Types for reference+    ,FullscreenFloat, FullscreenFocus, FullscreenFull+    ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Util.WindowProperties+import XMonad.Hooks.ManageHelpers (isFullscreen)+import qualified XMonad.StackSet as W+import Data.List+import Data.Maybe+import Data.Monoid+import qualified Data.Map as M+import Control.Monad+import Control.Arrow (second)++-- $usage+-- Provides a ManageHook and an EventHook that sends layout messages+-- with information about fullscreening windows. This allows layouts+-- to make their own decisions about what they should to with a+-- window that requests fullscreen.+--+-- The module also includes a few layout modifiers as an illustration+-- of how such layouts should behave.+--+-- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook'+-- to your config, i.e.+--+-- > xmonad defaultconfig { eventHook = fullscreenEventHook,+-- >                        manageHook = fullscreenManageHook,+-- >                        layoutHook = myLayouts }+--+-- Now you can use layouts that respect fullscreen, for example the+-- provided 'fullscreenFull':+--+-- > myLayouts = fullscreenFull someLayout+--++-- | Messages that control the fullscreen state of the window.+-- AddFullscreen and RemoveFullscreen are sent to all layouts+-- when a window wants or no longer wants to be fullscreen.+-- FullscreenChanged is sent to the current layout after one+-- of the above have been sent.+data FullscreenMessage = AddFullscreen Window+                       | RemoveFullscreen Window+                       | FullscreenChanged+     deriving (Typeable)++instance Message FullscreenMessage++data FullscreenFull a = FullscreenFull W.RationalRect [a]+     deriving (Read, Show)++data FullscreenFocus a = FullscreenFocus W.RationalRect [a]+     deriving (Read, Show)++data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))+     deriving (Read, Show)++instance LayoutModifier FullscreenFull Window where+  pureMess ff@(FullscreenFull frect fulls) m = case fromMessage m of+    Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls+    Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls+    Just FullscreenChanged -> Just ff+    _ -> Nothing++  pureModifier (FullscreenFull frect fulls) rect _ list =+    (map (flip (,) rect') visfulls ++ rest, Nothing)+    where visfulls = intersect fulls $ map fst list+          rest = filter (flip notElem visfulls . fst) list+          rect' = scaleRationalRect rect frect++instance LayoutModifier FullscreenFocus Window where+  pureMess ff@(FullscreenFocus frect fulls) m = case fromMessage m of+    Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls+    Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls+    Just FullscreenChanged -> Just ff+    _ -> Nothing++  pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list+     | f `elem` fulls = ((f, rect') : rest, Nothing)+     | otherwise = (list, Nothing)+     where rest = filter ((/= f) . fst) list+           rect' = scaleRationalRect rect frect+  pureModifier _ _ Nothing list = (list, Nothing)++instance LayoutModifier FullscreenFloat Window where+  handleMess (FullscreenFloat frect fulls) m = case fromMessage m of+    Just (AddFullscreen win) -> do+      mrect <- (M.lookup win . W.floating) `fmap` gets windowset+      return $ case mrect of+        Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls+        Nothing -> Nothing++    Just (RemoveFullscreen win) ->+      return $ Just $ FullscreenFloat frect $ M.adjust (second $ const False) win fulls++    -- Modify the floating member of the stack set directly; this is the hackish part.+    Just FullscreenChanged -> do+      state <- get+      let ws = windowset state+          flt = W.floating ws+          flt' = M.intersectionWith doFull fulls flt+      put state {windowset = ws {W.floating = M.union flt' flt}}+      return $ Just $ FullscreenFloat frect $ M.filter snd fulls+      where doFull (_, True) _ = frect+            doFull (rect, False) _ = rect++    Nothing -> return Nothing++-- | Layout modifier that makes fullscreened window fill the+-- entire screen.+fullscreenFull :: LayoutClass l a =>+  l a -> ModifiedLayout FullscreenFull l a+fullscreenFull = fullscreenFullRect $ W.RationalRect 0 0 1 1++-- | As above, but the fullscreened window will fill the+-- specified rectangle instead of the entire screen.+fullscreenFullRect :: LayoutClass l a =>+  W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a+fullscreenFullRect r = ModifiedLayout $ FullscreenFull r []++-- | Layout modifier that makes the fullscreened window fill+-- the entire screen only if it is currently focused.+fullscreenFocus :: LayoutClass l a =>+  l a -> ModifiedLayout FullscreenFocus l a+fullscreenFocus = fullscreenFocusRect $ W.RationalRect 0 0 1 1++-- | As above, but the fullscreened window will fill the+-- specified rectangle instead of the entire screen.+fullscreenFocusRect :: LayoutClass l a =>+  W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a+fullscreenFocusRect r = ModifiedLayout $ FullscreenFocus r []++-- | Hackish layout modifier that makes floating fullscreened+-- windows fill the entire screen.+fullscreenFloat :: LayoutClass l a =>+  l a -> ModifiedLayout FullscreenFloat l a+fullscreenFloat = fullscreenFloatRect $ W.RationalRect 0 0 1 1++-- | As above, but the fullscreened window will fill the+-- specified rectangle instead of the entire screen.+fullscreenFloatRect :: LayoutClass l a =>+  W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a+fullscreenFloatRect r = ModifiedLayout $ FullscreenFloat r M.empty++-- | The event hook required for the layout modifiers to work+fullscreenEventHook :: Event -> X All+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do+  state <- getAtom "_NET_WM_STATE"+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"+  wstate <- fromMaybe [] `fmap` getProp32 state win+  let fi :: (Integral i, Num n) => i -> n+      fi = fromIntegral+      isFull = fi fullsc `elem` wstate+      remove = 0+      add = 1+      toggle = 2+      ptype = 4+      chWState f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)+  when (typ == state && fi fullsc `elem` dats) $ do+    when (action == add || (action == toggle && not isFull)) $ do+      chWState (fi fullsc:)+      broadcastMessage $ AddFullscreen win+      sendMessage FullscreenChanged+    when (action == remove || (action == toggle && isFull)) $ do+      chWState $ delete (fi fullsc)+      broadcastMessage $ RemoveFullscreen win+      sendMessage FullscreenChanged+  return $ All True++fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do+  -- When a window is destroyed, the layouts should remove that window+  -- from their states.+  broadcastMessage $ RemoveFullscreen w+  cw <- (W.workspace . W.current) `fmap` gets windowset+  sendMessageWithNoRefresh FullscreenChanged cw+  return $ All True++fullscreenEventHook _ = return $ All True++-- | Manage hook that sets the fullscreen property for+-- windows that are initially fullscreen+fullscreenManageHook :: ManageHook+fullscreenManageHook = fullscreenManageHook' isFullscreen++-- | A version of fullscreenManageHook that lets you specify+-- your own query to decide whether a window should be fullscreen.+fullscreenManageHookWith :: Query Bool -> ManageHook+fullscreenManageHookWith h = fullscreenManageHook' $ isFullscreen <||> h++fullscreenManageHook' :: Query Bool -> ManageHook+fullscreenManageHook' isFull = isFull --> do+  w <- ask+  liftX $ do+    broadcastMessage $ AddFullscreen w+    cw <- (W.workspace . W.current) `fmap` gets windowset+    sendMessageWithNoRefresh FullscreenChanged cw+  idHook+
XMonad/Layout/Gaps.hs view
@@ -28,7 +28,7 @@ module XMonad.Layout.Gaps (                                -- * Usage                                -- $usage-                          Direction2D(..),+                          Direction2D(..), Gaps,                           GapSpec, gaps, GapMessage(..)                            ) where@@ -38,6 +38,7 @@  import XMonad.Layout.LayoutModifier import XMonad.Util.Types (Direction2D(..))+import XMonad.Util.XUtils (fi)  import Data.List (delete) @@ -56,8 +57,8 @@ -- -- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps)  -- toggle all gaps -- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap--- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap R 5)  -- increment the right-hand gap--- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap R 5)  -- decrement the right-hand gap+-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R)  -- increment the right-hand gap+-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R)  -- decrement the right-hand gap -- -- If you want complete control over all gaps, you could include -- something like this in your keybindings, assuming in this case you@@ -132,9 +133,6 @@  incGap :: GapSpec -> Direction2D -> Int -> GapSpec incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs--fi :: (Num b, Integral a) => a -> b-fi = fromIntegral  -- | Add togglable manual gaps to a layout. gaps :: GapSpec   -- ^ The gaps to allow, paired with their initial sizes.
XMonad/Layout/GridVariants.hs view
@@ -19,7 +19,8 @@  module XMonad.Layout.GridVariants ( -- * Usage                                     -- $usage-                                    ChangeMasterGeom(..)+                                    ChangeMasterGridGeom(..)+                                  , ChangeGridGeom(..)                                   , Grid(..)                                   , TallGrid(..)                                   , SplitGrid(..)@@ -68,9 +69,24 @@           nwins = length wins           rects = arrangeAspectGrid rect nwins aspect +    pureMessage layout msg = fmap (changeGridAspect layout) (fromMessage msg)+     description _ = "Grid" --- | SplitGrid layout.  Parameters are+changeGridAspect :: Grid a -> ChangeGridGeom -> Grid a+changeGridAspect (Grid _) (SetGridAspect aspect) = Grid aspect+changeGridAspect (Grid aspect) (ChangeGridAspect delta) =+    Grid (max 0.00001 (aspect + delta))++-- |Geometry change messages understood by Grid and SplitGrid+data ChangeGridGeom+    = SetGridAspect !Rational+    | ChangeGridAspect !Rational+      deriving Typeable++instance Message ChangeGridGeom++-- |SplitGrid layout.  Parameters are -- --   - side where the master is --   - number of master rows@@ -81,8 +97,8 @@ data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational                    deriving (Read, Show) --- | Type to specify the side of the screen that holds---   the master area of a SplitGrid.+-- |Type to specify the side of the screen that holds+--  the master area of a SplitGrid. data Orientation = T | B | L | R                    deriving (Eq, Read, Show) @@ -95,18 +111,23 @@           rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect      pureMessage layout msg =-        msum [ fmap (resizeMaster layout) (fromMessage msg)-             , fmap (changeMasterGrid layout) (fromMessage msg) ]+        msum [ fmap (resizeMaster layout)          (fromMessage msg)+             , fmap (changeMasterGrid layout)      (fromMessage msg)+             , fmap (changeSlaveGridAspect layout) (fromMessage msg)+             ]      description _ = "SplitGrid"  -- |The geometry change message understood by the master grid-data ChangeMasterGeom-    = IncMasterRows !Int -- ^Change the number of master rows-    | IncMasterCols !Int -- ^Change the number of master columns+data ChangeMasterGridGeom+    = IncMasterRows     !Int      -- ^Change the number of master rows+    | IncMasterCols     !Int      -- ^Change the number of master columns+    | SetMasterRows     !Int      -- ^Set the number of master rows to absolute value+    | SetMasterCols     !Int      -- ^Set the number of master columns to absolute value+    | SetMasterFraction !Rational -- ^Set the fraction of the screen used by the master grid     deriving Typeable -instance Message ChangeMasterGeom+instance Message ChangeMasterGridGeom  arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle] arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect@@ -183,11 +204,23 @@ resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand =     SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta -changeMasterGrid :: SplitGrid a -> ChangeMasterGeom -> SplitGrid a+changeMasterGrid :: SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) =     SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) =     SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta+changeMasterGrid (SplitGrid o _ mcols mfrac saspect delta) (SetMasterRows mrows) =+    SplitGrid o (max 0 mrows) mcols mfrac saspect delta+changeMasterGrid (SplitGrid o mrows _ mfrac saspect delta) (SetMasterCols mcols) =+    SplitGrid o mrows (max 0 mcols) mfrac saspect delta+changeMasterGrid (SplitGrid o mrows mcols _ saspect delta) (SetMasterFraction mfrac) =+    SplitGrid o mrows mcols mfrac saspect delta++changeSlaveGridAspect :: SplitGrid a -> ChangeGridGeom -> SplitGrid a+changeSlaveGridAspect (SplitGrid o mrows mcols mfrac _ delta) (SetGridAspect saspect) =+    SplitGrid o mrows mcols mfrac saspect delta+changeSlaveGridAspect (SplitGrid o mrows mcols mfrac saspect delta) (ChangeGridAspect sdelta) =+    SplitGrid o mrows mcols mfrac (max 0.00001 (saspect + sdelta)) delta  -- | TallGrid layout.  Parameters are --
+ XMonad/Layout/Groups.hs view
@@ -0,0 +1,510 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}+{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable+  , UndecidableInstances, FlexibleInstances, MultiParamTypeClasses+  , PatternGuards, Rank2Types, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Groups+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  unstable+-- Portability :  unportable+--+-- Two-level layout with windows split in individual layout groups,+-- themselves managed by a user-provided layout.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Groups ( -- * Usage+                              -- $usage+                              -- * Creation+                              group+                              -- * Messages+                            , GroupsMessage(..)+                            , ModifySpec+                              -- ** Useful 'ModifySpec's+                            , swapUp+                            , swapDown+                            , swapMaster+                            , focusUp+                            , focusDown+                            , focusMaster+                            , swapGroupUp+                            , swapGroupDown+                            , swapGroupMaster+                            , focusGroupUp+                            , focusGroupDown+                            , focusGroupMaster+                            , moveToGroupUp+                            , moveToGroupDown+                            , moveToNewGroupUp+                            , moveToNewGroupDown+                            , splitGroup+                              -- * Types+                            , Groups+                            , Group(..)+                            , onZipper+                            , onLayout+                            , WithID+                            , sameID+                            ) where++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Util.Stack++import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)+import Data.List ((\\))+import Control.Arrow ((>>>))+import Control.Applicative ((<$>))+import Control.Monad (forM)++-- $usage+-- This module provides a layout combinator that allows you+-- to manage your windows in independent groups. You can provide+-- both the layout with which to arrange the windows inside each+-- group, and the layout with which the groups themselves will+-- be arranged on the screen.+--+-- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii" +-- modules contain examples of layouts that can be defined with this +-- combinator. They're also the recommended starting point +-- if you are a beginner and looking for something you can use easily.+--+-- One thing to note is that 'Groups'-based layout have their own+-- notion of the order of windows, which is completely separate+-- from XMonad's. For this reason, operations like 'XMonad.StackSet.SwapUp'+-- will have no visible effect, and those like 'XMonad.StackSet.focusUp'+-- will focus the windows in an unpredictable order. For a better way of+-- rearranging windows and moving focus in such a layout, see the+-- example 'ModifySpec's (to be passed to the 'Modify' message) provided +-- by this module.+--+-- If you use both 'Groups'-based and other layouts, The "XMonad.Layout.Groups.Helpers"+-- module provides actions that can work correctly with both, defined using+-- functions from "XMonad.Actions.MessageFeedback".++-- | Create a 'Groups' layout.+--+-- Note that the second parameter (the layout for arranging the+-- groups) is not used on 'Windows', but on 'Group's. For this+-- reason, you can only use layouts that don't specifically+-- need to manage 'Window's. This is obvious, when you think+-- about it.+group :: l Window -> l2 (Group l Window) -> Groups l l2 Window+group l l2 = Groups l l2 startingGroups (U 1 0)+    where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ+++-- * Stuff with unique keys++data Uniq = U Integer Integer+  deriving (Eq, Show, Read)++-- | From a seed, generate an infinite list of keys and a new +-- seed. All keys generated with this method will be different+-- provided you don't use 'gen' again with a key from the list.+-- (if you need to do that, see 'split' instead)+gen :: Uniq -> (Uniq, [Uniq])+gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..])++-- | Split an infinite list into two. I ended up not+-- needing this, but let's keep it just in case.+-- split :: [a] -> ([a], [a])+-- split as = snd $ foldr step (True, ([], [])) as+--     where step a (True, (as1, as2)) = (False, (a:as1, as2))+--           step a (False, (as1, as2)) = (True, (as1, a:as2))++-- | Add a unique identity to a layout so we can+-- follow it around.+data WithID l a = ID { getID :: Uniq +                     , unID :: (l a)}+  deriving (Show, Read)++-- | Compare the ids of two 'WithID' values+sameID :: WithID l a -> WithID l a -> Bool+sameID (ID id1 _) (ID id2 _) = id1 == id2++instance Eq (WithID l a) where+    ID id1 _ == ID id2 _ = id1 == id2++instance LayoutClass l a => LayoutClass (WithID l) a where+    runLayout ws@W.Workspace { W.layout = ID id l } r +        = do (placements, ml') <- flip runLayout r +                                     ws { W.layout = l}+             return (placements, ID id <$> ml')+    handleMessage (ID id l) sm = do ml' <- handleMessage l sm+                                    return $ ID id <$> ml'+    description (ID _ l) = description l++          ++-- * The 'Groups' layout+++-- ** Datatypes++-- | A group of windows and its layout algorithm.+data Group l a = G { gLayout :: WithID l a+                   , gZipper :: Zipper a }+  deriving (Show, Read, Eq)++onLayout :: (WithID l a -> WithID l a) -> Group l a -> Group l a+onLayout f g = g { gLayout = f $ gLayout g }++onZipper :: (Zipper a -> Zipper a) -> Group l a -> Group l a+onZipper f g = g { gZipper = f $ gZipper g }++-- | The type of our layouts.+data Groups l l2 a = Groups { -- | The starting layout for new groups+                              baseLayout :: l a+                              -- | The layout for placing each group on the screen+                            , partitioner :: l2 (Group l a)+                              -- | The window groups+                            , groups :: W.Stack (Group l a)+                              -- | A seed for generating unique ids+                            , seed :: Uniq+                            }++deriving instance (Show a, Show (l a), Show (l2 (Group l a))) => Show (Groups l l2 a)+deriving instance (Read a, Read (l a), Read (l2 (Group l a))) => Read (Groups l l2 a)++-- | Messages accepted by 'Groups'-based layouts.+-- All other messages are forwarded to the layout of the currently+-- focused subgroup (as if they had been wrapped in 'ToFocused').+data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosing layout+                                             -- (the one that places the groups themselves)+                   | ToGroup Int SomeMessage -- ^ Send a message to the layout for nth group+                                             -- (starting at 0)+                   | ToFocused SomeMessage -- ^ Send a message to the layout for the focused+                                           -- group+                   | ToAll SomeMessage -- ^ Send a message to all the sub-layouts+                   | Refocus -- ^ Refocus the window which should be focused according+                             -- to the layout.+                   | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing+                                       -- of windows according to a 'ModifySpec'+                     deriving Typeable++instance Show GroupsMessage where+    show (ToEnclosing _) = "ToEnclosing {...}"+    show (ToGroup i _) = "ToGroup "++show i++" {...}"+    show (ToFocused _) = "ToFocused {...}"+    show (ToAll _) = "ToAll {...}"+    show Refocus = "Refocus"+    show (Modify _) = "Modify {...}"++instance Message GroupsMessage++modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a))+             -> Groups l l2 a -> Groups l l2 a+modifyGroups f g = let (seed', id:_) = gen (seed g)+                       defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ+                   in g { groups = fromMaybe defaultGroups . f . Just $ groups g+                        , seed = seed' }+++-- ** Readaptation++-- | Adapt our groups to a new stack.+-- This algorithm handles window additions and deletions correctly,+-- ignores changes in window ordering, and tries to react to any +-- other stack changes as gracefully as possible.+readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a+readapt z g = let mf = getFocusZ z+                  (seed', id:_) = gen $ seed g+                  g' = g { seed = seed' }+              in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z)+                                        >>> filterKeepLast (isJust . gZipper)+                                        >>> findNewWindows (W.integrate' z)+                                        >>> addWindows (ID id $ baseLayout g)+                                        >>> focusGroup mf+                                        >>> onFocusedZ (onZipper $ focusWindow mf)+    where filterKeepLast _ Nothing = Nothing+          filterKeepLast f z@(Just s) = maybe (singletonZ $ W.focus s) Just+                                            $ filterZ_ f z++-- | Remove the windows from a group which are no longer present in+-- the stack.+removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a+removeDeleted z = filterZ_ (flip elemZ z)++-- | Identify the windows not already in a group.+findNewWindows :: Eq a => [a] -> Zipper (Group l a) +               -> (Zipper (Group l a), [a])+findNewWindows as gs = (gs, foldrZ_ removePresent as gs)+    where removePresent g as' = filter (not . flip elemZ (gZipper g)) as'++-- | Add windows to the focused group. If you need to create one,+-- use the given layout and an id from the given list.+addWindows :: WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)+addWindows l (Nothing, as) = singletonZ $ G l (W.differentiate as)+addWindows _ (z, as) = onFocusedZ (onZipper add) z+    where add z = foldl (flip insertUpZ) z as++-- | Focus the group containing the given window+focusGroup :: Eq a => Maybe a -> Zipper (Group l a) -> Zipper (Group l a)+focusGroup Nothing = id+focusGroup (Just a) = fromTags . map (tagBy $ elemZ a . gZipper) . W.integrate'++-- | Focus the given window+focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a+focusWindow Nothing = id+focusWindow (Just a) = fromTags . map (tagBy (==a)) . W.integrate'+++-- * Interface++-- ** Layout instance++instance (LayoutClass l Window, LayoutClass l2 (Group l Window))+    => LayoutClass (Groups l l2) Window where++        description (Groups _ p gs _) = s1++" by "++s2+            where s1 = description $ gLayout $ W.focus gs+                  s2 = description p++        runLayout ws@(W.Workspace _ _l z) r = let l = readapt z _l in+            do (areas, mpart') <- runLayout ws { W.layout = partitioner l+                                               , W.stack = Just $ groups l } r++               results <- forM areas $ \(g, r') -> runLayout ws { W.layout = gLayout g+                                                                , W.stack = gZipper g } r'++               let hidden = map gLayout (W.integrate $ groups l) \\ map (gLayout . fst) areas+               hidden' <- mapM (flip handleMessage $ SomeMessage Hide) hidden++               let placements = concatMap fst results+                   newL = justMakeNew l mpart' (map snd results ++ hidden')+                                        +               return $ (placements, newL)++        handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm +            = do mp' <- handleMessage p sm'+                 return $ maybeMakeNew l mp' []++        handleMessage l@(Groups _ p gs _) sm | Just (ToAll sm') <- fromMessage sm+            = do mp' <- handleMessage p sm'+                 mg's <- mapZM_ (handle sm') $ Just gs+                 return $ maybeMakeNew l mp' $ W.integrate' mg's+            where handle sm (G l _) = handleMessage l sm++        handleMessage l sm | Just a <- fromMessage sm+            = let _rightType = a == Hide -- Is there a better-looking way+                                         -- of doing this?+              in handleMessage l $ SomeMessage $ ToAll sm++        handleMessage l@(Groups _ _ z _) sm = case fromMessage sm of+              Just (ToFocused sm') -> do mg's <- W.integrate' <$> handleOnFocused sm' z+                                         return $ maybeMakeNew l Nothing mg's+              Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z+                                         return $ maybeMakeNew l Nothing mg's+              Just (Modify spec) -> case applySpec spec l of+                                      Just l' -> refocus l' >> return (Just l')+                                      Nothing -> return $ Just l+              Just Refocus -> refocus l >> return (Just l)+              Just _ -> return Nothing+              Nothing -> handleMessage l $ SomeMessage (ToFocused sm)+            where handleOnFocused sm z = mapZM step $ Just z+                      where step True (G l _) = handleMessage l sm+                            step False _ = return Nothing+                  handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate z+                      where step (j, (G l _)) | i == j = handleMessage l sm+                            step _ = return Nothing+++justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] +            -> Maybe (Groups l l2 a)+justMakeNew g mpart' ml's = Just g { partitioner = fromMaybe (partitioner g) mpart'+                                   , groups = combine (groups g) ml's }+    where combine z ml's = let table = map (\(ID id a) -> (id, a)) $ catMaybes ml's+                           in flip mapS_ z $ \(G (ID id l) ws) -> case lookup id table of+                                        Nothing -> G (ID id l) ws+                                        Just l' -> G (ID id l') ws+          mapS_ f = fromJust . mapZ_ f . Just+++maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]+             -> Maybe (Groups l l2 a)+maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing+maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's++refocus :: Groups l l2 Window -> X ()+refocus g = case getFocusZ $ gZipper $ W.focus $ groups g+            of Just w -> focus w+               Nothing -> return ()++-- ** ModifySpec type++-- | Type of functions describing modifications to a 'Groups' layout. They +-- are transformations on 'Zipper's of groups.+--+-- Things you shouldn't do:+--+-- * Forge new windows (they will be ignored)+--+-- * Duplicate windows (whatever happens is your problem)+--+-- * Remove windows (they will be added again)+--+-- * Duplicate layouts (only one will be kept, the rest will+--   get the base layout)+--+-- Note that 'ModifySpec' is a rank-2 type (indicating that 'ModifySpec's must+-- be polymorphic in the layout type), so if you define functions taking+-- 'ModifySpec's as arguments, or returning them,  you'll need to write a type+-- signature and add @{-# LANGUAGE Rank2Types #-}@ at the beginning+type ModifySpec = forall l. WithID l Window+                -> Zipper (Group l Window) +                -> Zipper (Group l Window)++-- | Apply a ModifySpec.+applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)+applySpec f g = let (seed', id:ids) = gen $ seed g+                    g' = flip modifyGroups g $ f (ID id $ baseLayout g)+                                               >>> toTags+                                               >>> foldr reID ((ids, []), [])+                                               >>> snd +                                               >>> fromTags+                in case groups g == groups g' of+                     True -> Nothing+                     False -> Just g' { seed = seed' }++    where reID eg ((id:ids, seen), egs)+              = let myID = getID $ gLayout $ fromE eg+                in case elem myID seen of+                     False -> ((id:ids, myID:seen), eg:egs)+                     True -> ((ids, seen), mapE_ (setID id) eg:egs)+              where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z+          reID _ (([], _), _) = undefined -- The list of ids is infinite++++++-- ** Misc. ModifySpecs++-- | helper+onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec+onFocused f _ gs = onFocusedZ (onZipper f) gs++-- | Swap the focused window with the previous one.+swapUp :: ModifySpec+swapUp = onFocused swapUpZ++-- | Swap the focused window with the next one.+swapDown :: ModifySpec+swapDown = onFocused swapDownZ++-- | Swap the focused window with the (group's) master+-- window.+swapMaster :: ModifySpec+swapMaster = onFocused swapMasterZ++-- | Swap the focused group with the previous one.+swapGroupUp :: ModifySpec+swapGroupUp _ = swapUpZ++-- | Swap the focused group with the next one.+swapGroupDown :: ModifySpec+swapGroupDown _ = swapDownZ++-- | Swap the focused group with the master group.+swapGroupMaster :: ModifySpec+swapGroupMaster _ = swapMasterZ++-- | Move focus to the previous window in the group.+focusUp :: ModifySpec+focusUp = onFocused focusUpZ++-- | Move focus to the next window in the group.+focusDown :: ModifySpec+focusDown = onFocused focusDownZ++-- | Move focus to the group's master window.+focusMaster :: ModifySpec+focusMaster = onFocused focusMasterZ++-- | Move focus to the previous group.+focusGroupUp :: ModifySpec+focusGroupUp _ = focusUpZ++-- | Move focus to the next group.+focusGroupDown :: ModifySpec+focusGroupDown _ = focusDownZ++-- | Move focus to the master group.+focusGroupMaster :: ModifySpec+focusGroupMaster _ = focusMasterZ++-- | helper+_removeFocused :: W.Stack a -> (a, Zipper a)+_removeFocused (W.Stack f (u:up) down) = (f, Just $ W.Stack u up down)+_removeFocused (W.Stack f [] (d:down)) = (f, Just $ W.Stack d [] down)+_removeFocused (W.Stack f [] []) = (f, Nothing)++-- helper+_moveToNewGroup :: WithID l Window -> W.Stack (Group l Window)+                -> (Group l Window -> Zipper (Group l Window) +                                   -> Zipper (Group l Window))+                -> Zipper (Group l Window)+_moveToNewGroup l0 s insertX | G l (Just f) <- W.focus s+    = let (w, f') = _removeFocused f+          s' = s { W.focus = G l f' }+      in insertX (G l0 $ singletonZ w) $ Just s'+_moveToNewGroup _ s _ = Just s+ +-- | Move the focused window to a new group before the current one.+moveToNewGroupUp :: ModifySpec+moveToNewGroupUp _ Nothing = Nothing+moveToNewGroupUp l0 (Just s) = _moveToNewGroup l0 s insertUpZ++-- | Move the focused window to a new group after the current one.+moveToNewGroupDown :: ModifySpec+moveToNewGroupDown _ Nothing = Nothing+moveToNewGroupDown l0 (Just s) = _moveToNewGroup l0 s insertDownZ+++-- | Move the focused window to the previous group.+-- If 'True', when in the first group, wrap around to the last one.+-- If 'False', create a new group before it.+moveToGroupUp :: Bool -> ModifySpec+moveToGroupUp _ _ Nothing = Nothing+moveToGroupUp False l0 (Just s) = if null (W.up s) then moveToNewGroupUp l0 (Just s)+                                                   else moveToGroupUp True l0 (Just s)+moveToGroupUp True _ (Just s@(W.Stack _ [] [])) = Just s+moveToGroupUp True _ (Just s@(W.Stack (G l (Just f)) _ _))+    = let (w, f') = _removeFocused f+      in onFocusedZ (onZipper $ insertUpZ w) $ focusUpZ $ Just s { W.focus = G l f' }+moveToGroupUp True _ gs = gs++-- | Move the focused window to the next group.+-- If 'True', when in the last group, wrap around to the first one.+-- If 'False', create a new group after it.+moveToGroupDown :: Bool -> ModifySpec+moveToGroupDown _ _ Nothing = Nothing+moveToGroupDown False l0 (Just s) = if null (W.down s) then moveToNewGroupDown l0 (Just s)+                                                       else moveToGroupDown True l0 (Just s)+moveToGroupDown True _ (Just s@(W.Stack _ [] [])) = Just s+moveToGroupDown True _ (Just s@(W.Stack (G l (Just f)) _ _))+    = let (w, f') = _removeFocused f+      in onFocusedZ (onZipper $ insertUpZ w) $ focusDownZ $ Just s { W.focus = G l f' }+moveToGroupDown True _ gs = gs++-- | Split the focused group into two at the position of the focused window (below it,+-- unless it's the last window - in that case, above it).+splitGroup :: ModifySpec+splitGroup _ Nothing = Nothing+splitGroup l0 z@(Just s) | G l (Just ws) <- W.focus s+    = case ws of+        W.Stack _ [] [] -> z+        W.Stack f (u:up) [] -> let g1 = G l  $ Just $ W.Stack f [] []+                                   g2 = G l0 $ Just $ W.Stack u up []+                               in insertDownZ g1 $ onFocusedZ (const g2) z+        W.Stack f up (d:down) -> let g1 = G l  $ Just $ W.Stack f up []+                                     g2 = G l0 $ Just $ W.Stack d [] down+                                 in insertUpZ g1 $ onFocusedZ (const g2) z+splitGroup _ _ = Nothing
+ XMonad/Layout/Groups/Examples.hs view
@@ -0,0 +1,240 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Groups.Examples+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  unstable+-- Portability :  unportable+--+-- Example layouts for "XMonad.Layout.Groups".+--+-----------------------------------------------------------------------------++module XMonad.Layout.Groups.Examples ( -- * Usage+                                       -- $usage++                                       -- * Example: Row of columns+                                       -- $example1+                                       rowOfColumns+                                     , zoomColumnIn+                                     , zoomColumnOut+                                     , zoomColumnReset+                                     , toggleColumnFull+                                     , zoomWindowIn+                                     , zoomWindowOut+                                     , zoomWindowReset+                                     , toggleWindowFull++                                       -- * Example: Tiled tab groups+                                       -- $example2+                                     , tallTabs+                                     , mirrorTallTabs+                                     , fullTabs+                                     , TiledTabsConfig(..)+                                     , defaultTiledTabsConfig+                                     , increaseNMasterGroups+                                     , decreaseNMasterGroups+                                     , shrinkMasterGroups+                                     , expandMasterGroups+                                     , nextOuterLayout+++                                       -- * Useful re-exports and utils+                                     , module XMonad.Layout.Groups.Helpers+                                     , shrinkText+                                     , defaultTheme+                                     , GroupEQ(..)+                                     , zoomRowG+                                     ) where++import XMonad hiding ((|||))++import qualified XMonad.Layout.Groups as G+import XMonad.Layout.Groups.Helpers++import XMonad.Layout.ZoomRow+import XMonad.Layout.Tabbed+import XMonad.Layout.Named+import XMonad.Layout.Renamed+import XMonad.Layout.LayoutCombinators+import XMonad.Layout.Decoration+import XMonad.Layout.Simplest+++-- $usage+-- This module contains example 'G.Groups'-based layouts. +-- You can either import this module directly, or look at its source+-- for ideas of how "XMonad.Layout.Groups" may be used.+--+-- You can use the contents of this module by adding+-- +-- > import XMonad.Layout.Groups.Examples+--+-- to the top of your @.\/.xmonad\/xmonad.hs@.+--+-- For more information on using any of the layouts, jump directly+--   to its \"Example\" section.+--+-- Whichever layout you choose to use, you will probably want to be +--   able to move focus and windows between groups in a consistent+--   manner. For this, you should take a look at the functions from+--   the "XMonad.Layout.Groups.Helpers" module, which are all +--   re-exported by this module.+--+-- For more information on how to extend your layour hook and key bindings, see+--   "XMonad.Doc.Extending".+++-- * Helper: ZoomRow of Group elements++-- | Compare two 'Group's by comparing the ids of their layouts.+data GroupEQ a = GroupEQ+  deriving (Show, Read)++instance Eq a => EQF GroupEQ (G.Group l a) where+    eq _ (G.G l1 _) (G.G l2 _) = G.sameID l1 l2++zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a)) +            => ZoomRow GroupEQ (G.Group l a)+zoomRowG = zoomRowWith GroupEQ+++-- * Example 1: Row of columns++-- $example1+-- A layout that arranges windows in a row of columns. It uses 'ZoomRow's for+-- both, allowing you to:+--+--  * Freely change the proportion of the screen width allocated to each column+--+--  * Freely change the proportion of a column's heigth allocated to each of its windows+--+--  * Set a column to occupy the whole screen space whenever it has focus+--+--  * Set a window to occupy its whole column whenever it has focus+--+-- to use this layout, add 'rowOfColumns' to your layout hook, for example:+--+-- > myLayout = rowOfColumns+--+-- To be able to change the sizes of columns and windows, you can create key bindings+-- for the relevant actions:+--+-- > ((modMask, xK_minus), zoomWindowOut)+--+-- and so on.++rowOfColumns = G.group column zoomRowG+    where column = renamed [CutWordsLeft 2, PrependWords "ZoomColumn"] $ Mirror zoomRow++-- | Increase the width of the focused column+zoomColumnIn :: X ()+zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomIn++-- | Decrease the width of the focused column+zoomColumnOut :: X ()+zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomOut++-- | Reset the width of the focused column+zoomColumnReset :: X ()+zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomReset++-- | Toggle whether the currently focused column should+-- take up all available space whenever it has focus+toggleColumnFull :: X ()+toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage $ ZoomFullToggle++-- | Increase the heigth of the focused window+zoomWindowIn :: X ()+zoomWindowIn = sendMessage zoomIn++-- | Decrease the height of the focused window+zoomWindowOut :: X ()+zoomWindowOut = sendMessage zoomOut++-- | Reset the height of the focused window+zoomWindowReset :: X ()+zoomWindowReset = sendMessage zoomReset++-- | Toggle whether the currently focused window should+-- take up the whole column whenever it has focus+toggleWindowFull :: X ()+toggleWindowFull = sendMessage ZoomFullToggle+++-- * Example 2: Tabbed groups in a Tall/Full layout.++-- $example2+-- A layout which arranges windows into tabbed groups, and the groups+-- themselves according to XMonad's default algorithm +-- (@'Tall' ||| 'Mirror' 'Tall' ||| 'Full'@). As their names+-- indicate, 'tallTabs' starts as 'Tall', 'mirrorTallTabs' starts +-- as 'Mirror' 'Tall' and 'fullTabs' starts as 'Full', but in any +-- case you can freely switch between the three afterwards.+--+-- You can use any of these three layouts by including it in your layout hook.+-- You will need to provide it with a 'TiledTabsConfig' containing the size+-- parameters for 'Tall' and 'Mirror' 'Tall', and the shrinker and decoration theme+-- for the tabs. If you're happy with defaults, you can use 'defaultTiledTabsConfig':+--+-- > myLayout = tallTabs defaultTiledTabsConfig+--+-- To be able to increase\/decrease the number of master groups and shrink\/expand+-- the master area, you can create key bindings for the relevant actions:+--+-- > ((modMask, xK_h), shrinkMasterGroups)+--+-- and so on.++-- | Configuration data for the "tiled tab groups" layout+data TiledTabsConfig s = TTC { vNMaster :: Int+                             , vRatio :: Rational+                             , vIncrement :: Rational+                             , hNMaster :: Int+                             , hRatio :: Rational+                             , hIncrement :: Rational+                             , tabsShrinker :: s+                             , tabsTheme :: Theme }++defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker+defaultTiledTabsConfig = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText defaultTheme++fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c ++tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full++mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c++_tabs = named "Tabs" Simplest++_tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l++_vert c = named "Vertical" $ Tall (vNMaster c) (vIncrement c) (vRatio c)++_horiz c = named "Horizontal" $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c)++-- | Increase the number of master groups by one+increaseNMasterGroups :: X ()+increaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN 1++-- | Decrease the number of master groups by one+decreaseNMasterGroups :: X ()+decreaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN (-1)++-- | Shrink the master area+shrinkMasterGroups :: X ()+shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Shrink++-- | Expand the master area+expandMasterGroups :: X ()+expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Expand++-- | Rotate the available outer layout algorithms+nextOuterLayout :: X ()+nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage $ NextLayout+
+ XMonad/Layout/Groups/Helpers.hs view
@@ -0,0 +1,232 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Groups.Helpers+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  stable+-- Portability :  unportable+--+-- Utility functions for "XMonad.Layout.Groups".+--+-----------------------------------------------------------------------------++module XMonad.Layout.Groups.Helpers ( -- * Usage+                                      -- $usage++                                      -- ** Layout-generic actions+                                      swapUp+                                    , swapDown+                                    , swapMaster+                                    , focusUp+                                    , focusDown+                                    , focusMaster+                                    , toggleFocusFloat++                                      -- ** 'G.Groups'-secific actions+                                    , swapGroupUp+                                    , swapGroupDown+                                    , swapGroupMaster+                                    , focusGroupUp+                                    , focusGroupDown+                                    , focusGroupMaster+                                    , moveToGroupUp+                                    , moveToGroupDown+                                    , moveToNewGroupUp+                                    , moveToNewGroupDown+                                    , splitGroup ) where++import XMonad hiding ((|||))+import qualified XMonad.StackSet as W++import qualified XMonad.Layout.Groups as G++import XMonad.Actions.MessageFeedback++import Control.Monad (unless)+import qualified Data.Map as M++-- $usage+--+-- This module provides helpers functions for use with "XMonad.Layout.Groups"-based+-- layouts. You can use its contents by adding+--+-- > import XMonad.Layout.Groups.Helpers+--+-- to the top of your @.\/.xmonad\/xmonad.hs@.+--+-- "XMonad.Layout.Groups"-based layouts do not have the same notion+-- of window ordering as the rest of XMonad. For this reason, the usual+-- ways of reordering windows and moving focus do not work with them.+-- "XMonad.Layout.Groups" provides 'Message's that can be used to obtain+-- the right effect.+--+-- But what if you want to use both 'G.Groups' and other layouts?+-- This module provides actions that try to send 'G.GroupsMessage's, and+-- fall back to the classic way if the current layout doesn't hande them.+-- They are in the section called \"Layout-generic actions\".+-- +-- The sections \"Groups-specific actions\" contains actions that don't make+-- sense for non-'G.Groups'-based layouts. These are simply wrappers around+-- the equivalent 'G.GroupsMessage's, but are included so you don't have to+-- write @sendMessage $ Modify $ ...@ everytime.+--+-- This module exports many operations with the same names as+-- 'G.ModifySpec's from "XMonad.Layout.Groups", so if you want+-- to import both, we suggest to import "XMonad.Layout.Groups"+-- qualified:+--+-- > import qualified XMonad.Layout.Groups as G+--+-- For more information on how to extend your layour hook and key bindings, see+-- "XMonad.Doc.Extending".++-- ** Layout-generic actions+-- #Layout-generic actions#++alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X ()+alt f g = alt2 (G.Modify f) $ windows g++alt2 :: G.GroupsMessage -> X () -> X ()+alt2 m x = do b <- send m+              unless b x++-- | Swap the focused window with the previous one+swapUp :: X ()+swapUp = alt G.swapUp W.swapUp++-- | Swap the focused window with the next one+swapDown :: X ()+swapDown = alt G.swapDown W.swapDown++-- | Swap the focused window with the master window+swapMaster :: X ()+swapMaster = alt G.swapMaster W.swapMaster++-- | If the focused window is floating, focus the next floating+-- window. otherwise, focus the next non-floating one.+focusUp :: X ()+focusUp = ifFloat focusFloatUp focusNonFloatUp++-- | If the focused window is floating, focus the next floating+-- window. otherwise, focus the next non-floating one.+focusDown :: X ()+focusDown = ifFloat focusFloatDown focusNonFloatDown++-- | Move focus to the master window+focusMaster :: X ()+focusMaster = alt G.focusMaster W.shiftMaster++-- | Move focus between the floating and non-floating layers+toggleFocusFloat :: X ()+toggleFocusFloat = ifFloat focusNonFloat focusFloatUp++-- *** Floating layer helpers++getFloats :: X [Window]+getFloats = gets $ M.keys . W.floating . windowset++getWindows :: X [Window]+getWindows = gets $ W.integrate' . W.stack . W.workspace . W.current . windowset++ifFloat :: X () -> X () -> X ()+ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats+                                       if elem w floats then x1 else x2++focusNonFloat :: X ()+focusNonFloat = alt2 G.Refocus helper+    where helper = withFocused $ \w -> do +                     ws <- getWindows+                     floats <- getFloats+                     let (before,  after) = span (/=w) ws+                     case filter (flip notElem floats) $ after ++ before of+                       [] -> return ()+                       w':_ -> focus w'++focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'.+                              -- if you want a non-floating one, 'not'.+            -> ([Window] -> [Window]) -- ^ if you want the next window, 'id'.+                                      -- if you want the previous one, 'reverse'.+            -> X ()+focusHelper f g = withFocused $ \w -> do+                 ws <- getWindows+                 let (before, _:after) = span (/=w) ws+                 let toFocus = g $ after ++ before+                 floats <- getFloats+                 case filter (f . flip elem floats) toFocus of+                   [] -> return ()+                   w':_ -> focus w'+++focusNonFloatUp :: X ()+focusNonFloatUp = alt2 (G.Modify G.focusUp) $ focusHelper not reverse++focusNonFloatDown :: X ()+focusNonFloatDown = alt2 (G.Modify G.focusDown) $ focusHelper not id++focusFloatUp :: X ()+focusFloatUp = focusHelper id reverse+                 +focusFloatDown :: X ()+focusFloatDown = focusHelper id id+++-- ** Groups-specific actions++wrap :: G.ModifySpec -> X ()+wrap = sendMessage . G.Modify++-- | Swap the focused group with the previous one+swapGroupUp :: X ()+swapGroupUp = wrap G.swapGroupUp++-- | Swap the focused group with the next one+swapGroupDown :: X ()+swapGroupDown = wrap G.swapGroupDown++-- | Swap the focused group with the master group+swapGroupMaster :: X ()+swapGroupMaster = wrap G.swapGroupMaster++-- | Move the focus to the previous group+focusGroupUp :: X ()+focusGroupUp = wrap G.focusGroupUp++-- | Move the focus to the next group+focusGroupDown :: X ()+focusGroupDown = wrap G.focusGroupDown++-- | Move the focus to the master group+focusGroupMaster :: X ()+focusGroupMaster = wrap G.focusGroupMaster++-- | Move the focused window to the previous group. The 'Bool' argument+-- determines what will be done if the focused window is in the very first+-- group: Wrap back to the end ('True'), or create a new group before+-- it ('False').+moveToGroupUp :: Bool -> X ()+moveToGroupUp b = wrap (G.moveToGroupUp b)++-- | Move the focused window to the next group. The 'Bool' argument+-- determines what will be done if the focused window is in the very last+-- group: Wrap back to the beginning ('True'), or create a new group after+-- it ('False').+moveToGroupDown :: Bool -> X ()+moveToGroupDown b = wrap (G.moveToGroupDown b)++-- | Move the focused window to a new group before the current one+moveToNewGroupUp :: X ()+moveToNewGroupUp = wrap G.moveToNewGroupUp++-- | Move the focused window to a new group after the current one+moveToNewGroupDown :: X ()+moveToNewGroupDown = wrap G.moveToNewGroupDown++-- | Split the focused group in two at the position of the focused+-- window.+splitGroup :: X ()+splitGroup = wrap G.splitGroup
+ XMonad/Layout/Groups/Wmii.hs view
@@ -0,0 +1,133 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Groups.Wmii+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  stable+-- Portability :  unportable+--+-- A wmii-like layout algorithm.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Groups.Wmii ( -- * Usage+                                   -- $usage+                                   +                                   wmii+                                 , zoomGroupIn+                                 , zoomGroupOut+                                 , zoomGroupReset+                                 , toggleGroupFull+                                 , groupToNextLayout+                                 , groupToFullLayout+                                 , groupToTabbedLayout+                                 , groupToVerticalLayout++                                   -- * Useful re-exports+                                 , shrinkText+                                 , defaultTheme+                                 , module XMonad.Layout.Groups.Helpers ) where++import XMonad hiding ((|||))++import qualified XMonad.Layout.Groups as G+import XMonad.Layout.Groups.Examples+import XMonad.Layout.Groups.Helpers++import XMonad.Layout.Tabbed+import XMonad.Layout.Named+import XMonad.Layout.Renamed+import XMonad.Layout.LayoutCombinators+import XMonad.Layout.MessageControl+import XMonad.Layout.Simplest+++-- $usage+-- This module provides a layout inspired by the one used by the wmii +-- (<http://wmii.suckless.org>) window manager.+-- Windows are arranged into groups in a horizontal row, and each group can lay out +-- its windows+--+--   * by maximizing the focused one+--+--   * by tabbing them (wmii uses a stacked layout, but I'm too lazy to write it)+--+--   * by arranging them in a column.+--+-- As the groups are arranged in a 'ZoomRow', the relative width of each group can be +-- increased or decreased at will. Groups can also be set to use the whole screen +-- whenever they have focus.+--+-- You can use the contents of this module by adding+-- +-- > import XMonad.Layout.Groups.Wmii+--+-- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii' +-- (with a 'Shrinker' and decoration 'Theme' as +-- parameters) to your layout hook, for example:+--+-- > myLayout = wmii shrinkText defaultTheme+--+-- To be able to zoom in and out of groups, change their inner layout, etc.,+-- create key bindings for the relevant actions:+--+-- > ((modMask, xK_f), toggleGroupFull)+--+-- and so on.+--+-- For more information on how to extend your layout hook and key bindings, see+-- "XMonad.Doc.Extending".+--+-- Finally, you will probably want to be able to move focus and windows+-- between groups in a consistent fashion. For this, you should take a look+-- at the "XMonad.Layout.Groups.Helpers" module, whose contents are re-exported+-- by this module.++-- | A layout inspired by wmii+wmii s t = G.group innerLayout zoomRowG+    where column = named "Column" $ Tall 0 (3/100) (1/2)+          tabs = named "Tabs" $ Simplest+          innerLayout = renamed [CutWordsLeft 3] +                        $ addTabs s t+                        $ ignore NextLayout +                        $ ignore (JumpToLayout "") $ unEscape +                           $ column ||| tabs ||| Full++-- | Increase the width of the focused group+zoomGroupIn :: X ()+zoomGroupIn = zoomColumnIn++-- | Decrease the size of the focused group+zoomGroupOut :: X ()+zoomGroupOut = zoomColumnOut++-- | Reset the size of the focused group to the default+zoomGroupReset :: X ()+zoomGroupReset = zoomColumnReset++-- | Toggle whether the currently focused group should be maximized+-- whenever it has focus.+toggleGroupFull :: X ()+toggleGroupFull = toggleGroupFull++-- | Rotate the layouts in the focused group.+groupToNextLayout :: X ()+groupToNextLayout = sendMessage $ escape NextLayout++-- | Switch the focused group to the \"maximized\" layout.+groupToFullLayout :: X ()+groupToFullLayout = sendMessage $ escape $ JumpToLayout "Full"++-- | Switch the focused group to the \"tabbed\" layout.+groupToTabbedLayout :: X ()+groupToTabbedLayout = sendMessage $ escape $ JumpToLayout "Tabs"++-- | Switch the focused group to the \"column\" layout.+groupToVerticalLayout :: X ()+groupToVerticalLayout = sendMessage $ escape $ JumpToLayout "Column"+
XMonad/Layout/IM.hs view
@@ -25,12 +25,11 @@     -- * TODO     -- $todo         Property(..), IM(..), withIM, gridIM,+        AddRoster, ) where  import XMonad import qualified XMonad.StackSet as S-import Data.List-import XMonad.Layout (splitHorizontallyBy) import XMonad.Layout.Grid import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties
+ XMonad/Layout/ImageButtonDecoration.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ImageButtonDecoration+-- Copyright   :  (c) Jan Vornberger 2009+--                    Alejandro Serrano 2010+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  trupill@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- A decoration that includes small image buttons on both ends which invoke+-- various actions when clicked on: Show a window menu (see+-- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window.+--+-- Note: For maximizing and minimizing to actually work, you will need+-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your+-- setup.  See the documentation of those modules for more information.+--+-----------------------------------------------------------------------------++-- This module is mostly derived from "XMonad.Layout.DecorationAddons"+-- and "XMonad.Layout.ButtonDecoration"++module XMonad.Layout.ImageButtonDecoration+    ( -- * Usage:+      -- $usage+      imageButtonDeco+    , defaultThemeWithImageButtons+    , imageTitleBarButtonHandler+    , ImageButtonDecoration+    ) where++import XMonad+import XMonad.Layout.Decoration+import XMonad.Layout.DecorationAddons+import XMonad.Util.Image++import XMonad.Actions.WindowMenu+import XMonad.Layout.Minimize+import XMonad.Layout.Maximize++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ImageButtonDecoration+--+-- Then edit your @layoutHook@ by adding the ImageButtonDecoration to+-- your layout:+--+-- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--++-- The buttons' dimension and placements++buttonSize :: Int+buttonSize = 10++menuButtonOffset :: Int+menuButtonOffset = 4++minimizeButtonOffset :: Int+minimizeButtonOffset = 32++maximizeButtonOffset :: Int+maximizeButtonOffset = 18++closeButtonOffset :: Int+closeButtonOffset = 4+++-- The images in a 0-1 scale to make+-- it easier to visualize++convertToBool' :: [Int] -> [Bool]+convertToBool' = map (\x -> x == 1)++convertToBool :: [[Int]] -> [[Bool]]+convertToBool = map convertToBool'++menuButton' :: [[Int]]+menuButton' = [[1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1]]++menuButton :: [[Bool]]+menuButton = convertToBool menuButton'++miniButton' :: [[Int]]+miniButton' = [[0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [0,0,0,0,0,0,0,0,0,0],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1]]++miniButton :: [[Bool]]+miniButton = convertToBool miniButton'++maxiButton' :: [[Int]]+maxiButton' = [[1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,0,0,0,0,0,0,1,1],+               [1,1,1,1,1,1,1,1,1,1],+               [1,1,1,1,1,1,1,1,1,1]]++maxiButton :: [[Bool]]+maxiButton = convertToBool maxiButton'++closeButton' :: [[Int]]+closeButton' = [[1,1,0,0,0,0,0,0,1,1],+                [1,1,1,0,0,0,0,1,1,1],+                [0,1,1,1,0,0,1,1,1,0],+                [0,0,1,1,1,1,1,1,0,0],+                [0,0,0,1,1,1,1,0,0,0],+                [0,0,0,1,1,1,1,0,0,0],+                [0,0,1,1,1,1,1,1,0,0],+                [0,1,1,1,0,0,1,1,1,0],+                [1,1,1,0,0,0,0,1,1,1],+                [1,1,0,0,0,0,0,0,1,1]]+++closeButton :: [[Bool]]+closeButton = convertToBool closeButton'    ++-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration.+-- It will intercept clicks on the buttons of the decoration and invoke the associated action.+-- To actually see the buttons, you will need to use a theme that includes them.+-- See 'defaultThemeWithImageButtons' below.+imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool+imageTitleBarButtonHandler mainw distFromLeft distFromRight = do+    let action = if (fi distFromLeft >= menuButtonOffset &&+                      fi distFromLeft <= menuButtonOffset + buttonSize)+                        then focus mainw >> windowMenu >> return True+                  else if (fi distFromRight >= closeButtonOffset &&+                           fi distFromRight <= closeButtonOffset + buttonSize)+                              then focus mainw >> kill >> return True+                  else if (fi distFromRight >= maximizeButtonOffset &&+                           fi distFromRight <= maximizeButtonOffset + buttonSize)+                             then focus mainw >> sendMessage (maximizeRestore mainw) >> return True+                  else if (fi distFromRight >= minimizeButtonOffset &&+                           fi distFromRight <= minimizeButtonOffset + buttonSize)+                             then focus mainw >> minimizeWindow mainw >> return True+                  else return False+    action++defaultThemeWithImageButtons :: Theme+defaultThemeWithImageButtons = defaultTheme {+                                windowTitleIcons = [ (menuButton, CenterLeft 3),+                                                     (closeButton, CenterRight 3),+                                                     (maxiButton, CenterRight 18),+                                                     (miniButton, CenterRight 33) ]+                               }++imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme+                   -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a+imageButtonDeco s c = decoration s c $ NFD True++data ImageButtonDecoration a = NFD Bool deriving (Show, Read)++instance Eq a => DecorationStyle ImageButtonDecoration a where+    describeDeco _ = "ImageButtonDeco"+    decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR+    decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()
XMonad/Layout/IndependentScreens.hs view
@@ -19,18 +19,23 @@     VirtualWorkspace, PhysicalWorkspace,     workspaces',     withScreens, onCurrentScreen,+    marshallPP,     countScreens,-    marshall, unmarshall+    -- * Converting between virtual and physical workspaces+    -- $converting+    marshall, unmarshall, unmarshallS, unmarshallW,+    marshallWindowSpace, unmarshallWindowSpace ) where  -- for the screen stuff+import Control.Applicative((<*), liftA2) import Control.Arrow hiding ((|||)) import Control.Monad-import Control.Monad.Instances import Data.List import Graphics.X11.Xinerama import XMonad-import XMonad.StackSet hiding (workspaces)+import XMonad.StackSet hiding (filter, workspaces)+import XMonad.Hooks.DynamicLog  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -48,15 +53,19 @@ -- to specific workspace names.  In the default configuration, only -- the keybindings for changing workspace do this: ----- > [((m .|. modm, k), windows $ f i)--- >     | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]--- >     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+-- > keyBindings conf = let m = modMask conf in fromList $+-- >     {- lots of other keybindings -}+-- >     [((m .|. modm, k), windows $ f i)+-- >         | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]+-- >         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] -- -- This should change to ----- > [((m .|. modm, k), windows $ onCurrentScreen f i)--- >     | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]--- >     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+-- > keyBindings conf = let m = modMask conf in fromList $+-- >     {- lots of other keybindings -}+-- >     [((m .|. modm, k), windows $ onCurrentScreen f i)+-- >         | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]+-- >         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] -- -- In particular, the analogue of @XMonad.workspaces@ is -- @workspaces'@, and you can use @onCurrentScreen@ to convert functions@@ -67,17 +76,24 @@ type VirtualWorkspace  = WorkspaceId type PhysicalWorkspace = WorkspaceId +-- $converting+-- You shouldn't need to use the functions below very much. They are used+-- internally. However, in some cases, they may be useful, and so are exported+-- just in case. In general, the \"marshall\" functions convert the convenient+-- form (like \"web\") you would like to use in your configuration file to the+-- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly,+-- the \"unmarshall\" functions convert in the other direction.+ marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace marshall (S sc) vws = show sc ++ '_':vws -unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)-unmarshall = ((S . read) *** drop 1) . break (=='_')+unmarshall  :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)+unmarshallS :: PhysicalWorkspace -> ScreenId+unmarshallW :: PhysicalWorkspace -> VirtualWorkspace --- ^ You shouldn't need to use @marshall@ and @unmarshall@ very much.--- They simply convert between the physical and virtual worlds.  For--- example, you might want to use them as part of a status bar--- configuration.  The function @snd . unmarshall@ would discard the--- screen information from an otherwise unsightly workspace name.+unmarshall  = ((S . read) *** drop 1) . break (=='_')+unmarshallS = fst . unmarshall+unmarshallW = snd . unmarshall  workspaces' :: XConfig l -> [VirtualWorkspace] workspaces' = nub . map (snd . unmarshall) . workspaces@@ -101,4 +117,39 @@ -- >     } -- countScreens :: (MonadIO m, Integral i) => m i-countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo+countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay++-- | This turns a naive pretty-printer into one that is aware of the+-- independent screens. That is, you can write your pretty printer to behave+-- the way you want on virtual workspaces; this function will convert that+-- pretty-printer into one that first filters out physical workspaces on other+-- screens, then converts all the physical workspaces on this screen to their+-- virtual names.+--+-- For example, if you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write+--+-- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle+-- >           in log 0 hLeft >> log 1 hRight+marshallPP :: ScreenId -> PP -> PP+marshallPP s pp = pp {+    ppCurrent           = ppCurrent         pp . snd . unmarshall,+    ppVisible           = ppVisible         pp . snd . unmarshall,+    ppHidden            = ppHidden          pp . snd . unmarshall,+    ppHiddenNoWindows   = ppHiddenNoWindows pp . snd . unmarshall,+    ppUrgent            = ppUrgent          pp . snd . unmarshall,+    ppSort              = fmap (marshallSort s) (ppSort pp)+    }++marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace])+marshallSort s vSort = pScreens . vSort . vScreens where+    onScreen ws = unmarshallS (tag ws) == s+    vScreens    = map unmarshallWindowSpace . filter onScreen+    pScreens    = map (marshallWindowSpace s)++-- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'.+marshallWindowSpace   :: ScreenId -> WindowSpace -> WindowSpace+-- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'.+unmarshallWindowSpace :: WindowSpace -> WindowSpace++marshallWindowSpace s ws = ws { tag = marshall s  (tag ws) }+unmarshallWindowSpace ws = ws { tag = unmarshallW (tag ws) }
XMonad/Layout/LayoutBuilder.hs view
@@ -24,15 +24,13 @@   SubMeasure (..),   SubBox (..),   absBox,-  relBox+  relBox,+  LayoutN, ) where  import XMonad-import XMonad.Layout import qualified XMonad.StackSet as W-import Graphics.X11.Xlib import Data.Maybe (isJust)-import Control.Monad  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+ XMonad/Layout/LayoutBuilderP.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.LayoutBuilderP+-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout combinator that sends windows matching given predicate to one rectangle+-- and the rest to another.+--+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutBuilderP (+  LayoutP (..),+  layoutP, layoutAll,+  B.relBox, B.absBox,+  -- * Overloading ways to select windows+  -- $selectWin+  Predicate (..), Proxy(..),+  ) where++import Control.Monad+import Data.Maybe (isJust)++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Util.WindowProperties++import qualified XMonad.Layout.LayoutBuilder as B++-- $selectWin+--+-- 'Predicate' exists because layouts are required to be serializable, and+-- "XMonad.Util.WindowProperties" is not sufficient (for example it does not+-- allow using regular expressions).+--+-- compare "XMonad.Util.Invisible"++-- | Type class for predicates. This enables us to manage not only Windows, +-- but any objects, for which instance Predicate is defined.+--+-- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras+class Predicate p w where+  alwaysTrue :: Proxy w -> p         -- ^ A predicate that is always True.+  checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate++-- | Contains no actual data, but is needed to help select the correct instance+-- of 'Predicate'+data Proxy a = Proxy++-- | Data type for our layout.+data LayoutP p l1 l2 a =+    LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))+    deriving (Show,Read)++-- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.+--   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.+layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>+       p+    -> B.SubBox                       -- ^ The box to place the windows in+    -> Maybe B.SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left+    -> l1 a                         -- ^ The layout to use in the specified area+    -> LayoutP p l2 l3 a              -- ^ Where to send the remaining windows+    -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout+layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next)++-- | Use the specified layout in the described area for all remaining windows.+layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>+       B.SubBox             -- ^ The box to place the windows in+    -> l1 a               -- ^ The layout to use in the specified area+    -> LayoutP p l1 Full a  -- ^ The resulting layout+layoutAll box sub =+  let a = alwaysTrue (Proxy :: Proxy a)+  in  LayoutP Nothing Nothing a box Nothing sub Nothing++instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>+    LayoutClass (LayoutP p l1 l2) w where++        -- | Update window locations.+        runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect+            = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf+                 let selBox = if isJust nextf'+                                then box+                                else maybe box id mbox++                 (sublist,sub') <- handle sub subs $ calcArea selBox rect++                 (nextlist,next') <- case next of Nothing -> return ([],Nothing)+                                                  Just n -> do (res,l) <- handle n nexts rect+                                                               return (res,Just l)++                 return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' )+              where+                  handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r+                                     l' <- return $ maybe l id ml+                                     return (res,l')++        -- |  Propagate messages.+        handleMessage l m+            | Just (IncMasterN _) <- fromMessage m = sendFocus l m+            | Just (Shrink) <- fromMessage m = sendFocus l m+            | Just (Expand) <- fromMessage m = sendFocus l m+            | otherwise = sendBoth l m++        -- |  Descriptive name for layout.+        description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next+        description (LayoutP _ _ _ _ _ sub Nothing)     = "layoutP "++ description sub+++sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)+        => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))+sendSub (LayoutP subf nextf prop box mbox sub next) m =+    do sub' <- handleMessage sub m+       return $ if isJust sub'+                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next+                else Nothing++sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)+         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))+sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m+sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m =+    do sub' <- handleMessage sub m+       next' <- handleMessage next m+       return $ if isJust sub' || isJust next'+                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next')+                else Nothing++sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)+         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))+sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing+sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m =+    do next' <- handleMessage next m+       return $ if isJust next'+                then Just $ LayoutP subf nextf prop box mbox sub next'+                else Nothing++sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)+          => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))+sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf+                                              if foc then sendSub l m+                                                     else sendNext l m++isFocus :: (Show a) => Maybe a -> X Bool+isFocus Nothing = return False+isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset+                      return $ maybe False (\s -> show w == (show $ W.focus s)) ms+++-- | Split given list of objects (i.e. windows) using predicate.+splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])+splitBy prop ws = foldM step ([], []) ws+  where+    step (good, bad) w = do+      ok <- checkPredicate prop w+      return $ if ok+                then (w:good, bad)+                else (good,   w:bad)++splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)+splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing)+splitStack (Just s) prop subf nextf = do+    let ws = W.integrate s+    (good, other) <- splitBy prop ws+    let subf'  = foc good subf+        nextf' = foc other nextf+    return ( differentiate' subf' good+           , differentiate' nextf' other+           , subf'+           , nextf'+           )+  where+    foc [] _ = Nothing+    foc l f = if W.focus s `elem` l+              then Just $ W.focus s+              else if maybe False (`elem` l) f+                   then f+                   else Just $ head l++calcArea :: B.SubBox -> Rectangle -> Rectangle+calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'+    where+        xpos' = calc False xpos $ rect_width rect+        ypos' = calc False ypos $ rect_height rect+        width' = calc True width $ rect_width rect - xpos'+        height' = calc True height $ rect_height rect - ypos'++        calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $+            case val of B.Rel v -> floor $ v * fromIntegral tot+                        B.Abs v -> if v<0 || (zneg && v==0)+                                 then (fromIntegral tot)+v+                                 else v++differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)+differentiate' _ [] = Nothing+differentiate' Nothing w = W.differentiate w+differentiate' (Just f) w+    | f `elem` w = Just $ W.Stack { W.focus = f+                                  , W.up    = reverse $ takeWhile (/=f) w+                                  , W.down  = tail $ dropWhile (/=f) w+                                  }+    | otherwise = W.differentiate w++instance Predicate Property Window where+  alwaysTrue _ = Const True+  checkPredicate = hasProperty+
XMonad/Layout/LayoutCombinators.hs view
@@ -47,6 +47,9 @@       -- $jtl     , (|||)     , JumpToLayout(..)++      -- * Types+    , NewSelect     ) where  import Data.Maybe ( isJust, isNothing )@@ -76,6 +79,7 @@ -- > import XMonad hiding ( (|||) ) -- > import XMonad.Layout.LayoutCombinators --+-- If you import XMonad.Layout, you will need to hide it from there as well. -- Then bind some keys to a 'JumpToLayout' message: -- -- >   , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")  -- jump directly to the Full layout@@ -179,9 +183,16 @@ -- The standard xmonad core exports a layout combinator @|||@ which -- represents layout choice.  This is a reimplementation which also -- provides the capability to support 'JumpToLayout' messages.  To use--- it, be sure to hide the import of @|||@ from the xmonad core:+-- it, be sure to hide the import of @|||@ from the xmonad core; if either of+-- these two lines appear in your configuration: --+-- > import XMonad+-- > import XMonad.Layout+--+-- replace them with these instead, respectively:+-- -- > import XMonad hiding ( (|||) )+-- > import XMonad.Layout hiding ( (|||) ) -- -- The argument given to a 'JumpToLayout' message should be the -- @description@ of the layout to be selected.  If you use@@ -213,7 +224,7 @@  data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show ) --- | +-- | data JumpToLayout = JumpToLayout String -- ^ A message to jump to a particular layout                                         -- , specified by its description string..                   | NextLayoutNoWrap
XMonad/Layout/LayoutHints.hs view
@@ -20,10 +20,15 @@     , layoutHintsWithPlacement     , layoutHintsToCenter     , LayoutHints+    , LayoutHintsToCenter+    , hintsEventHook     )  where  import XMonad(LayoutClass(runLayout), mkAdjust, Window,-              Dimension, Position, Rectangle(Rectangle),D)+              Dimension, Position, Rectangle(Rectangle), D,+              X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,+              (<&&>), io, applySizeHints, whenX, isClient, withDisplay,+              getWindowAttributes, getWMNormalHints, WindowAttributes(..)) import qualified XMonad.StackSet as W  import XMonad.Layout.Decoration(isInStack)@@ -32,9 +37,10 @@ import XMonad.Util.Types(Direction2D(..)) import Control.Applicative((<$>)) import Control.Arrow(Arrow((***), first, second))-import Control.Monad(Monad(return), mapM, join)+import Control.Monad(join) import Data.Function(on) import Data.List(sortBy)+import Data.Monoid(All(..))  import Data.Set (Set) import qualified Data.Set as Set@@ -62,6 +68,14 @@ -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- To make XMonad reflect changes in window hints immediately, add+-- 'hintsEventHook' to your 'handleEventHook'.+--+-- > myHandleEventHook = hintsEventHook <+> ...+-- >+-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook+-- >                             , ... }  layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a layoutHints = ModifiedLayout (LayoutHints (0, 0))@@ -235,3 +249,19 @@     = (cf $ cx - cwx, cf $ cy - cwy)     where (cx,cy) = center root           (cwx,cwy) = center assigned++-- | Event hook that refreshes the layout whenever a window changes its hints.+hintsEventHook :: Event -> X All+hintsEventHook (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w })+    | t == propertyNotify && a == wM_NORMAL_HINTS = do+        whenX (isClient w <&&> hintsMismatch w) $ refresh+        return (All True)+hintsEventHook _ = return (All True)++-- | True if the window's current size does not satisfy its size hints.+hintsMismatch :: Window -> X Bool+hintsMismatch w = withDisplay $ \d -> io $ do+    wa <- getWindowAttributes d w+    sh <- getWMNormalHints d w+    let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)+    return $ dim /= applySizeHints 0 sh dim
XMonad/Layout/LayoutModifier.hs view
@@ -29,6 +29,8 @@     LayoutModifier(..), ModifiedLayout(..)     ) where +import Control.Monad+ import XMonad import XMonad.StackSet ( Stack, Workspace (..) ) @@ -106,6 +108,22 @@                  -> X ([(a, Rectangle)], Maybe (l a))     modifyLayout _ w r = runLayout w r +    -- | Similar to 'modifyLayout', but this function also allows you+    -- update the state of your layout modifier(the second value in the+    -- outer tuple).+    --+    -- If both 'modifyLayoutWithUpdate' and 'redoLayout' return a+    -- modified state of the layout modifier, 'redoLayout' takes+    -- precedence. If this function returns a modified state, this+    -- state will internally be used in the subsequent call to+    -- 'redoLayout' as well.+    modifyLayoutWithUpdate :: (LayoutClass l a) =>+                              m a+                           -> Workspace WorkspaceId (l a) a+                           -> Rectangle+                           -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))+    modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r+     -- | 'handleMess' allows you to spy on messages to the underlying     --   layout, in order to have an effect in the X monad, or alter     --   the layout modifier state in some way (by returning @Just@@ -234,9 +252,9 @@ --   semantics of a 'LayoutModifier' applied to an underlying layout. instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where     runLayout (Workspace i (ModifiedLayout m l) ms) r =-        do (ws, ml')  <- modifyLayout m (Workspace i l ms) r-           (ws', mm') <- redoLayout m r ms ws-           let ml'' = case mm' of+        do ((ws, ml'),mm')  <- modifyLayoutWithUpdate m (Workspace i l ms) r+           (ws', mm'') <- redoLayout (maybe m id mm') r ms ws+           let ml'' = case mm'' `mplus` mm' of                         Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'                         Nothing -> ModifiedLayout m `fmap` ml'            return (ws', ml'')
XMonad/Layout/LayoutScreens.hs view
@@ -16,7 +16,8 @@ module XMonad.Layout.LayoutScreens (                                     -- * Usage                                     -- $usage-                                    layoutScreens, fixedLayout+                                    layoutScreens, layoutSplitScreen, fixedLayout,+                                    FixedLayout,                                    ) where  import XMonad@@ -55,6 +56,7 @@ -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". +-- | Modify all screens. layoutScreens :: LayoutClass l Int => Int -> l Int -> X () layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens." layoutScreens nscr l =@@ -65,6 +67,20 @@                s:ss = map snd wss            in  ws { W.current = W.Screen x 0 (SD s)                   , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss+                  , W.hidden  = ys }++-- | Modify current screen.+layoutSplitScreen :: LayoutClass l Int => Int -> l Int -> X ()+layoutSplitScreen nscr _ | nscr < 1 = trace $ "Can't layoutSplitScreen with only " ++ show nscr ++ " screens."+layoutSplitScreen nscr l =+    do rect <- gets $ screenRect . W.screenDetail . W.current . windowset+       (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect+       windows $ \ws@(W.StackSet { W.current = c, W.visible = vs, W.hidden = hs }) ->+           let (x:xs, ys) = splitAt nscr $ W.workspace c : hs+               s:ss = map snd wss+           in  ws { W.current = W.Screen x (W.screen c) (SD s)+                  , W.visible = (zipWith3 W.Screen xs [(W.screen c+1) ..] $ map SD ss) +++                                map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs                   , W.hidden  = ys }  getWindowRectangle :: Window -> X Rectangle
XMonad/Layout/LimitWindows.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.LimitWindows@@ -23,13 +23,20 @@     limitWindows,limitSlice,limitSelect,      -- * Change the number of windows-    increaseLimit,decreaseLimit,setLimit+    increaseLimit,decreaseLimit,setLimit,++#ifdef TESTING+    -- * For tests+    select,update,Selection(..),updateAndSelect,+#endif++    -- * Types+    LimitWindows, Selection,     ) where  import XMonad.Layout.LayoutModifier import XMonad import qualified XMonad.StackSet as W-import XMonad.Layout (IncMasterN (..)) import Control.Monad((<=<),guard) import Control.Applicative((<$>)) import Data.Maybe(fromJust)@@ -139,7 +146,7 @@         downs = W.down stk         ups = reverse $ W.up stk         lups = length ups-    + updateStart :: Selection l -> W.Stack a -> Int updateStart s stk     | lups < nMaster s  -- the focussed window is in the master pane
XMonad/Layout/MagicFocus.hs view
@@ -20,7 +20,8 @@      promoteWarp,      promoteWarp',      followOnlyIf,-     disableFollowOnWS+     disableFollowOnWS,+     MagicFocus,     ) where  import XMonad
XMonad/Layout/Magnifier.hs view
@@ -26,12 +26,14 @@       magnifiercz,       magnifiercz',       maximizeVertical,-      MagnifyMsg (..)+      MagnifyMsg (..),+      Magnifier,     ) where  import XMonad import XMonad.StackSet import XMonad.Layout.LayoutModifier+import XMonad.Util.XUtils  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -159,6 +161,3 @@           y' = max sy (y - (max 0 (y + fi h - sy - fi sh)))           w' = min sw w           h' = min sh h--fi :: (Num b, Integral a) => a -> b-fi = fromIntegral
XMonad/Layout/Master.hs view
@@ -17,7 +17,9 @@     -- * Usage     -- $usage -    mastered+    mastered,+    multimastered,+    AddMaster, ) where  import XMonad@@ -34,6 +36,10 @@ -- -- > mastered (1/100) (1/2) $ Grid --+-- Or if you want multiple (here two) master windows from the beginning:+--+-- > multimastered 2 (1/100) (1/2) $ Grid+-- -- This will use the left half of your screen for a master window and let -- Grid manage the right half. --@@ -45,42 +51,68 @@  -- | Data type for LayoutModifier which converts given layout to a mastered -- layout-data AddMaster a = AddMaster Rational Rational deriving (Show, Read)+data AddMaster a = AddMaster Int Rational Rational deriving (Show, Read)  -- | Modifier which converts given layout to a mastered one+multimastered :: (LayoutClass l a) =>+       Int -- ^ @k@, number of master windows+    -> Rational -- ^ @delta@, the ratio of the screen to resize by+    -> Rational -- ^ @frac@, what portion of the screen to use for the master window+    -> l a      -- ^ the layout to be modified+    -> ModifiedLayout AddMaster l a+multimastered k delta frac = ModifiedLayout $ AddMaster k delta frac+ mastered :: (LayoutClass l a) =>        Rational -- ^ @delta@, the ratio of the screen to resize by     -> Rational -- ^ @frac@, what portion of the screen to use for the master window     -> l a      -- ^ the layout to be modified     -> ModifiedLayout AddMaster l a-mastered delta frac = ModifiedLayout $ AddMaster delta frac+mastered delta frac = multimastered 1 delta frac  instance LayoutModifier AddMaster Window where-    modifyLayout (AddMaster delta frac) = applyMaster delta frac+    modifyLayout (AddMaster k delta frac) = applyMaster k delta frac     modifierDescription _               = "Mastered" -    pureMess (AddMaster delta frac) m-        | Just Shrink <- fromMessage m = Just $ AddMaster delta (frac-delta)-        | Just Expand <- fromMessage m = Just $ AddMaster delta (frac+delta)+    pureMess (AddMaster k delta frac) m+        | Just Shrink <- fromMessage m = Just $ AddMaster k delta (frac-delta)+        | Just Expand <- fromMessage m = Just $ AddMaster k delta (frac+delta)+        | Just (IncMasterN d) <- fromMessage m = Just $ AddMaster (max 1 (k+d)) delta frac      pureMess _ _ = Nothing  -- | Internal function for adding a master window and let the modified -- layout handle the rest of the windows applyMaster :: (LayoutClass l Window) =>-                  Rational+                  Int                -> Rational+               -> Rational                -> S.Workspace WorkspaceId (l Window) Window                -> Rectangle                -> X ([(Window, Rectangle)], Maybe (l Window))-applyMaster _ frac wksp rect = do+applyMaster k _ frac wksp rect = do     let st= S.stack wksp     let ws = S.integrate' $ st-    if length ws > 1 then do-        let m = head ws-        let (mr, sr) = splitHorizontallyBy frac rect-        let nst = st>>= S.filter (m/=)-        wrs <- runLayout (wksp {S.stack = nst}) sr-        return ((m, mr) : fst wrs, snd wrs)-+    let n = length ws+    if n > 1 then do+        if(n<=k) then+             return ((divideCol rect ws), Nothing)+             else do+             let m = take k ws+             let (mr, sr) = splitHorizontallyBy frac rect+             let nst = st>>= S.filter (\w -> not (w `elem` m))+             wrs <- runLayout (wksp {S.stack = nst}) sr+             return ((divideCol mr m) ++ (fst wrs), snd wrs)         else runLayout wksp rect++-- | Shift rectangle down+shiftD :: Position -> Rectangle -> Rectangle+shiftD s (Rectangle x y w h) = Rectangle x (y+s) w h++-- | Divide rectangle between windows+divideCol :: Rectangle -> [a] -> [(a, Rectangle)]+divideCol (Rectangle x y w h) ws = zip ws rects+    where n = length ws+          oneH = fromIntegral h `div` n+          oneRect = Rectangle x y w (fromIntegral oneH)+          rects = take n $ iterate (shiftD (fromIntegral oneH)) oneRect+
XMonad/Layout/Maximize.hs view
@@ -19,7 +19,8 @@         -- * Usage         -- $usage         maximize,-        maximizeRestore+        maximizeRestore,+        Maximize, MaximizeRestore,     ) where  import XMonad@@ -64,12 +65,14 @@     pureModifier (Maximize (Just target)) rect (Just (S.Stack focused _ _)) wrs =             if focused == target                 then (maxed ++ rest, Nothing)-                else (rest ++ maxed, Nothing)+                else (rest ++ maxed, lay)         where             (toMax, rest) = partition (\(w, _) -> w == target) wrs             maxed = map (\(w, _) -> (w, maxRect)) toMax             maxRect = Rectangle (rect_x rect + 25) (rect_y rect + 25)                 (rect_width rect - 50) (rect_height rect - 50)+            lay | null maxed = Just (Maximize Nothing)+                | otherwise  = Nothing     pureModifier _ _ _ wrs = (wrs, Nothing)      pureMess (Maximize mw) m = case fromMessage m of
XMonad/Layout/MessageControl.hs view
@@ -6,7 +6,7 @@ -- Copyright   :  (c) 2008 Quentin Moser -- License     :  BSD3 ----- Maintainer  :  <quentin.moser@unifr.ch>+-- Maintainer  :  orphaned -- Stability   :  unstable -- Portability :  unportable --@@ -41,7 +41,7 @@ -- > import XMonad.Layout.MessageEscape -- -- Then, if you use a modified layout where the modifier would intercept--- a message, but you'd want to be able to send it to the inner layout +-- a message, but you'd want to be able to send it to the inner layout -- only, add the 'unEscape' modifier to the inner layout like so: -- -- > import XMonad.Layout.Master (mastered)@@ -60,7 +60,7 @@ -- layout, use the 'ignore' modifier: -- -- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $--- >                       unEscape $ mastered 0.01 0.5 +-- >                       unEscape $ mastered 0.01 0.5 -- >                         $ Full ||| simpleTabbed) -- -- /IMPORTANT NOTE:/ The standard '(|||)' operator from "XMonad.Layout"@@ -121,6 +121,6 @@ -- | Applies the Ignore layout modifier to a layout, blocking -- all messages of the same type as the one passed as its first argument. -ignore :: (Message m, LayoutClass l w) +ignore :: (Message m, LayoutClass l w)           => m -> l w -> (Ignore m l w) ignore _ l = I l
XMonad/Layout/Minimize.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.Minimize--- Copyright   :  (c) Jan Vornberger 2009+-- Copyright   :  (c) Jan Vornberger 2009, Alejandro Serrano 2010 -- License     :  BSD3-style (see LICENSE) -- -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de@@ -18,14 +18,20 @@         -- * Usage         -- $usage         minimize,-        MinimizeMsg(..)+        minimizeWindow,+        MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin),+        Minimize,     ) where  import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Layout.BoringWindows as BW+import XMonad.Util.WindowProperties (getProp32) import Data.List+import qualified Data.Map as M+import Data.Maybe+import Foreign.C.Types (CLong)  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -43,7 +49,7 @@ -- -- In the key-bindings, do something like: ----- >        , ((modm,               xK_m     ), withFocused (\f -> sendMessage (MinimizeWin f)))+-- >        , ((modm,               xK_m     ), withFocused minimizeWindow) -- >        , ((modm .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin) -- -- The first action will minimize the focused window, while the second one will restore@@ -54,15 +60,16 @@ -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- The module is designed to work together with "XMonad.Layout.BoringWindows" so--- that minimized windows will be skipped when switching the focus window with--- the keyboard.  Use the 'BW.boringAuto' function.+-- that minimized windows will be skipped over when switching the focused window with+-- the keyboard. Include 'BW.boringWindows' in your layout hook and see the+-- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings. ----- Also see "XMonad.Hooks.RestoreMinimized" if you want to be able to restore--- minimized windows from your taskbar.+-- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize+-- and restore windows from your taskbar. -data Minimize a = Minimize [Window] deriving ( Read, Show )+data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show ) minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window-minimize = ModifiedLayout $ Minimize []+minimize = ModifiedLayout $ Minimize [] M.empty  data MinimizeMsg = MinimizeWin Window                     | RestoreMinimizedWin Window@@ -70,25 +77,68 @@                     deriving (Typeable, Eq) instance Message MinimizeMsg +minimizeWindow :: Window -> X ()+minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown++setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()+setMinimizedState win st f = do+    setWMState win st+    withDisplay $ \dpy -> do+        state <- getAtom "_NET_WM_STATE"+        mini <- getAtom "_NET_WM_STATE_HIDDEN"+        wstate <- fromMaybe [] `fmap` getProp32 state win+        let ptype = 4 -- The atom property type for changeProperty+            fi_mini = fromIntegral mini+        io $ changeProperty32 dpy win state ptype propModeReplace (f fi_mini wstate)++setMinimized :: Window -> X ()+setMinimized win = setMinimizedState win iconicState (:)++setNotMinimized :: Window -> X ()+setNotMinimized win = setMinimizedState win normalState delete+ instance LayoutModifier Minimize Window where-    modifierDescription (Minimize _) = "Minimize"+    modifierDescription _ = "Minimize" -    modifyLayout (Minimize minimized) wksp rect = do+    modifyLayout (Minimize minimized _) wksp rect = do         let stack = W.stack wksp             filtStack = stack >>=W.filter (\w -> not (w `elem` minimized))         runLayout (wksp {W.stack = filtStack}) rect -    handleMess (Minimize minimized) m = case fromMessage m of-        Just (MinimizeWin w)-          | not (w `elem` minimized) -> do-                BW.focusDown-                return $ Just $ Minimize (w:minimized)-          | otherwise               -> return Nothing-        Just (RestoreMinimizedWin w) ->-            return $ Just $ Minimize (minimized \\ [w])-        Just (RestoreNextMinimizedWin)-          | not (null minimized)    -> do-                focus (head minimized)-                return $ Just $ Minimize (tail minimized)-          | otherwise               -> return Nothing-        _ -> return Nothing+    handleMess (Minimize minimized unfloated) m+        | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do+                setMinimized w+                ws <- gets windowset+                case M.lookup w (W.floating ws) of+                  Nothing -> return $ Just $ Minimize (w:minimized) unfloated+                  Just r -> do+                    modify (\s -> s { windowset = W.sink w ws})+                    return $ Just $ Minimize (w:minimized) (M.insert w r unfloated)+        | Just (RestoreMinimizedWin w) <- fromMessage m = do+            setNotMinimized w+            case M.lookup w unfloated of+              Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated+              Just r -> do+                ws <- gets windowset+                modify (\s -> s { windowset = W.float w r ws})+                return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated)+        | Just RestoreNextMinimizedWin <- fromMessage m = do+          ws <- gets windowset+          if not (null minimized)+            then case M.lookup (head minimized) unfloated of+              Nothing -> do+                let w = head minimized+                setNotMinimized w+                modify (\s -> s { windowset = W.focusWindow w ws})+                return $ Just $ Minimize (tail minimized) unfloated+              Just r -> do+                let w = head minimized+                setNotMinimized w+                modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws})+                return $ Just $ Minimize (tail minimized) (M.delete w unfloated)+            else return Nothing+        | Just BW.UpdateBoring <- fromMessage m = do+            ws <- gets (W.workspace . W.current . windowset)+            flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized+            return Nothing+        | otherwise = return Nothing
XMonad/Layout/Mosaic.hs view
@@ -21,6 +21,8 @@     ,mosaic     ,changeMaster     ,changeFocused++    ,Mosaic     )     where
XMonad/Layout/MosaicAlt.hs view
@@ -25,6 +25,9 @@         , tallWindowAlt         , wideWindowAlt         , resetAlt++        , Params, Param+        , HandleWindowAlt     ) where  import XMonad
XMonad/Layout/MouseResizableTile.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ---------------------------------------------------------------------------- -- | -- Module      :  XMonad.Layout.MouseResizableTile@@ -19,12 +19,24 @@                                     -- $usage                                     mouseResizableTile,                                     mouseResizableTileMirrored,-                                    MRTMessage (ShrinkSlave, ExpandSlave)+                                    MRTMessage (ShrinkSlave, ExpandSlave),++                                    -- * Parameters+                                    -- $mrtParameters+                                    nmaster,+                                    masterFrac,+                                    slaveFrac,+                                    fracIncrement,+                                    isMirrored,+                                    draggerType,+                                    DraggerType (..),+                                    MouseResizableTile,                                    ) where  import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import qualified XMonad.StackSet as W import XMonad.Util.XUtils+import Control.Applicative((<$>))  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -38,11 +50,7 @@ -- > myLayout = mouseResizableTile ||| etc.. -- > main = xmonad defaultConfig { layoutHook = myLayout } ----- or ----- > myLayout = mouseResizableTileMirrored ||| etc..--- > main = xmonad defaultConfig { layoutHook = myLayout }--- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook"@@ -56,6 +64,17 @@ -- -- "XMonad.Doc.Extending#Editing_key_bindings". +-- $mrtParameters+-- The following functions are also labels for updating the @data@ (whose+-- representation is otherwise hidden) produced by 'mouseResizableTile'.+--+-- Usage:+--+-- > myLayout = mouseResizableTile{ masterFrac = 0.7,+-- >                                fracIncrement = 0.05,+-- >                                draggerType = BordersDragger }+-- >                |||  etc..+ data MRTMessage = SetMasterFraction Rational                     | SetLeftSlaveFraction Int Rational                     | SetRightSlaveFraction Int Rational@@ -71,50 +90,68 @@ type DraggerWithRect = (Rectangle, Glyph, DraggerInfo) type DraggerWithWin = (Window, DraggerInfo) +-- | Specifies the size of the clickable area between windows.+data DraggerType = FixedDragger+                    { gapWidth :: Dimension -- ^ width of a gap between windows+                    , draggerWidth :: Dimension -- ^ width of the dragger itself+                                                -- (will overlap windows if greater than gap)+                    }+                    | BordersDragger -- ^ no gaps, draggers overlap window borders+                    deriving (Show, Read)+type DraggerGeometry = (Position, Dimension, Position, Dimension)+ data MouseResizableTile a = MRT { nmaster :: Int,+                                    -- ^ Get/set the number of windows in+                                    -- master pane (default: 1).                                     masterFrac :: Rational,+                                    -- ^ Get/set the proportion of screen+                                    -- occupied by master pane (default: 1/2).+                                    slaveFrac :: Rational,+                                    -- ^ Get/set the proportion of remaining+                                    -- space in a column occupied by a slave+                                    -- window (default: 1/2).+                                    fracIncrement :: Rational,+                                    -- ^ Get/set the increment used when+                                    -- modifying masterFrac/slaveFrac by the+                                    -- Shrink, Expand, etc. messages (default:+                                    -- 3/100).                                     leftFracs :: [Rational],                                     rightFracs :: [Rational],                                     draggers :: [DraggerWithWin],+                                    draggerType :: DraggerType,+                                    -- ^ Get/set dragger and gap dimensions+                                    -- (default: FixedDragger 6 6).                                     focusPos :: Int,                                     numWindows :: Int,                                     isMirrored :: Bool+                                    -- ^ Get/set whether the layout is+                                    -- mirrored (default: False).                                 } deriving (Show, Read) -mrtFraction :: Rational-mrtFraction = 0.5-mrtDelta :: Rational-mrtDelta = 0.03-mrtDraggerOffset :: Position-mrtDraggerOffset = 3-mrtDraggerSize :: Dimension-mrtDraggerSize = 6-mrtHDoubleArrow :: Glyph-mrtHDoubleArrow = 108-mrtVDoubleArrow :: Glyph-mrtVDoubleArrow = 116- mouseResizableTile :: MouseResizableTile a-mouseResizableTile = MRT 1 mrtFraction [] [] [] 0 0 False+mouseResizableTile = MRT 1 0.5 0.5 0.03 [] [] [] (FixedDragger 6 6) 0 0 False +-- | May be removed in favor of @mouseResizableTile { isMirrored = True }@ mouseResizableTileMirrored :: MouseResizableTile a-mouseResizableTileMirrored= MRT 1 mrtFraction [] [] [] 0 0 True+mouseResizableTileMirrored = mouseResizableTile { isMirrored = True } -instance LayoutClass MouseResizableTile a where-    doLayout state sr (W.Stack w l r) =+instance LayoutClass MouseResizableTile Window where+    doLayout state sr (W.Stack w l r) = do+        drg <- draggerGeometry $ draggerType state         let wins = reverse l ++ w : r             num = length wins             sr' = mirrorAdjust sr (mirrorRect sr)             (rects, preparedDraggers) = tile (nmaster state) (masterFrac state)-                                            (leftFracs state ++ repeat mrtFraction)-                                            (rightFracs state ++ repeat mrtFraction) sr' num+                                            (leftFracs state ++ repeat (slaveFrac state))+                                            (rightFracs state ++ repeat (slaveFrac state)) sr' num drg             rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects-        in do-            mapM_ deleteDragger $ draggers state-            newDraggers <- mapM (createDragger sr . adjustForMirror (isMirrored state)) preparedDraggers-            return (zip wins rects', Just $ state { draggers = newDraggers,-                                                    focusPos = length l,-                                                    numWindows = length wins })+        mapM_ deleteDragger $ draggers state+        (draggerWrs, newDraggers) <- unzip <$> mapM+                                        (createDragger sr . adjustForMirror (isMirrored state))+                                        preparedDraggers+        return (draggerWrs ++ zip wins rects', Just $ state { draggers = newDraggers,+                                                              focusPos = length l,+                                                              numWindows = length wins })         where             mirrorAdjust a b = if (isMirrored state)                                 then b@@ -124,19 +161,21 @@         | Just (IncMasterN d) <- fromMessage m =             return $ Just $ state { nmaster = max 0 (nmaster state + d) }         | Just Shrink <- fromMessage m =-            return $ Just $ state { masterFrac = max 0 (masterFrac state - mrtDelta) }+            return $ Just $ state { masterFrac = max 0 (masterFrac state - fracIncrement state) }         | Just Expand <- fromMessage m =-            return $ Just $ state { masterFrac = min 1 (masterFrac state + mrtDelta) }+            return $ Just $ state { masterFrac = min 1 (masterFrac state + fracIncrement state) }         | Just ShrinkSlave <- fromMessage m =-            return $ Just $ modifySlave state (-mrtDelta)+            return $ Just $ modifySlave state (- fracIncrement state)         | Just ExpandSlave <- fromMessage m =-            return $ Just $ modifySlave state mrtDelta+            return $ Just $ modifySlave state (fracIncrement state)         | Just (SetMasterFraction f) <- fromMessage m =             return $ Just $ state { masterFrac = max 0 (min 1 f) }         | Just (SetLeftSlaveFraction pos f) <- fromMessage m =-            return $ Just $ state { leftFracs = replaceAtPos (leftFracs state) pos (max 0 (min 1 f)) }+            return $ Just $ state { leftFracs = replaceAtPos (slaveFrac state)+                (leftFracs state) pos (max 0 (min 1 f)) }         | Just (SetRightSlaveFraction pos f) <- fromMessage m =-            return $ Just $ state { rightFracs = replaceAtPos (rightFracs state) pos (max 0 (min 1 f)) }+            return $ Just $ state { rightFracs = replaceAtPos (slaveFrac state)+                (rightFracs state) pos (max 0 (min 1 f)) }          | Just e <- fromMessage m :: Maybe Event = handleResize (draggers state) (isMirrored state) e >> return Nothing         | Just Hide             <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] })@@ -144,45 +183,54 @@         where releaseResources = mapM_ deleteDragger $ draggers state     handleMessage _ _ = return Nothing -    description _ = "MouseResizableTile"+    description state = mirror "MouseResizableTile"+        where mirror = if isMirrored state then ("Mirror " ++) else id +draggerGeometry :: DraggerType -> X DraggerGeometry+draggerGeometry (FixedDragger g d) =+    return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d)+draggerGeometry BordersDragger = do+    w <- asks (borderWidth . config)+    return (0, 0, fromIntegral w, 2*w)+ adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect adjustForMirror False dragger = dragger adjustForMirror True (draggerRect, draggerCursor, draggerInfo) =         (mirrorRect draggerRect, draggerCursor', draggerInfo)     where-        draggerCursor' = if (draggerCursor == mrtHDoubleArrow)-                            then mrtVDoubleArrow-                            else mrtHDoubleArrow+        draggerCursor' = if (draggerCursor == xC_sb_h_double_arrow)+                            then xC_sb_v_double_arrow+                            else xC_sb_h_double_arrow -modifySlave :: MouseResizableTile a -> Rational-> MouseResizableTile a+modifySlave :: MouseResizableTile a -> Rational -> MouseResizableTile a modifySlave state delta =     let pos = focusPos state         num = numWindows state         nmaster' = nmaster state         leftFracs' = leftFracs state         rightFracs' = rightFracs state+        slFrac = slaveFrac state         draggersLeft = nmaster' - 1         draggersRight = (num - nmaster') - 1     in if pos < nmaster'         then if draggersLeft > 0                 then let draggerPos = min (draggersLeft - 1) pos-                         oldFraction = (leftFracs' ++ repeat mrtFraction) !! draggerPos-                     in state { leftFracs = replaceAtPos leftFracs' draggerPos+                         oldFraction = (leftFracs' ++ repeat slFrac) !! draggerPos+                     in state { leftFracs = replaceAtPos slFrac leftFracs' draggerPos                                             (max 0 (min 1 (oldFraction + delta))) }                 else state         else if draggersRight > 0                 then let draggerPos = min (draggersRight - 1) (pos - nmaster')-                         oldFraction = (rightFracs' ++ repeat mrtFraction) !! draggerPos-                     in state { rightFracs = replaceAtPos rightFracs' draggerPos+                         oldFraction = (rightFracs' ++ repeat slFrac) !! draggerPos+                     in state { rightFracs = replaceAtPos slFrac rightFracs' draggerPos                                             (max 0 (min 1 (oldFraction + delta))) }                 else state -replaceAtPos :: (Num t) => [Rational] -> t -> Rational -> [Rational]-replaceAtPos [] 0 x' = [x']-replaceAtPos [] pos x' = mrtFraction : replaceAtPos [] (pos - 1) x'-replaceAtPos (_:xs) 0 x' = x' : xs-replaceAtPos (x:xs) pos x' = x : replaceAtPos xs (pos -1 ) x'+replaceAtPos :: (Num t, Eq t) => Rational -> [Rational] -> t -> Rational -> [Rational]+replaceAtPos _ [] 0 x' = [x']+replaceAtPos d [] pos x' = d : replaceAtPos d [] (pos - 1) x'+replaceAtPos _ (_:xs) 0 x' = x' : xs+replaceAtPos d (x:xs) pos x' = x : replaceAtPos d xs (pos -1 ) x'  sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) =@@ -192,44 +240,46 @@ within :: (Ord a) => a -> a -> a -> a within low high a = max low $ min high a -tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> ([Rectangle], [DraggerWithRect])-tile nmaster' masterFrac' leftFracs' rightFracs' sr num-    | num <= nmaster'       = splitVertically (take (num - 1) leftFracs') sr True 0-    | nmaster' == 0         = splitVertically (take (num - 1) rightFracs') sr False 0+tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect])+tile nmaster' masterFrac' leftFracs' rightFracs' sr num drg+    | num <= nmaster'       = splitVertically (take (num - 1) leftFracs') sr True 0 drg+    | nmaster' == 0         = splitVertically (take (num - 1) rightFracs') sr False 0 drg     | otherwise             = (leftRects ++ rightRects, masterDragger : leftDraggers ++ rightDraggers)-    where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr-          (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0-          (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0+    where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr drg+          (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0 drg+          (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0 drg -splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> ([Rectangle], [DraggerWithRect])-splitVertically [] r _ _ = ([r], [])-splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num =-    let nextRect = Rectangle sx sy sw $ smallh - div mrtDraggerSize 2+splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect])+splitVertically [] r _ _ _ = ([r], [])+splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num drg@(drOff, drSz, drOff2, drSz2) =+    let nextRect = Rectangle sx sy sw $ smallh - div drSz 2         (otherRects, otherDragger) = splitVertically fx-                                        (Rectangle sx (sy + fromIntegral smallh + mrtDraggerOffset)-                                                    sw (sh - smallh - div mrtDraggerSize 2))-                                        isLeft (num + 1)-        draggerRect = Rectangle sx (sy + fromIntegral smallh - mrtDraggerOffset) sw mrtDraggerSize+                                        (Rectangle sx (sy + fromIntegral smallh + drOff)+                                                    sw (sh - smallh - div drSz 2))+                                        isLeft (num + 1) drg+        draggerRect = Rectangle sx (sy + fromIntegral smallh - drOff2) sw drSz2         draggerInfo = if isLeft                         then LeftSlaveDragger sy (fromIntegral sh) num                         else RightSlaveDragger sy (fromIntegral sh) num-        nextDragger = (draggerRect, mrtVDoubleArrow, draggerInfo)+        nextDragger = (draggerRect, xC_sb_v_double_arrow, draggerInfo)     in (nextRect : otherRects, nextDragger : otherDragger)   where smallh = floor $ fromIntegral sh * f -splitHorizontallyBy :: RealFrac r => r -> Rectangle -> ((Rectangle, Rectangle), DraggerWithRect)-splitHorizontallyBy f (Rectangle sx sy sw sh) = ((leftHalf, rightHalf), (draggerRect, mrtHDoubleArrow, draggerInfo))+splitHorizontallyBy :: RealFrac r => r -> Rectangle -> DraggerGeometry -> ((Rectangle, Rectangle), DraggerWithRect)+splitHorizontallyBy f (Rectangle sx sy sw sh) (drOff, drSz, drOff2, drSz2) =+    ((leftHalf, rightHalf), (draggerRect, xC_sb_h_double_arrow, draggerInfo))   where leftw = floor $ fromIntegral sw * f-        leftHalf = Rectangle sx sy (leftw - mrtDraggerSize `div` 2) sh-        rightHalf = Rectangle (sx + fromIntegral leftw + mrtDraggerOffset) sy-                                (sw - fromIntegral leftw - mrtDraggerSize `div` 2) sh-        draggerRect = Rectangle (sx + fromIntegral leftw - mrtDraggerOffset) sy mrtDraggerSize sh+        leftHalf = Rectangle sx sy (leftw - drSz `div` 2) sh+        rightHalf = Rectangle (sx + fromIntegral leftw + drOff) sy+                                (sw - fromIntegral leftw - drSz `div` 2) sh+        draggerRect = Rectangle (sx + fromIntegral leftw - drOff2) sy drSz2 sh         draggerInfo = MasterDragger sx (fromIntegral sw) -createDragger :: Rectangle -> DraggerWithRect -> X DraggerWithWin+createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin) createDragger sr (draggerRect, draggerCursor, draggerInfo) = do-        draggerWin <- createInputWindow draggerCursor $ sanitizeRectangle sr draggerRect-        return (draggerWin, draggerInfo)+        let draggerRect' = sanitizeRectangle sr draggerRect+        draggerWin <- createInputWindow draggerCursor draggerRect'+        return ((draggerWin, draggerRect'), (draggerWin, draggerInfo))  deleteDragger :: DraggerWithWin -> X () deleteDragger (draggerWin, _) = deleteWindow draggerWin
+ XMonad/Layout/MultiColumns.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.MultiColumns+-- Copyright   :  (c) Anders Engstrom <ankaan@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This layout tiles windows in a growing number of columns. The number of+-- windows in each column can be controlled by messages.+-----------------------------------------------------------------------------++module XMonad.Layout.MultiColumns (+                              -- * Usage+                              -- $usage++                              multiCol,+                              MultiCol,+                             ) where++import XMonad+import qualified XMonad.StackSet as W++import Control.Monad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.MultiColumns+--+-- Then edit your @layoutHook@ by adding the multiCol layout:+--+-- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- Or alternatively:+--+-- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- The maximum number of windows in a column can be controlled using the+-- IncMasterN messages and the column containing the focused window will be+-- modified. If the value is 0, all remaining windows will be placed in that+-- column when all columns before that has been filled.+--+-- The size can be set to between 1 and -0.5. If the value is positive, the+-- master column will be of that size. The rest of the screen is split among+-- the other columns. But if the size is negative, it instead indicates the+-- size of all non-master columns and the master column will cover the rest of+-- the screen. If the master column would become smaller than the other+-- columns, the screen is instead split equally among all columns. Therefore,+-- if equal size among all columns are desired, set the size to -0.5.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | Layout constructor.+multiCol+  :: [Int]    -- ^ Windows in each column, starting with master. Set to 0 to catch the rest.+  -> Int      -- ^ Default value for all following columns.+  -> Rational -- ^ How much to change size each time.+  -> Rational -- ^ Initial size of master area, or column area if the size is negative.+  -> MultiCol a+multiCol n defn ds s = MultiCol (map (max 0) n) (max 0 defn) ds s 0++data MultiCol a = MultiCol+  { multiColNWin      :: ![Int]+  , multiColDefWin    :: !Int+  , multiColDeltaSize :: !Rational+  , multiColSize      :: !Rational+  , multiColActive    :: !Int+  } deriving (Show,Read,Eq)++instance LayoutClass MultiCol a where+    doLayout l r s = return (zip w rlist, resl)+        where rlist = doL (multiColNWin l') (multiColSize l') r wlen+              w = W.integrate s+              wlen = length w+              -- Make sure the list of columns is big enough and update active column+              nw = multiColNWin l ++ repeat (multiColDefWin l)+              l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw+                     , multiColActive = getCol (length $ W.up s) nw+                     }+              -- Only return new layout if it has been modified+              resl = if l'==l+                     then Nothing+                     else Just l'+    handleMessage l m =+        return $ msum [fmap resize     (fromMessage m)+                      ,fmap incmastern (fromMessage m)]+            where resize Shrink = l { multiColSize = max (-0.5) $ s-ds }+                  resize Expand = l { multiColSize = min 1 $ s+ds }+                  incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ tail r }+                      where newval =  max 0 $ head r + x+                            r = drop a n+                  n = multiColNWin l+                  ds = multiColDeltaSize l+                  s = multiColSize l+                  a = multiColActive l+    description _ = "MultiCol"+++-- | Get which column a window is in, starting at 0.+getCol :: Int -> [Int] -> Int+getCol w (n:ns) = if n<1 || w < n+                  then 0+                  else 1 + getCol (w-n) ns+-- Should never occur...+getCol _ _ = -1++doL :: [Int] -> Rational -> Rectangle -> Int -> [Rectangle]+doL nwin s r n = rlist+    where -- Number of columns to tile+          ncol = getCol (n-1) nwin + 1+          -- Compute the actual size+          size = floor $ abs s * fromIntegral (rect_width r)+          -- Extract all but last column to tile+          c = take (ncol-1) nwin+          -- Compute number of windows in last column and add it to the others+          col = c ++ [n-sum c]+          -- Compute width of columns+          width = if s>0+                  then if ncol==1+                       -- Only one window+                       then [fromIntegral $ rect_width r]+                       -- Give the master it's space and split the rest equally for the other columns+                       else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1))+                  else if fromIntegral ncol * abs s >= 1+                       -- Split equally+                       then replicate ncol $ fromIntegral (rect_width r) `div` ncol+                       -- Let the master cover what is left...+                       else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size+          -- Compute the horizontal position of columns+          xpos = accumEx (fromIntegral $ rect_x r) width+          -- Exclusive accumulation+          accumEx a (x:xs) = a:accumEx (a+x) xs+          accumEx _ _ = []+          -- Create a rectangle for each column+          cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width+          -- Split the columns into the windows+          rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr
XMonad/Layout/MultiToggle.hs view
@@ -24,7 +24,11 @@     EOT(..),     single,     mkToggle,-    mkToggle1+    mkToggle1,++    HList,+    HCons,+    MultiToggle, ) where  import XMonad@@ -41,11 +45,6 @@ -- first disables any currently active transformer; i.e. it works like a -- group of radio buttons. ----- A side effect of this meta-layout is that layout transformers no longer--- receive any messages; any message not handled by MultiToggle itself will--- undo the current layout transformer, pass the message on to the base--- layout, then reapply the transformer.--- -- To use this module, you need some data types which represent -- transformers; for some commonly used transformers (including -- MIRROR, NOBORDERS, and FULL used in the examples below) you can@@ -89,7 +88,7 @@ -- -- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) -- > instance Transformer MIRROR Window where--- >     transform _ x k = k (Mirror x)+-- >     transform _ x k = k (Mirror x) (\(Mirror x') -> x') -- -- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the -- beginning of your file.@@ -97,16 +96,20 @@ -- | A class to identify custom transformers (and look up transforming -- functions by type). class (Eq t, Typeable t) => Transformer t a | t -> a where-    transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b+    transform :: (LayoutClass l a) => t -> l a ->+        (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b -data EL a = forall l. (LayoutClass l a) => EL (l a)+data (LayoutClass l a) => EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a) -unEL :: EL a -> (forall l. (LayoutClass l a) => l a -> b) -> b-unEL (EL x) k = k x+unEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b+unEL (EL x _) k = k x -transform' :: (Transformer t a) => t -> EL a -> EL a-transform' t el = el `unEL` \l -> transform t l EL+deEL :: (LayoutClass l a) => EL l a -> l a+deEL (EL x det) = det x +transform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a+transform' t (EL l det) = transform t l (\l' det' -> EL l' (det . det'))+ -- | Toggle the specified layout transformer. data Toggle a = forall t. (Transformer t a) => Toggle t     deriving (Typeable)@@ -117,10 +120,8 @@     deriving (Read, Show)  data MultiToggle ts l a = MultiToggle{-    baseLayout :: l a,-    currLayout :: EL a,+    currLayout :: EL l a,     currIndex :: Maybe Int,-    currTrans :: EL a -> EL a,     transformers :: ts } @@ -128,27 +129,23 @@ expand (MultiToggleS b i ts) =     resolve ts (fromMaybe (-1) i) id         (\x mt ->-            let g = transform' x in-            mt{-                currLayout = g . EL $ baseLayout mt,-                currTrans = g-            }+            let g = transform' x in mt{ currLayout = g $ currLayout mt }         )-        (MultiToggle b (EL b) i id ts)+        (MultiToggle (EL b id) i ts) -collapse :: MultiToggle ts l a -> MultiToggleS ts l a-collapse mt = MultiToggleS (baseLayout mt) (currIndex mt) (transformers mt)+collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a+collapse mt = MultiToggleS (deEL (currLayout mt)) (currIndex mt) (transformers mt)  instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where     readsPrec p s = map (first expand) $ readsPrec p s -instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where+instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where     showsPrec p = showsPrec p . collapse  -- | Construct a @MultiToggle@ layout from a transformer table and a base -- layout. mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a-mkToggle ts l = MultiToggle l (EL l) Nothing id ts+mkToggle ts l = MultiToggle (EL l id) Nothing ts  -- | Construct a @MultiToggle@ layout from a single transformer and a base -- layout.@@ -190,48 +187,26 @@ geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool geq a b = Just a == cast b -acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c-acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x }))- instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where     description mt = currLayout mt `unEL` \l -> description l -    runLayout (Workspace i mt s) r-        | isNothing (currIndex mt) =-            acceptChange mt (fmap . fmap . \f x -> (f x){ baseLayout = x }) $ runLayout (Workspace i (baseLayout mt) s) r-        | otherwise = currLayout mt `unEL` \l ->-            acceptChange mt (fmap . fmap) $ runLayout (Workspace i l s) r+    runLayout (Workspace i mt s) r = case currLayout mt of+        EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $+            runLayout (Workspace i l s) r      handleMessage mt m         | Just (Toggle t) <- fromMessage m         , i@(Just _) <- find (transformers mt) t-            = currLayout mt `unEL` \l ->-            if i == currIndex mt-                then do-                    handleMessage l (SomeMessage ReleaseResources)-                    return . Just $-                        mt{-                            currLayout = EL $ baseLayout mt,-                            currIndex = Nothing,-                            currTrans = id-                        }-                else do-                    handleMessage l (SomeMessage ReleaseResources)-                    let f = transform' t+            = case currLayout mt of+                EL l det -> do+                    l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources)                     return . Just $-                        mt{-                            currLayout = f . EL $ baseLayout mt,-                            currIndex = i,-                            currTrans = f+                        mt {+                            currLayout = (if cur then id else transform' t) (EL (det l') id),+                            currIndex = if cur then Nothing else i                         }-        | fromMessage m == Just ReleaseResources ||-          fromMessage m == Just Hide-            = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m)-        | otherwise = do-            ml <- handleMessage (baseLayout mt) m-            case ml of-                Nothing -> return Nothing-                Just b' -> currLayout mt `unEL` \l -> do-                    handleMessage l (SomeMessage ReleaseResources)-                    return . Just $-                        mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' }+                    where cur = (i == currIndex mt)+        | otherwise+            = case currLayout mt of+                EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $+                    handleMessage l m
XMonad/Layout/MultiToggle/Instances.hs view
@@ -22,6 +22,7 @@  import XMonad import XMonad.Layout.NoBorders+import XMonad.Layout.LayoutModifier  data StdTransformers = FULL          -- ^ switch to Full layout                      | NBFULL        -- ^ switch to Full with no borders@@ -31,8 +32,8 @@   deriving (Read, Show, Eq, Typeable)  instance Transformer StdTransformers Window where-    transform FULL         _ k = k Full-    transform NBFULL       _ k = k (noBorders Full)-    transform MIRROR       x k = k (Mirror x)-    transform NOBORDERS    x k = k (noBorders x)-    transform SMARTBORDERS x k = k (smartBorders x)+    transform FULL         x k = k Full (const x)+    transform NBFULL       x k = k (noBorders Full) (const x)+    transform MIRROR       x k = k (Mirror x) (\(Mirror x') -> x')+    transform NOBORDERS    x k = k (noBorders x) (\(ModifiedLayout _ x') -> x')+    transform SMARTBORDERS x k = k (smartBorders x) (\(ModifiedLayout _ x') -> x')
XMonad/Layout/Named.hs view
@@ -10,7 +10,8 @@ -- Stability   :  unstable -- Portability :  unportable ----- A module for assigning a name to a given layout.+-- A module for assigning a name to a given layout. Deprecated, use+-- "XMonad.Layout.Renamed" instead. -- ----------------------------------------------------------------------------- @@ -21,8 +22,8 @@       nameTail     ) where -import XMonad import XMonad.Layout.LayoutModifier+import XMonad.Layout.Renamed  -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -38,22 +39,14 @@ -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook"---- | Rename a layout.-named :: String -> l a -> ModifiedLayout Named l a-named s = ModifiedLayout (Named s)--data Named a = Named String deriving ( Read, Show )--instance LayoutModifier Named a where-    modifyDescription (Named n) _ = n----- | Remove the first word of the name.-nameTail :: l a -> ModifiedLayout NameTail l a-nameTail = ModifiedLayout NameTail+--+-- Note that this module has been deprecated and may be removed in a future+-- release, please use "XMonad.Layout.Renamed" instead. -data NameTail a = NameTail deriving (Read,Show)+-- | (Deprecated) Rename a layout.+named :: String -> l a -> ModifiedLayout Rename l a+named s = renamed [Replace s] -instance LayoutModifier NameTail a where-  modifyDescription NameTail i = dropWhile (==' ') $ dropWhile (/=' ') $ description i+-- | (Deprecated) Remove the first word of the name.+nameTail :: l a -> ModifiedLayout Rename l a+nameTail = renamed [CutWordsLeft 1]
XMonad/Layout/NoBorders.hs view
@@ -27,13 +27,13 @@                                 lessBorders,                                 SetsAmbiguous(..),                                 Ambiguity(..),-                                With(..)+                                With(..),+                                SmartBorder, WithBorder, ConfigurableBorder,                                ) where  import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W-import Control.Monad import Data.List import qualified Data.Map as M import Data.Function (on)@@ -129,11 +129,11 @@ -- -- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... ) ----- To get the same result as smartBorders:+-- To get the same result as 'smartBorders': ----- > layoutHook = lessBorders (Combine Never) (Tall 1 0.5 0.03 ||| ...)+-- > layoutHook = lessBorders Never (Tall 1 0.5 0.03 ||| ...) ----- This indirect method is required to keep the Read and Show for+-- This indirect method is required to keep the 'Read' and 'Show' for -- ConfigurableBorder so that xmonad can serialize state. class SetsAmbiguous p where     hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]@@ -173,7 +173,7 @@ -- | In order of increasing ambiguity (less borders more frequently), where -- subsequent constructors add additional cases where borders are not drawn -- than their predecessors. These behaviors make most sense with with multiple--- screens: for single screens, Never or 'smartBorders' makes more sense.+-- screens: for single screens, 'Never' or 'smartBorders' makes more sense. data Ambiguity = Combine With Ambiguity Ambiguity                              -- ^ This constructor is used to combine the                              -- borderless windows provided by the@@ -195,7 +195,7 @@  -- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two -- lists should be combined.-data With = Union        -- ^ Combine with Data.List.union-          | Difference   -- ^ Combine with Data.List.\\-          | Intersection -- ^ Combine with Data.List.intersect+data With = Union        -- ^ uses 'Data.List.union'+          | Difference   -- ^ uses 'Data.List.\\'+          | Intersection -- ^ uses 'Data.List.intersect'         deriving (Read, Show)
XMonad/Layout/NoFrillsDecoration.hs view
@@ -20,9 +20,13 @@     ( -- * Usage:       -- $usage       noFrillsDeco++    , module XMonad.Layout.SimpleDecoration+    , NoFrillsDecoration     ) where  import XMonad.Layout.Decoration+import XMonad.Layout.SimpleDecoration  -- $usage -- You can use this module with the following in your
+ XMonad/Layout/PositionStoreFloat.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.PositionStoreFloat+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- A floating layout which has been designed with a dual-head setup+-- in mind. It makes use of "XMonad.Util.PositionStore" as well as+-- "XMonad.Hooks.PositionStoreHooks" . Since there is currently no way+-- to move or resize windows with the keyboard alone in this layout,+-- it is adviced to use it in combination with a decoration such as+-- "XMonad.Layout.NoFrillsDecoration" (to move windows) and the+-- layout modifier "XMonad.Layout.BorderResize" (to resize windows).+--+-----------------------------------------------------------------------------++module XMonad.Layout.PositionStoreFloat+    ( -- * Usage+      -- $usage+      positionStoreFloat, PositionStoreFloat+    ) where++import XMonad+import XMonad.Util.PositionStore+import qualified XMonad.StackSet as S+import XMonad.Layout.WindowArranger+import Control.Monad(when)+import Data.Maybe(isJust)+import Data.List(nub)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.PositionStoreFloat+-- > import XMonad.Layout.NoFrillsDecoration+-- > import XMonad.Layout.BorderResize+--+-- Then edit your @layoutHook@ by adding the PositionStoreFloat layout.+-- Below is a suggestion which uses the mentioned NoFrillsDecoration and+-- BorderResize:+--+-- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc..+-- >               where floatingDeco l = noFrillsDeco shrinkText defaultTheme l+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how+-- to add the support hooks.++positionStoreFloat :: PositionStoreFloat a+positionStoreFloat = PSF (Nothing, [])++data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read)+instance LayoutClass PositionStoreFloat Window where+    description _ = "PSF"+    doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do+            posStore <- getPosStore+            let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r)+            let focused = case maybeChange of+                            Nothing -> (w, pSQ posStore w sr)+                            Just changedRect -> (w, changedRect)+            let wrs' = focused : wrs+            let paintOrder' = nub (w : paintOrder)+            when (isJust maybeChange) $ do+                updatePositionStore focused sr+            return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))+        where+            pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of+                                    Just rect   -> rect+                                    Nothing     -> (Rectangle 50 50 200 200)  -- should usually not happen+    pureMessage (PSF (_, paintOrder)) m+        | Just (SetGeometry rect) <- fromMessage m =+            Just $ PSF (Just rect, paintOrder)+        | otherwise = Nothing++updatePositionStore :: (Window, Rectangle) -> Rectangle -> X ()+updatePositionStore (w, rect) sr = modifyPosStore (\ps ->+                                            posStoreInsert ps w rect sr)++reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]+reorder wrs order =+    let ordered = concat $ map (pickElem wrs) order+        rest = filter (\(w, _) -> not (w `elem` order)) wrs+    in ordered ++ rest+    where+        pickElem list e = case (lookup e list) of+                                Just result -> [(e, result)]+                                Nothing -> []
XMonad/Layout/Reflect.hs view
@@ -18,7 +18,8 @@                                -- $usage                                 reflectHoriz, reflectVert,-                               REFLECTX(..), REFLECTY(..)+                               REFLECTX(..), REFLECTY(..),+                               Reflect                               ) where @@ -28,6 +29,7 @@  import XMonad.Layout.LayoutModifier import XMonad.Layout.MultiToggle+import XMonad.Util.XUtils (fi)  -- $usage -- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:@@ -84,8 +86,6 @@ reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) =   Rectangle rx (2*sy + fi sh - ry - fi rh) rw rh -fi :: (Integral a, Num b) => a -> b-fi = fromIntegral   data Reflect a = Reflect ReflectDir deriving (Show, Read)@@ -105,7 +105,7 @@ data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable)  instance Transformer REFLECTX Window where-    transform REFLECTX x k = k (reflectHoriz x)+    transform REFLECTX x k = k (reflectHoriz x) (\(ModifiedLayout _ x') -> x')  instance Transformer REFLECTY Window where-    transform REFLECTY x k = k (reflectVert x)+    transform REFLECTY x k = k (reflectVert x) (\(ModifiedLayout _ x') -> x')
+ XMonad/Layout/Renamed.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Groups+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layout modifier that can modify the description of its underlying+-- layout on a (hopefully) flexible way.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Renamed ( -- * Usage+                               -- $usage+                               renamed+                             , Rename(..) ) where++import XMonad+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module by adding +--+-- > import XMonad.Layout.Renamed+--+-- to your @~\/.xmonad\/xmonad.hs@.+--+-- You can then use 'renamed' to modify the description of your+-- layouts. For example:+--+-- > myLayout = renamed [PrependWords "Awesome"] $ tiled ||| Mirror tiled ||| Full++-- | Apply a list of 'Rename' values to a layout, from left to right.+renamed :: [Rename a] -> l a -> ModifiedLayout Rename l a+renamed = ModifiedLayout . Chain++-- | The available renaming operations+data Rename a = CutLeft Int -- ^ Remove a number of characters from the left+              | CutRight Int -- ^ Remove a number of characters from the right+              | Append String -- ^ Add a string on the right+              | Prepend String -- ^ Add a string on the left+              | CutWordsLeft Int -- ^ Remove a number of words from the left+              | CutWordsRight Int -- ^ Remove a number of words from the right+              | AppendWords String -- ^ Add a string to the right, prepending a space to it+                                   -- if necessary+              | PrependWords String -- ^ Add a string to the left, appending a space to it if+                                    -- necessary+              | Replace String -- ^ Repace with another wtring+              | Chain [Rename a] -- ^ Apply a list of modifications in left-to-right order+  deriving (Show, Read, Eq)++apply :: Rename a -> String -> String+apply (CutLeft i) s = drop i s+apply (CutRight i) s = take (length s - i) s+apply (CutWordsLeft i) s = unwords $ drop i $ words s+apply (CutWordsRight i) s = let ws = words s+                           in unwords $ take (length ws - i) ws+apply (Replace s) _ = s+apply (Append s') s = s ++ s'+apply (Prepend s') s = s' ++ s+apply (AppendWords s') s = unwords $ words s ++ [s']+apply (PrependWords s') s = unwords $ s' : words s+apply (Chain rs) s = ($s) $ foldr (flip (.)) id $ map apply rs++instance LayoutModifier Rename a where+    modifyDescription r l = apply r (description l)
XMonad/Layout/ResizeScreen.hs view
@@ -22,6 +22,7 @@     , resizeHorizontalRight, resizeVerticalBottom     , withNewRectangle     , ResizeScreen (..)+    , ResizeMode     ) where  import XMonad
XMonad/Layout/ShowWName.hs view
@@ -19,6 +19,7 @@     , showWName'     , defaultSWNConfig     , SWNConfig(..)+    , ShowWName     ) where  import XMonad@@ -96,7 +97,7 @@       x     = (fi wh - width + 2) `div` 2   w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True   showWindow w-  paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) AlignCenter n+  paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n]   releaseXMF f   io $ sync d False   i <- startTimer (swn_fade c)
XMonad/Layout/Spacing.hs view
@@ -17,12 +17,13 @@                                -- * Usage                                -- $usage -                               spacing+                               spacing, Spacing,                               ) where  import Graphics.X11 (Rectangle(..)) import Control.Arrow (second)+import XMonad.Util.Font (fi)  import XMonad.Layout.LayoutModifier @@ -51,4 +52,3 @@  shrinkRect :: Int -> Rectangle -> Rectangle shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (w-2*fi p) (h-2*fi p)-  where fi n = fromIntegral n   -- avoid the DMR
XMonad/Layout/Spiral.hs view
@@ -21,6 +21,8 @@                             , spiralWithDir                             , Rotation (..)                             , Direction (..)++                            , SpiralWithDir                             ) where  import Data.Ratio
XMonad/Layout/SubLayouts.hs view
@@ -28,6 +28,8 @@      defaultSublMap, +    Sublayout,+     -- * Screenshots     -- $screenshots @@ -51,13 +53,10 @@ import XMonad import Control.Applicative((<$>),(<*)) import Control.Arrow(Arrow(second, (&&&)))-import Control.Monad(Monad(return), Functor(..),-                     MonadPlus(mplus), (=<<), sequence, foldM, guard, when, join)-import Data.Function((.), ($), flip, id, on)-import Data.List((++), foldr, filter, map, concatMap, elem,-                 notElem, null, nubBy, (\\), find)-import Data.Maybe(Maybe(..), isNothing, maybe, fromMaybe, listToMaybe,-                  mapMaybe)+import Control.Monad(MonadPlus(mplus), foldM, guard, when, join)+import Data.Function(on)+import Data.List(nubBy, (\\), find)+import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe) import Data.Traversable(sequenceA)  import qualified XMonad.Layout.BoringWindows as B
XMonad/Layout/TabBarDecoration.hs view
@@ -66,7 +66,7 @@ instance Eq a => DecorationStyle TabBarDecoration a where     describeDeco  _ = "TabBar"     shrink    _ _ r = r-    decorationMouseDragHook _ _ _ = return ()+    decorationCatchClicksHook _ mainw _ _ = focus mainw >> return True     pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) =         if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing         where wrs = S.integrate s
XMonad/Layout/Tabbed.hs view
@@ -26,9 +26,9 @@     , TabbedDecoration (..)     , shrinkText, CustomShrink(CustomShrink)     , Shrinker(..)+    , TabbarShown, TabbarLocation     ) where -import Data.Maybe import Data.List  import XMonad@@ -81,7 +81,7 @@ -- This is a minimal working configuration: -- -- > import XMonad--- > import XMonad.Layout.DecorationMadness+-- > import XMonad.Layout.Tabbed -- > main = xmonad defaultConfig { layoutHook = simpleTabbed } simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbed = tabbed shrinkText defaultTheme@@ -155,17 +155,16 @@ instance Eq a => DecorationStyle TabbedDecoration a where     describeDeco (Tabbed Top _ ) = "Tabbed"     describeDeco (Tabbed Bottom _ ) = "Tabbed Bottom"-    decorationMouseFocusHook _ ds ButtonEvent { ev_window     = ew-                                             , ev_event_type = et-                                             , ev_button     = eb }+    decorationEventHook _ ds ButtonEvent { ev_window     = ew+                                         , ev_event_type = et+                                         , ev_button     = eb }         | et == buttonPress         , Just ((w,_),_) <-findWindowByDecoration ew ds =            if eb == button2                then killWindow w                else focus w-    decorationMouseFocusHook _ _ _ = return ()+    decorationEventHook _ _ _ = return () -    decorationMouseDragHook _ _ _ = return ()     pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh))         = if ((sh == Always && numWindows > 0) || numWindows > 1)           then Just $ case lc of
XMonad/Layout/ToggleLayouts.hs view
@@ -16,7 +16,7 @@ module XMonad.Layout.ToggleLayouts (     -- * Usage     -- $usage-    toggleLayouts, ToggleLayout(..)+    toggleLayouts, ToggleLayout(..), ToggleLayouts     ) where  import XMonad
+ XMonad/Layout/TrackFloating.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+{- |++Module      :  XMonad.Layout.TrackFloating+Copyright   :  (c) 2010 Adam Vogt+License     :  BSD-style (see xmonad/LICENSE)++Maintainer  :  vogt.adam@gmail.com+Stability   :  unstable+Portability :  unportable++Layout modifier that tracks focus in the tiled layer while the floating layer+is in use. This is particularly helpful for tiled layouts where the focus+determines what is visible.++The relevant bug is Issue 4+<http://code.google.com/p/xmonad/issues/detail?id=4>.+-}+module XMonad.Layout.TrackFloating+    (-- * Usage+     -- $usage++     -- ** For other layout modifiers+     -- $layoutModifier+     trackFloating,+     TrackFloating,+    ) where++import Control.Monad+import Data.Function+import Data.List+import Data.Maybe+import qualified Data.Map as M+import qualified Data.Set as S++import XMonad+import XMonad.Layout.LayoutModifier+import qualified XMonad.StackSet as W+++data TrackFloating a = TrackFloating+    { _wasFloating :: Bool,+      _tiledFocus :: Maybe Window }+    deriving (Read,Show,Eq)+++instance LayoutModifier TrackFloating Window where+    modifyLayoutWithUpdate os@(TrackFloating wasF mw) ws@(W.Workspace{ W.stack = ms }) r+      = do+        winset <- gets windowset+        let xCur = fmap W.focus xStack+            xStack = W.stack $ W.workspace $ W.current winset+            isF = fmap (\x -> x `M.member` W.floating winset ||+                            (let (\\\) = (S.\\) `on` (S.fromList . W.integrate')+                             in x `S.member` (xStack \\\ ms)))+                        xCur+            newStack+              -- focus is floating, so use the remembered focus point+              | Just isF' <- isF,+                isF' || wasF,+                Just w <- mw,+                Just s <- ms,+                Just ns <- find ((==) w . W.focus)+                    $ zipWith const (iterate W.focusDown' s) (W.integrate s)+                = Just ns+              | otherwise+                = ms+            newState = case isF of+              Just True -> mw+              Just False | Just f <- xCur -> Just f+              _ -> Nothing+        ran <- runLayout ws{ W.stack = newStack } r+        return (ran,+                let n = TrackFloating (fromMaybe False isF) newState+                in guard (n /= os) >> Just n)+++{- $usage++Apply to your layout in a config like:++> main = xmonad (defaultConfig{+>                   layoutHook = trackFloating+>                       (noBorders Full ||| Tall 1 0.3 0.5),+>                   ...+>               })++-}++{- | Runs another layout with a remembered focus, provided:++* the subset of windows doesn't include the focus in XState++* it was previously run with a subset that included the XState focus++* the remembered focus hasn't since been killed++-}+trackFloating ::  l a -> ModifiedLayout TrackFloating l a+trackFloating layout = ModifiedLayout (TrackFloating False Nothing) layout++{- $layoutModifier+It also corrects focus issues for full-like layouts inside other layout+modifiers:++> import XMonad.Layout.IM+> import XMonad.Layout.Tabbed+> import XMonad.Layout.TrackFloating+> import XMonad.Layout.Reflect++> gimpLayout = withIM 0.11 (Role "gimp-toolbox") $ reflectHoriz+>       $ withIM 0.15 (Role "gimp-dock") (trackFloating simpleTabbed)++Interactions with some layout modifiers (ex. decorations, minimizing) are+unknown but likely unpleasant.+-}
XMonad/Layout/WindowArranger.hs view
@@ -32,7 +32,6 @@  import Control.Arrow import Data.List-import Data.Maybe  -- $usage -- You can use this module with the following in your
XMonad/Layout/WindowNavigation.hs view
@@ -21,7 +21,8 @@                                    Navigate(..), Direction2D(..),                                    MoveWindowToWindow(..),                                    navigateColor, navigateBrightness,-                                   noNavigateBorders, defaultWNConfig+                                   noNavigateBorders, defaultWNConfig,+                                   WNConfig, WindowNavigation,                                   ) where  import Data.List ( nub, sortBy, (\\) )
+ XMonad/Layout/WindowSwitcherDecoration.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.WindowSwitcherDecoration+-- Copyright   :  (c) Jan Vornberger 2009+--                    Alejandro Serrano 2010+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- A decoration that allows to switch the position of windows by dragging+-- them onto each other.+--+-----------------------------------------------------------------------------++module XMonad.Layout.WindowSwitcherDecoration+    ( -- * Usage:+      -- $usage+      windowSwitcherDecoration,+      windowSwitcherDecorationWithButtons,+      windowSwitcherDecorationWithImageButtons,+      WindowSwitcherDecoration, ImageWindowSwitcherDecoration,+    ) where++import XMonad+import XMonad.Layout.Decoration+import XMonad.Layout.DecorationAddons+import XMonad.Layout.ImageButtonDecoration+import XMonad.Layout.DraggingVisualizer+import qualified XMonad.StackSet as S+import Control.Monad+import Foreign.C.Types(CInt)++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.WindowSwitcherDecoration+-- > import XMonad.Layout.DraggingVisualizer+--+-- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to+-- your layout:+--+-- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--+-- There is also a version of the decoration that contains buttons like+-- "XMonad.Layout.ButtonDecoration". To use that version, you will need to+-- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@+-- in the following way:+--+-- > import XMonad.Layout.DecorationAddons+-- >+-- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--+-- Additionaly, there is a version of the decoration that contains image buttons like+-- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to+-- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@+-- in the following way:+--+-- > import XMonad.Layout.ImageButtonDecoration+-- >+-- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--++windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme+           -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a+windowSwitcherDecoration s c = decoration s c $ WSD False++windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme+           -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a+windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True++data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read)++instance Eq a => DecorationStyle WindowSwitcherDecoration a where+    describeDeco _ = "WindowSwitcherDeco"++    decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons+                                                                    then titleBarButtonHandler mainw dFL dFR+                                                                    else return False+    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+    decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw+                                                          hasCrossed <- handleScreenCrossing mainw decoWin+                                                          unless hasCrossed $ do sendMessage $ DraggingStopped+                                                                                 performWindowSwitching mainw++-- Note: the image button code is duplicated from the above+-- because the title bar handle is different++windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme+           -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a+windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True++data ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read)++instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where+    describeDeco _ = "ImageWindowSwitcherDeco"++    decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons+                                                                    then imageTitleBarButtonHandler mainw dFL dFR+                                                                    else return False+    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+    decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw+                                                          hasCrossed <- handleScreenCrossing mainw decoWin+                                                          unless hasCrossed $ do sendMessage $ DraggingStopped+                                                                                 performWindowSwitching mainw++handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+handleTiledDraggingInProgress ex ey (mainw, r) x y = do+    let rect = Rectangle (x - (fi ex - rect_x r))+                         (y - (fi ey - rect_y r))+                         (rect_width  r)+                         (rect_height r)+    sendMessage $ DraggingWindow mainw rect++performWindowSwitching :: Window -> X ()+performWindowSwitching win =+    withDisplay $ \d -> do+       root <- asks theRoot+       (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root+       ws <- gets windowset+       let allWindows = S.index ws+       -- do a little double check to be sure+       if (win `elem` allWindows) && (selWin `elem` allWindows)+            then do+                let allWindowsSwitched = map (switchEntries win selWin) allWindows+                let (ls, t:rs) = break (win ==) allWindowsSwitched+                let newStack = S.Stack t (reverse ls) rs+                windows $ S.modify' $ \_ -> newStack+            else return ()+    where+        switchEntries a b x+            | x == a    = b+            | x == b    = a+            | otherwise = x
XMonad/Layout/WorkspaceDir.hs view
@@ -25,9 +25,12 @@                                    -- * Usage                                    -- $usage                                    workspaceDir,-                                   changeDir+                                   changeDir,+                                   WorkspaceDir,                                   ) where +import Prelude hiding (catch)+import Control.Exception import System.Directory ( setCurrentDirectory, getCurrentDirectory ) import Control.Monad ( when ) @@ -38,6 +41,9 @@ import XMonad.Layout.LayoutModifier import XMonad.StackSet ( tag, currentTag ) +econst :: Monad m => a -> IOException -> m a+econst = const . return+ -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --@@ -84,7 +90,7 @@ cleanDir x = scd x >> io getCurrentDirectory  scd :: String -> X ()-scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x)+scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` econst x)            catchIO $ setCurrentDirectory x'  changeDir :: XPConfig -> X ()
+ XMonad/Layout/ZoomRow.hs view
@@ -0,0 +1,258 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses+  , PatternGuards, DeriveDataTypeable, ExistentialQuantification+  , FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ZoomRow+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  unstable+-- Portability :  unportable+--+-- Row layout with individually resizable elements.+--+-----------------------------------------------------------------------------++module XMonad.Layout.ZoomRow ( -- * Usage+                               -- $usage+                               ZoomRow+                               -- * Creation+                             , zoomRow+                               -- * Messages+                             , ZoomMessage(..)+                             , zoomIn+                             , zoomOut+                             , zoomReset+                               -- * Use with non-'Eq' elements+                               -- $noneq+                             , zoomRowWith+                             , EQF(..)+                             , ClassEQ(..)+                             ) where++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Util.Stack+import XMonad.Layout.Decoration (fi)++import Data.Maybe (fromMaybe)+import Control.Arrow (second)+ +-- $usage+-- This module provides a layout which places all windows in a single+-- row; the size occupied by each individual window can be increased+-- and decreased, and a window can be set to use the whole available+-- space whenever it has focus.+--+-- You can use this module by including  the following in your @~\/.xmonad/xmonad.hs@:+--+-- > import XMonad.Layout.ZoomRow+--+-- and using 'zoomRow' somewhere in your 'layoutHook', for example:+--+-- > myLayout = zoomRow ||| Mirror zoomRow+--+-- To be able to resize windows, you can create keybindings to send+-- the relevant 'ZoomMessage's:+--+-- >   -- Increase the size occupied by the focused window+-- > , ((modMask .|. shifMask, xK_minus), sendMessage zoomIn)+-- >   -- Decrease the size occupied by the focused window+-- > , ((modMayk             , xK_minus), sendMessage zoomOut)+-- >   -- Reset the size occupied by the focused window+-- > , ((modMask             , xK_equal), sendMessage zoomReset)+-- >   -- (Un)Maximize the focused window+-- > , ((modMask             , xK_f    ), sendMessage ToggleZoomFull)+--+-- For more information on editing your layout hook and key bindings,+-- see "XMonad.Doc.Extending".++-- * Creation functions++-- | 'ZoomRow' layout for laying out elements which are instances of+-- 'Eq'. Perfect for 'Window's.+zoomRow :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a+zoomRow = ZC ClassEQ emptyZ++-- $noneq+-- Haskell's 'Eq' class is usually concerned with structural equality, whereas +-- what this layout really wants is for its elements to have a unique identity,+-- even across changes. There are cases (such as, importantly, 'Window's) where +-- the 'Eq' instance for a type actually does that, but if you want to lay+-- out something more exotic than windows and your 'Eq' means something else,+-- you can use the following.++-- | ZoomRow layout with a custom equality predicate. It should+-- of course satisfy the laws for 'Eq', and you should also make+-- sure that the layout never has to handle two \"equal\" elements+-- at the same time (it won't do any huge damage, but might behave+-- a bit strangely).+zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a) +               => f a -> ZoomRow f a+zoomRowWith f = ZC f emptyZ+++-- * The datatypes++-- | A layout that arranges its windows in a horizontal row,+-- and allows to change the relative size of each element+-- independently.+data ZoomRow f a = ZC { zoomEq ::  f a+                          -- ^ Function to compare elements for+                          -- equality, a real Eq instance might+                          -- not be what you want in some cases+                      , zoomRatios :: (Zipper (Elt a))+                          -- ^ Element specs. The zipper is so we+                          -- know what the focus is when we handle+                          --  a message+                      }+  deriving (Show, Read, Eq)++-- | Class for equivalence relations. Must be transitive, reflexive.+class EQF f a where+    eq :: f a -> a -> a -> Bool++-- | To use the usual '==':+data ClassEQ a = ClassEQ+  deriving (Show, Read, Eq)++instance Eq a => EQF ClassEQ a where+    eq _ a b = a == b++-- | Size specification for an element.+data Elt a = E { elt :: a -- ^ The element+               , ratio :: Rational -- ^ Its size ratio+               , full :: Bool -- ^ Whether it should occupy all the+                              -- available space when it has focus.+               }+  deriving (Show, Read, Eq)+++-- * Helpers++getRatio :: Elt a -> (a, Rational)+getRatio (E a r _) = (a,r)++lookupBy :: (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a)+lookupBy _ _ [] = Nothing+lookupBy f a (E a' r b : _) | f a a' = Just $ E a r b+lookupBy f a (_:es) = lookupBy f a es++setFocus :: Zipper a -> a -> Zipper a+setFocus Nothing a = Just $ W.Stack a [] []+setFocus (Just s) a = Just s { W.focus = a }+++-- * Messages++-- | The type of messages accepted by a 'ZoomRow' layout+data ZoomMessage = Zoom Rational+                 -- ^ Multiply the focused window's size factor+                 -- by the given number.+                 | ZoomTo Rational+                 -- ^ Set the focused window's size factor to the+                 -- given number.+                 | ZoomFull Bool+                 -- ^ Set whether the focused window should occupy+                 -- all available space when it has focus+                 | ZoomFullToggle+                 -- ^ Toggle whether the focused window should+                 -- occupy all available space when it has focus+  deriving (Typeable, Show)++instance Message ZoomMessage++-- | Increase the size of the focused window.+-- Defined as @Zoom 1.5@+zoomIn :: ZoomMessage+zoomIn = Zoom 1.5++-- | Decrease the size of the focused window.+-- Defined as @Zoom (2/3)@+zoomOut :: ZoomMessage+zoomOut = Zoom $ 2/3++-- | Reset the size of the focused window.+-- Defined as @ZoomTo 1@+zoomReset :: ZoomMessage+zoomReset = ZoomTo 1+++-- * LayoutClass instance++instance (EQF f a, Show a, Read a, Show (f a), Read (f a)) +    => LayoutClass (ZoomRow f) a where+    description (ZC _ Nothing) = "ZoomRow"+    description (ZC _ (Just s)) = "ZoomRow" ++ if full $ W.focus s+                                                then " (Max)"+                                                else ""++    emptyLayout (ZC _ Nothing) _ = return ([], Nothing)+    emptyLayout (ZC f _) _ = return ([], Just $ ZC f Nothing)++    doLayout (ZC f zelts) r@(Rectangle _ _ w _) s+        = let elts = W.integrate' zelts+              zelts' = mapZ_ (\a -> fromMaybe (E a 1 False) +                                    $ lookupBy (eq f) a elts) $ Just s+              elts' = W.integrate' zelts'++              maybeL' = if zelts `noChange` zelts'+                          then Nothing+                          else Just $ ZC f zelts'++              total = sum  $ map ratio elts'++              widths =  map (second ((* fi w) . (/total)) . getRatio) elts'++          in case getFocusZ zelts' of+               Just (E a _ True) -> return ([(a, r)], maybeL')+               _ -> return (makeRects r widths, maybeL')++        where makeRects :: Rectangle -> [(a, Rational)] -> [(a, Rectangle)]+              makeRects r pairs = let as = map fst pairs+                                      widths = map snd pairs+                                      discreteWidths = snd $ foldr discretize (0, []) widths+                                      rectangles = snd $ foldr makeRect (r, []) discreteWidths+                                  in zip as rectangles++              -- | Make a new rectangle by substracting the given width from the available+              -- space (from the right, since this is a foldr)+              makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle])+              makeRect w (Rectangle x y w0 h, rs) = ( Rectangle x y (w0-w) h+                                                    , Rectangle (x+fi w0-fi w) y w h : rs )++              -- | Round a list of fractions in a way that maintains the total.+              -- If you know a better way to do this I'm very interested.+              discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension])+              discretize r (carry, ds) = let (d, carry') = properFraction $ carry+r+                                         in (carry', d:ds)++              noChange z1 z2 = toTags z1 `helper` toTags z2+                  where helper [] [] = True+                        helper (Right a:as) (Right b:bs) = a `sameAs` b && as `helper` bs+                        helper (Left a:as) (Left b:bs) = a `sameAs` b && as `helper` bs+                        helper _ _ = False+                        E a1 r1 b1 `sameAs` E a2 r2 b2 = (eq f a1 a2) && (r1 == r2) && (b1 == b2)++    pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm+                                , Just (E a r True) <- getFocusZ zelts+        = Just $ ZC f $ setFocus zelts $ E a r False++    pureMessage (ZC f zelts) sm | Just (ZoomFull True) <- fromMessage sm+                                , Just (E a r False) <- getFocusZ zelts+        = Just $ ZC f $ setFocus zelts $ E a r True++    pureMessage (ZC f zelts) sm | Just (E a r b) <- getFocusZ zelts+        = case fromMessage sm of+            Just (Zoom r') -> Just $ ZC f $ setFocus zelts $ E a (r*r') b+            Just (ZoomTo r') -> Just $ ZC f $ setFocus zelts $ E a r' b+            Just ZoomFullToggle -> pureMessage (ZC f zelts) +                                     $ SomeMessage $ ZoomFull $ not b+            _ -> Nothing++    pureMessage _ _ = Nothing
XMonad/Prompt.hs view
@@ -29,7 +29,8 @@     , defaultXPKeymap     , quit     , killBefore, killAfter, startOfLine, endOfLine-    , pasteString, copyString, moveCursor+    , pasteString, moveCursor+    , setInput, getInput     , moveWord, killWord, deleteString     , moveHistory, setSuccess, setDone     , Direction1D(..)@@ -51,39 +52,43 @@     , splitInSubListsAt     , breakAtSpace     , uniqSort-    , decodeInput-    , encodeOutput     , historyCompletion     , historyCompletionP     -- * History filters     , deleteAllDuplicates     , deleteConsecutive+    , HistoryMatches+    , initMatches+    , historyUpMatching+    , historyDownMatching+    -- * Types+    , XPState     ) where  import Prelude hiding (catch) -import XMonad  hiding (config, io, numlockMask, cleanMask)-import qualified XMonad as X (numlockMask,config)+import XMonad  hiding (config, cleanMask)+import qualified XMonad as X (numberlockMask) import qualified XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.Types-import XMonad.Util.XSelection (getSelection, putSelection)+import XMonad.Util.XSelection (getSelection) +import Codec.Binary.UTF8.String (decodeString)+import Control.Applicative ((<$>)) import Control.Arrow ((&&&),first) import Control.Concurrent (threadDelay)-import Control.Monad.Reader+import Control.Exception.Extensible hiding (handle) import Control.Monad.State-import Control.Applicative ((<$>))-import Data.Char import Data.Bits-import Data.Maybe+import Data.Char (isSpace)+import Data.IORef import Data.List+import Data.Maybe (fromMaybe) import Data.Set (fromList, toList)-import System.Directory+import System.Directory (getAppUserDataDirectory) import System.IO import System.Posix.Files-import Control.Exception.Extensible hiding (handle)- import qualified Data.Map as M  -- $usage@@ -136,7 +141,10 @@         , defaultText       :: String     -- ^ The text by default in the prompt line         , autoComplete      :: Maybe Int  -- ^ Just x: if only one completion remains, auto-select it,         , showCompletionOnTab :: Bool     -- ^ Only show list of completions when Tab was pressed-                                         --   and delay by x microseconds+                                          --   and delay by x microseconds+        , searchPredicate   :: String -> String -> Bool+                                          -- ^ Given the typed string and a possible+                                          --   completion, is the completion valid?         }  data XPType = forall p . XPrompt p => XPT p@@ -210,15 +218,17 @@         , historyFilter     = id         , defaultText       = []         , autoComplete      = Nothing-        , showCompletionOnTab = False }-greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black" }+        , showCompletionOnTab = False+        , searchPredicate   = isPrefixOf+        }+greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } amberXPConfig = defaultXPConfig { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" }  type ComplFunction = String -> IO [String]  initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction-          -> GC -> XMonadFont -> p -> [String] -> XPConfig -> XPState-initState d rw w s compl gc fonts pt h c =+          -> GC -> XMonadFont -> p -> [String] -> XPConfig -> KeyMask -> XPState+initState d rw w s compl gc fonts pt h c nm =     XPS { dpy                = d         , rootw              = rw         , win                = w@@ -237,7 +247,7 @@         , config             = c         , successful         = False         , done               = False-        , numlockMask        = X.numlockMask defaultConfig+        , numlockMask        = nm         }  -- this would be much easier with functional references@@ -247,6 +257,15 @@ setCommand :: String -> XPState -> XPState setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} +-- | Sets the input string to the given value.+setInput :: String -> XP ()+setInput = modify . setCommand++-- | Returns the current input string. Intented for use in custom keymaps+-- where the 'get' or similar can't be used to retrieve it.+getInput :: XP String+getInput = gets command+ -- | Same as 'mkXPrompt', except that the action function can have --   type @String -> X a@, for any @a@, and the final action returned --   by 'mkXPromptWithReturn' will have type @X (Maybe a)@.  @Nothing@@@ -255,30 +274,28 @@ --   module. mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a)  -> X (Maybe a) mkXPromptWithReturn t conf compl action = do-  c <- ask-  let d = display c-      rw = theRoot c-  s <- gets $ screenRect . W.screenDetail . W.current . windowset-  hist <- liftIO readHistory-  w <- liftIO $ createWin d rw conf s-  liftIO $ selectInput d w $ exposureMask .|. keyPressMask-  gc <- liftIO $ createGC d w-  liftIO $ setGraphicsExposures d gc False+  XConf { display = d, theRoot = rw } <- ask+  s    <- gets $ screenRect . W.screenDetail . W.current . windowset+  hist <- io readHistory+  w    <- io $ createWin d rw conf s+  io $ selectInput d w $ exposureMask .|. keyPressMask+  gc <- io $ createGC d w+  io $ setGraphicsExposures d gc False   fs <- initXMF (font conf)-  numlock <- asks $ X.numlockMask . X.config+  numlock <- gets $ X.numberlockMask   let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist-      st = (initState d rw w s compl gc fs (XPT t) hs conf)-           { numlockMask = numlock }-  st' <- liftIO $ execStateT runXP st+      st = initState d rw w s compl gc fs (XPT t) hs conf numlock+  st' <- io $ execStateT runXP st    releaseXMF fs-  liftIO $ freeGC d gc+  io $ freeGC d gc   if successful st'     then do-      liftIO $ writeHistory $ M.insertWith-                                (\xs ys -> take (historySize conf)-                                        . historyFilter conf $ xs ++ ys)-                                (showXPrompt t) (historyFilter conf [command st'])+      let prune = take (historySize conf)+      io $ writeHistory $ M.insertWith+                                (\xs ys -> prune . historyFilter conf $ xs ++ ys)+                                (showXPrompt t)+                                (prune $ historyFilter conf [command st'])                                 hist                                 -- we need to apply historyFilter before as well, since                                 -- otherwise the filter would not be applied if@@ -302,8 +319,7 @@  runXP :: XP () runXP = do-  st <- get-  let (d,w) = (dpy &&& win) st+  (d,w) <- gets (dpy &&& win)   status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime   when (status == grabSuccess) $ do           updateWindows@@ -403,13 +419,13 @@   , (xK_a, startOfLine)   , (xK_e, endOfLine)   , (xK_y, pasteString)-  , (xK_c, copyString)   , (xK_Right, moveWord Next)   , (xK_Left, moveWord Prev)   , (xK_Delete, killWord Next)   , (xK_BackSpace, killWord Prev)   , (xK_w, killWord Prev)-  , (xK_q, quit)+  , (xK_g, quit)+  , (xK_bracketleft, quit)   ] ++   map (first $ (,) 0)   [ (xK_Return, setSuccess True >> setDone True)@@ -428,13 +444,13 @@ keyPressHandle :: KeyMask -> KeyStroke -> XP () keyPressHandle m (ks,str) = do   km <- gets (promptKeymap . config)-  mask <- cleanMask m-  case M.lookup (mask,ks) km of+  kmask <- cleanMask m -- mask is defined in ghc7+  case M.lookup (kmask,ks) km of     Just action -> action >> updateWindows     Nothing -> case str of                  "" -> eventLoop handle-                 _ -> when (mask .&. controlMask == 0) $ do-                                 insertString (decodeInput str)+                 _ -> when (kmask .&. controlMask == 0) $ do+                                 insertString (decodeString str)                                  updateWindows                                  completed <- tryAutoComplete                                  when completed $ setSuccess True >> setDone True@@ -505,10 +521,6 @@ pasteString :: XP () pasteString = join $ io $ liftM insertString getSelection --- | Copy the currently entered string into the X selection.-copyString :: XP ()-copyString = gets command >>= io . putSelection- -- | Remove a character at the cursor position deleteString :: Direction1D -> XP () deleteString d =@@ -724,28 +736,15 @@  printComplList :: Display -> Drawable -> GC -> String -> String                -> [Position] -> [Position] -> [[String]] -> XP ()-printComplList _ _ _ _ _ _ _ [] = return ()-printComplList _ _ _ _ _ [] _ _ = return ()-printComplList d drw gc fc bc (x:xs) y (s:ss) = do-  printComplColumn d drw gc fc bc x y s-  printComplList d drw gc fc bc xs y ss--printComplColumn :: Display -> Drawable -> GC -> String -> String-                 -> Position -> [Position] -> [String] -> XP ()-printComplColumn _ _ _ _ _ _ _ [] = return ()-printComplColumn _ _ _ _ _ _ [] _ = return ()-printComplColumn d drw gc fc bc x (y:yy) (s:ss) = do-  printComplString d drw gc fc bc x y s-  printComplColumn d drw gc fc bc x yy ss--printComplString :: Display -> Drawable -> GC -> String -> String-                 -> Position -> Position -> String  -> XP ()-printComplString d drw gc fc bc x y s = do-  st <- get-  if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st)-     then printStringXMF d drw (fontS st) gc-                            (fgHLight $ config st) (bgHLight $ config st) x y s-     else printStringXMF d drw (fontS st) gc fc bc x y s+printComplList d drw gc fc bc xs ys sss =+    zipWithM_ (\x ss ->+        zipWithM_ (\y s -> do+            st <- get+            let (f,b) = if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st)+                            then (fgHLight $ config st,bgHLight $ config st)+                            else (fc,bc)+            printStringXMF d drw (fontS st) gc f b x y s)+        ys ss) xs sss  -- History @@ -768,7 +767,9 @@ writeHistory :: History -> IO () writeHistory hist = do   path <- getHistoryFile-  writeFile path (show hist) `catch` \(SomeException _) -> hPutStrLn stderr "error in writing"+  let filtered = M.filter (not . null) hist+  writeFile path (show filtered) `catch` \(SomeException e) ->+                          hPutStrLn stderr ("error writing history: "++show e)   setFileMode path mode     where mode = ownerReadMode .|. ownerWriteMode @@ -834,14 +835,6 @@                   Just i  -> if i >= length l - 1 then 0 else i + 1                   Nothing -> 0 --- Lift an IO action into the XP-io :: IO a -> XP a-io = liftIO---- Shorthand for fromIntegral-fi :: (Num b, Integral a) => a -> b-fi = fromIntegral- -- | Given a maximum length, splits a list into sublists splitInSubListsAt :: Int -> [a] -> [[a]] splitInSubListsAt _ [] = []@@ -889,3 +882,45 @@ deleteAllDuplicates, deleteConsecutive :: [String] -> [String] deleteAllDuplicates = nub deleteConsecutive = map head . group++newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String)))++-- | Initializes a new HistoryMatches structure to be passed+-- to historyUpMatching+initMatches :: (Functor m, MonadIO m) => m HistoryMatches+initMatches = HistoryMatches <$> liftIO (newIORef ([],Nothing))++historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP ()+historyNextMatching hm@(HistoryMatches ref) next = do+  (completed,completions) <- io $ readIORef ref+  input <- getInput+  if input `elem` completed+     then case completions of+            Just cs -> do+                let cmd = W.focus cs+                modify $ setCommand cmd+                modify $ \s -> s { offset = length cmd }+                io $ writeIORef ref (cmd:completed,Just $ next cs)+            Nothing -> return ()+     else do -- the user typed something new, recompute completions+       io . writeIORef ref . ((,) [input]) . filterMatching input =<< gets commandHistory+       historyNextMatching hm next+    where filterMatching :: String -> W.Stack String -> Maybe (W.Stack String)+          filterMatching prefix = W.filter (prefix `isPrefixOf`) . next++-- | Retrieve the next history element that starts with+-- the current input. Pass it the result of initMatches+-- when creating the prompt. Example:+--+-- > ..+-- > ((modMask,xK_p), shellPrompt . myPrompt =<< initMatches)+-- > ..+-- > myPrompt ref = defaultPrompt+-- >   { promptKeymap = M.union [((0,xK_Up), historyUpMatching ref)+-- >                            ,((0,xK_Down), historyDownMatching ref)]+-- >                            (promptKeymap defaultPrompt)+-- >   , .. }+--+historyUpMatching, historyDownMatching :: HistoryMatches -> XP ()+historyUpMatching hm = historyNextMatching hm W.focusDown'+historyDownMatching hm = historyNextMatching hm W.focusUp'
XMonad/Prompt/AppLauncher.hs view
@@ -18,6 +18,9 @@                                    ,module XMonad.Prompt                                   -- * Use case: launching gimp with file                                   -- $tip++                                  -- * Types+                                   ,Application, AppPrompt,                                   ) where  import XMonad (X(),MonadIO)
XMonad/Prompt/AppendFile.hs view
@@ -22,7 +22,8 @@                                  -- * Usage                                  -- $usage -                                 appendFilePrompt+                                 appendFilePrompt,+                                 AppendFile,                                 ) where  import XMonad.Core@@ -42,6 +43,17 @@ -- and adding an appropriate keybinding, for example: -- -- >  , ((modm .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES")+--+-- Additional notes can be added via regular Haskell or XMonad functions; for+-- example, to preface notes with the time they were made, one could write a+-- binding like+--+-- > ,  ((modm .|. controlMask, xK_n), do+-- >            spawn ("date>>"++"/home/me/NOTES")+-- >            appendFilePrompt defaultXPConfig "/home/me/NOTES"+-- >        )+--+-- (Put the spawn on the line after the prompt to append the time instead.) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings".
XMonad/Prompt/DirExec.hs view
@@ -21,14 +21,20 @@       -- $usage       dirExecPrompt     , dirExecPromptNamed+    , DirExec     ) where +import Prelude hiding (catch)+import Control.Exception import System.Directory import Control.Monad import Data.List import XMonad import XMonad.Prompt +econst :: Monad m => a -> IOException -> m a+econst = const . return+ -- $usage -- 1. In your @~\/.xmonad\/xmonad.hs@: --@@ -98,5 +104,4 @@             liftM2 (&&)                 (doesFileExist x')                 (liftM executable (getPermissions x'))))-    `catch` (return . return . show)-+    `catch` econst []
XMonad/Prompt/Directory.hs view
@@ -4,7 +4,7 @@ -- Copyright   :  (C) 2007 Andrea Rossato, David Roundy -- License     :  BSD3 ----- Maintainer  :  +-- Maintainer  : -- Stability   :  unstable -- Portability :  unportable --@@ -15,7 +15,8 @@ module XMonad.Prompt.Directory (                              -- * Usage                              -- $usage-                             directoryPrompt+                             directoryPrompt,+                             Dir,                               ) where  import XMonad
XMonad/Prompt/Email.hs view
@@ -59,5 +59,5 @@     inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to ->     inputPrompt c "Subject" ?+ \subj ->     inputPrompt c "Body" ?+ \body ->-    io $ runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")+    runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")          >> return ()
XMonad/Prompt/Input.hs view
@@ -18,7 +18,8 @@                             -- $usage                             inputPrompt,                             inputPromptWithCompl,-                            (?+)+                            (?+),+                            InputPrompt,                            ) where  import XMonad.Core
XMonad/Prompt/Layout.hs view
@@ -4,7 +4,7 @@ -- Copyright   :  (C) 2007 Andrea Rossato, David Roundy -- License     :  BSD3 ----- Maintainer  :  +-- Maintainer  : -- Stability   :  unstable -- Portability :  unportable --@@ -21,6 +21,7 @@ import Data.List ( sort, nub ) import XMonad hiding ( workspaces ) import XMonad.Prompt+import XMonad.Prompt.Workspace ( Wor(..) ) import XMonad.StackSet ( workspaces, layout ) import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) ) @@ -42,11 +43,6 @@ -- (which doesn't have this feature).  So all in all, this module is really -- more a proof-of-principle than something you can actually use -- productively.--data Wor = Wor String--instance XPrompt Wor where-    showXPrompt (Wor x) = x  layoutPrompt :: XPConfig -> X () layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset)
XMonad/Prompt/Man.hs view
@@ -20,7 +20,9 @@                           -- $usage                           manPrompt                          , getCommandOutput+                         , Man                          ) where+  import XMonad import XMonad.Prompt
XMonad/Prompt/RunOrRaise.hs view
@@ -16,7 +16,8 @@ module XMonad.Prompt.RunOrRaise     ( -- * Usage       -- $usage-      runOrRaisePrompt+      runOrRaisePrompt,+      RunOrRaisePrompt,     ) where  import XMonad hiding (config)@@ -25,10 +26,14 @@ import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput) +import Prelude hiding (catch)+import Control.Exception import Control.Monad (liftM, liftM2)-import Data.Maybe import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) +econst :: Monad m => a -> IOException -> m a+econst = const . return+ {- $usage 1. In your @~\/.xmonad\/xmonad.hs@: @@ -66,7 +71,7 @@ isApp x = liftM2 (==) pid $ pidof x  pidof :: String -> Query Int-pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return 0)+pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` econst 0  pid :: Query Int pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w)
XMonad/Prompt/Shell.hs view
@@ -1,17 +1,15 @@--------------------------------------------------------------------------------- |--- Module      :  XMonad.Prompt.Shell--- Copyright   :  (C) 2007 Andrea Rossato--- License     :  BSD3------ Maintainer  :  andrea.rossato@unibz.it--- Stability   :  unstable--- Portability :  unportable------ A shell prompt for XMonad---------------------------------------------------------------------------------+{- |+Module      :  XMonad.Prompt.Shell+Copyright   :  (C) 2007 Andrea Rossato+License     :  BSD3 +Maintainer  :  andrea.rossato@unibz.it+Stability   :  unstable+Portability :  unportable++A shell prompt for XMonad+-}+ module XMonad.Prompt.Shell     ( -- * Usage       -- $usage@@ -26,29 +24,35 @@     , safePrompt     ) where -import System.Environment-import Control.Monad-import Data.List-import System.Directory-import System.IO-import System.Posix.Files+import Codec.Binary.UTF8.String (encodeString)+import Control.Exception+import Control.Monad (forM)+import Data.List (isPrefixOf)+import Prelude hiding (catch)+import System.Directory (doesDirectoryExist, getDirectoryContents)+import System.Environment (getEnv)+import System.Posix.Files (getFileStatus, isDirectory)+ import XMonad.Util.Run import XMonad hiding (config) import XMonad.Prompt --- $usage--- 1. In your @~\/.xmonad\/xmonad.hs@:------ > import XMonad.Prompt--- > import XMonad.Prompt.Shell------ 2. In your keybindings add something like:------ >   , ((modm .|. controlMask, xK_x), shellPrompt defaultXPConfig)------ For detailed instruction on editing the key binding see--- "XMonad.Doc.Extending#Editing_key_bindings".+econst :: Monad m => a -> IOException -> m a+econst = const . return +{- $usage+1. In your @~\/.xmonad\/xmonad.hs@:++> import XMonad.Prompt+> import XMonad.Prompt.Shell++2. In your keybindings add something like:++>   , ((modm .|. controlMask, xK_x), shellPrompt defaultXPConfig)++For detailed instruction on editing the key binding see+"XMonad.Doc.Extending#Editing_key_bindings". -}+ data Shell = Shell  instance XPrompt Shell where@@ -58,39 +62,40 @@ shellPrompt :: XPConfig -> X () shellPrompt c = do     cmds <- io getCommands-    mkXPrompt Shell c (getShellCompl cmds) (spawn . encodeOutput)+    mkXPrompt Shell c (getShellCompl cmds) spawn --- | See safe and unsafeSpawn. prompt is an alias for safePrompt;--- safePrompt and unsafePrompt work on the same principles, but will use--- XPrompt to interactively query the user for input; the appearance is--- set by passing an XPConfig as the second argument. The first argument--- is the program to be run with the interactive input.--- You would use these like this:------ >     , ((modm,               xK_b), safePrompt "firefox" greenXPConfig)--- >     , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig)------ Note that you want to use safePrompt for Firefox input, as Firefox--- wants URLs, and unsafePrompt for the XTerm example because this allows--- you to easily start a terminal executing an arbitrary command, like--- 'top'.+{- | See safe and unsafeSpawn. prompt is an alias for safePrompt;+    safePrompt and unsafePrompt work on the same principles, but will use+    XPrompt to interactively query the user for input; the appearance is+    set by passing an XPConfig as the second argument. The first argument+    is the program to be run with the interactive input.+    You would use these like this:++    >     , ((modm,               xK_b), safePrompt "firefox" greenXPConfig)+    >     , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig)++    Note that you want to use safePrompt for Firefox input, as Firefox+    wants URLs, and unsafePrompt for the XTerm example because this allows+    you to easily start a terminal executing an arbitrary command, like+    'top'. -} prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X () prompt = unsafePrompt safePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run-    where run = safeSpawn c . return . encodeOutput+    where run = safeSpawn c . return unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run-    where run a = unsafeSpawn $ c ++ " " ++ encodeOutput a+    where run a = unsafeSpawn $ c ++ " " ++ a  getShellCompl :: [String] -> String -> IO [String] getShellCompl cmds s | s == "" || last s == ' ' = return []                      | otherwise                = do-    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ encodeOutput s ++ "\n")+    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- "+                                                        ++ s ++ "\n")     files <- case f of-               [x] -> do fs <- getFileStatus x+               [x] -> do fs <- getFileStatus (encodeString x)                          if isDirectory fs then return [x ++ "/"]                                            else return [x]                _   -> return f-    return . map decodeInput . uniqSort $ files ++ commandCompletionFunction cmds s+    return . uniqSort $ files ++ commandCompletionFunction cmds s  commandCompletionFunction :: [String] -> String -> [String] commandCompletionFunction cmds str | '/' `elem` str = []@@ -98,8 +103,8 @@  getCommands :: IO [String] getCommands = do-    p  <- getEnv "PATH" `catch` const (return [])-    let ds = split ':' p+    p  <- getEnv "PATH" `catch` econst []+    let ds = filter (/= "") $ split ':' p     es <- forM ds $ \d -> do         exists <- doesDirectoryExist d         if exists@@ -127,7 +132,7 @@  -- | Ask the shell environment for env :: String -> String -> IO String-env variable fallthrough = getEnv variable `catch` \_ -> return fallthrough+env variable fallthrough = getEnv variable `catch` econst fallthrough  {- | Ask the shell what browser the user likes. If the user hasn't defined any    $BROWSER, defaults to returning \"firefox\", since that seems to be the most
XMonad/Prompt/Ssh.hs view
@@ -15,20 +15,26 @@ module XMonad.Prompt.Ssh     ( -- * Usage       -- $usage-      sshPrompt+      sshPrompt,+      Ssh,     ) where +import Prelude hiding (catch)+ import XMonad import XMonad.Util.Run import XMonad.Prompt  import System.Directory import System.Environment+import Control.Exception  import Control.Monad-import Data.List import Data.Maybe +econst :: Monad m => a -> IOException -> m a+econst = const . return+ -- $usage -- 1. In your @~\/.xmonad\/xmonad.hs@: --@@ -66,11 +72,13 @@ sshComplListLocal :: IO [String] sshComplListLocal = do   h <- getEnv "HOME"-  sshComplListFile $ h ++ "/.ssh/known_hosts"+  s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts"+  s2 <- sshComplListConf $ h ++ "/.ssh/config"+  return $ s1 ++ s2  sshComplListGlobal :: IO [String] sshComplListGlobal = do-  env <- getEnv "SSH_KNOWN_HOSTS" `catch` (\_ -> return "/nonexistent")+  env <- getEnv "SSH_KNOWN_HOSTS" `catch` econst "/nonexistent"   fs <- mapM fileExists [ env                         , "/usr/local/etc/ssh/ssh_known_hosts"                         , "/usr/local/etc/ssh_known_hosts"@@ -93,6 +101,22 @@   return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words)          $ filter nonComment          $ lines l++sshComplListConf :: String -> IO [String]+sshComplListConf kh = do+  f <- doesFileExist kh+  if f then sshComplListConf' kh+       else return []++sshComplListConf' :: String -> IO [String]+sshComplListConf' kh = do+  l <- readFile kh+  return $ map (!!1)+         $ filter isHost+         $ map words+         $ lines l+ where+   isHost ws = take 1 ws == ["Host"] && length ws > 1  fileExists :: String -> IO (Maybe String) fileExists kh = do
XMonad/Prompt/Theme.hs view
@@ -15,12 +15,12 @@     ( -- * Usage       -- $usage       themePrompt,+      ThemePrompt,     ) where  import Control.Arrow ( (&&&) ) import qualified Data.Map as M import Data.Maybe ( fromMaybe )-import Data.List import XMonad import XMonad.Prompt import XMonad.Layout.Decoration
XMonad/Prompt/Window.hs view
@@ -20,11 +20,11 @@     -- $usage     windowPromptGoto,     windowPromptBring,-    windowPromptBringCopy+    windowPromptBringCopy,+    WindowPrompt,     ) where  import qualified Data.Map as M-import Data.List  import qualified XMonad.StackSet as W import XMonad@@ -89,7 +89,7 @@       bringAction      = winAction bringWindow       bringCopyAction  = winAction bringCopyWindow -      compList m s = return . filter (isPrefixOf s) . map fst . M.toList $ m+      compList m s = return . filter (searchPredicate c s) . map fst . M.toList $ m   -- | Brings a copy of the specified window into the current workspace.
XMonad/Prompt/Workspace.hs view
@@ -4,7 +4,7 @@ -- Copyright   :  (C) 2007 Andrea Rossato, David Roundy -- License     :  BSD3 ----- Maintainer  :  +-- Maintainer  : -- Stability   :  unstable -- Portability :  unportable --@@ -15,7 +15,10 @@ module XMonad.Prompt.Workspace (                              -- * Usage                              -- $usage-                             workspacePrompt+                             workspacePrompt,++                             -- * For developers+                             Wor(Wor),                               ) where  import XMonad hiding ( workspaces )
XMonad/Prompt/XMonad.hs view
@@ -16,7 +16,8 @@                              -- * Usage                              -- $usage                              xmonadPrompt,-                             xmonadPromptC+                             xmonadPromptC,+                             XMonad,                               ) where  import XMonad
XMonad/Util/Dmenu.hs view
@@ -17,7 +17,7 @@ module XMonad.Util.Dmenu (                 -- * Usage                 -- $usage-                dmenu, dmenuXinerama, dmenuMap, menu, menuMap+                dmenu, dmenuXinerama, dmenuMap, menu, menuArgs, menuMap, menuMapArgs                ) where  import XMonad@@ -29,6 +29,11 @@ -- You can use this module with the following in your Config.hs file: -- -- > import XMonad.Util.Dmenu+--+-- These functions block xmonad's event loop until dmenu exits; this means that+-- programs will not be able to open new windows and you will not be able to+-- change workspaces or input focus until you have responded to the prompt one+-- way or another.  -- %import XMonad.Util.Dmenu @@ -37,20 +42,33 @@ dmenuXinerama :: [String] -> X String dmenuXinerama opts = do     curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int-    io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)+    runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)+    menuArgs "dmenu" ["-xs", show (curscreen+1)] opts +-- | Run dmenu to select an option from a list. dmenu :: [String] -> X String dmenu opts = menu "dmenu" opts +-- | like 'dmenu' but also takes the command to run. menu :: String -> [String] -> X String-menu menuCmd opts = io $ runProcessWithInput menuCmd [] (unlines opts)+menu menuCmd opts = menuArgs menuCmd [] opts +-- | Like 'menu' but also takes a list of command line arguments.+menuArgs :: String -> [String] -> [String] -> X String+menuArgs menuCmd args opts = runProcessWithInput menuCmd args (unlines opts)++-- | Like 'dmenuMap' but also takes the command to run. menuMap :: String -> M.Map String a -> X (Maybe a)-menuMap menuCmd selectionMap = do+menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap++-- | Like 'menuMap' but also takes a list of command line arguments.+menuMapArgs :: String -> [String] -> M.Map String a -> X (Maybe a)+menuMapArgs menuCmd args selectionMap = do   selection <- menuFunction (M.keys selectionMap)   return $ M.lookup selection selectionMap       where-        menuFunction = menu menuCmd+        menuFunction = menuArgs menuCmd args +-- | Run dmenu to select an entry from a map based on the key. dmenuMap :: M.Map String a -> X (Maybe a) dmenuMap selectionMap = menuMap "dmenu" selectionMap
XMonad/Util/Dzen.hs view
@@ -13,36 +13,168 @@ -----------------------------------------------------------------------------  module XMonad.Util.Dzen (+    -- * Flexible interface+    dzenConfig, DzenConfig,+    timeout,+    font,+    xScreen,+    vCenter,+    hCenter,+    center,+    onCurr,+    x,+    y,+    addArgs,++    -- * Legacy interface     dzen,-    dzenWithArgs,     dzenScreen,-    seconds+    dzenWithArgs,++    -- * Miscellaneous+    seconds,+    chomp,+    (>=>),   ) where +import Control.Monad import XMonad+import XMonad.StackSet import XMonad.Util.Run (runProcessWithInputAndWait, seconds) +type DzenConfig = (Int, [String]) -> X (Int, [String])++-- | @dzenConfig config s@ will display the string @s@ according to the+-- configuration @config@.  For example, to display the string @\"foobar\"@ with+-- all the default settings, you can simply call+--+-- > dzenConfig return "foobar"+--+-- Or, to set a longer timeout, you could use+--+-- > dzenConfig (timeout 10) "foobar"+--+-- You can combine configurations with the (>=>) operator.  To display+-- @\"foobar\"@ for 10 seconds on the first screen, you could use+--+-- > dzenConfig (timeout 10 >=> xScreen 0) "foobar"+--+-- As a final example, you could adapt the above to display @\"foobar\"@ for+-- 10 seconds on the current screen with+--+-- > dzenConfig (timeout 10 >=> onCurr xScreen) "foobar"+dzenConfig :: DzenConfig -> String -> X ()+dzenConfig conf s = do+    (t, args) <- conf (seconds 3, [])+    runProcessWithInputAndWait "dzen2" args (chomp s) t++-- | dzen wants exactly one newline at the end of its input, so this can be+-- used for your own invocations of dzen.  However, all functions in this+-- module will call this for you.+chomp :: String -> String+chomp = (++"\n") . reverse . dropWhile ('\n' ==) . reverse++-- | Set the timeout, in seconds.  This defaults to 3 seconds if not+-- specified.+timeout :: Rational -> DzenConfig+timeout = timeoutMicro . seconds++-- | Set the timeout, in microseconds.  Mostly here for the legacy+-- interface.+timeoutMicro :: Int -> DzenConfig+timeoutMicro n (_, ss) = return (n, ss)++-- | Add raw command-line arguments to the configuration.  These will be+-- passed on verbatim to dzen2.  The default includes no arguments.+addArgs :: [String] -> DzenConfig+addArgs ss (n, ss') = return (n, ss ++ ss')++-- | Start dzen2 on a particular screen.  Only works with versions of dzen+-- that support the "-xs" argument.+xScreen :: ScreenId -> DzenConfig+xScreen sc = addArgs ["-xs", show (fromIntegral sc + 1 :: Int)]++-- | Take a screen-specific configuration and supply it with the screen ID+-- of the currently focused screen, according to xmonad.  For example, show+-- a 100-pixel wide bar centered within the current screen, you could use+--+-- > dzenConfig (onCurr (hCenter 100)) "foobar"+--+-- Of course, you can still combine these with (>=>); for example, to center+-- the string @\"foobar\"@ both horizontally and vertically in a 100x14 box+-- using the lovely Terminus font, you could use+--+-- > terminus = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*"+-- > dzenConfig (onCurr (center 100 14) >=> font terminus) "foobar"+onCurr :: (ScreenId -> DzenConfig) -> DzenConfig+onCurr f conf = gets (screen . current . windowset) >>= flip f conf++-- | Put the top of the dzen bar at a particular pixel.+x :: Int -> DzenConfig+x n = addArgs ["-x", show n]+-- | Put the left of the dzen bar at a particular pixel.+y :: Int -> DzenConfig+y n = addArgs ["-y", show n]++-- | Specify the font.  Check out xfontsel to get the format of the String+-- right; if your dzen supports xft, then you can supply that here, too.+font :: String -> DzenConfig+font fn = addArgs ["-fn", fn]++-- | @vCenter height sc@ sets the configuration to have the dzen bar appear+-- on screen @sc@ with height @height@, vertically centered with respect to+-- the actual size of that screen.+vCenter :: Int -> ScreenId -> DzenConfig+vCenter = center' rect_height "-h" "-y"++-- | @hCenter width sc@ sets the configuration to have the dzen bar appear+-- on screen @sc@ with width @width@, horizontally centered with respect to+-- the actual size of that screen.+hCenter :: Int -> ScreenId -> DzenConfig+hCenter = center' rect_width  "-w" "-x"++-- | @center width height sc@ sets the configuration to have the dzen bar+-- appear on screen @sc@ with width @width@ and height @height@, centered+-- both horizontally and vertically with respect to the actual size of that+-- screen.+center :: Int -> Int -> ScreenId -> DzenConfig+center width height sc = hCenter width sc >=> vCenter height sc++-- Center things along a single dimension on a particular screen.+center' :: (Rectangle -> Dimension) -> String -> String -> Int -> ScreenId -> DzenConfig+center' selector extentName positionName extent sc conf = do+    rect <- gets (detailFromScreenId sc . windowset)+    case rect of+        Nothing -> return conf+        Just r  -> addArgs+            [extentName  , show extent,+             positionName, show ((fromIntegral (selector r) - extent) `div` 2),+             "-xs"       , show (fromIntegral sc + 1 :: Int)+            ] conf++-- Get the rectangle outlining a particular screen.+detailFromScreenId :: ScreenId -> WindowSet -> Maybe Rectangle+detailFromScreenId sc ws = fmap screenRect maybeSD where+    c       = current ws+    v       = visible ws+    mapping = map (\s -> (screen s, screenDetail s)) (c:v)+    maybeSD = lookup sc mapping+ -- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds. -- Example usage: -- -- > dzen "Hi, mom!" (5 `seconds`) dzen :: String -> Int -> X ()-dzen str timeout = dzenWithArgs str [] timeout+dzen = flip (dzenConfig . timeoutMicro)  -- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen. -- Example usage: -- -- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`) dzenWithArgs :: String -> [String] -> Int -> X ()-dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout-  -- dzen seems to require the input to terminate with exactly one newline.-  where unchomp s@['\n'] = s-        unchomp []       = ['\n']-        unchomp (c:cs)   = c : unchomp cs+dzenWithArgs str args t = dzenConfig (timeoutMicro t >=> addArgs args) str  -- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@. -- Requires dzen to be compiled with Xinerama support.-dzenScreen :: ScreenId -> String -> Int -> X()-dzenScreen sc str timeout = dzenWithArgs str ["-xs", screen] timeout-    where screen  = toXineramaArg sc-          toXineramaArg n = show ( ((fromIntegral n)+1)::Int )+dzenScreen :: ScreenId -> String -> Int -> X ()+dzenScreen sc str t = dzenConfig (timeoutMicro t >=> xScreen sc) str
XMonad/Util/EZConfig.hs view
@@ -27,7 +27,9 @@                              -- * Emacs-style keybinding specifications                               mkKeymap, checkKeymap,-                             mkNamedKeymap+                             mkNamedKeymap,++                             parseKey -- used by XMonad.Util.Paste                             ) where  import XMonad@@ -103,7 +105,7 @@ -- >                 `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a removeKeys conf keyList =-    conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ return ()) }+    conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ repeat ()) }  -- | Like 'removeKeys', except using short @String@ key descriptors --   like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the@@ -125,7 +127,7 @@ removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a removeMouseBindings conf mouseBindingList =     conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference`-                                   M.fromList (zip mouseBindingList $ return ()) }+                                   M.fromList (zip mouseBindingList $ repeat ()) }   --------------------------------------------------------------@@ -343,6 +345,7 @@ -- > <XF86MailForward> -- > <XF86Pictures> -- > <XF86Music>+-- > <XF86TouchpadToggle> -- > <XF86_Switch_VT_1>-<XF86_Switch_VT_12> -- > <XF86_Ungrab> -- > <XF86_ClearGrab>@@ -410,9 +413,9 @@ parseModifier c =  (string "M-" >> return (modMask c))                +++ (string "C-" >> return controlMask)                +++ (string "S-" >> return shiftMask)-               +++ do char 'M'+               +++ do _ <- char 'M'                       n <- satisfy (`elem` ['1'..'5'])-                      char '-'+                      _ <- char '-'                       return $ indexMod (read [n] - 1)     where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] @@ -428,11 +431,11 @@  -- | Parse a special key name (one enclosed in angle brackets). parseSpecial :: ReadP KeySym-parseSpecial = do char '<'+parseSpecial = do _   <- char '<'                   key <- choice [ string name >> return k                                 | (name,k) <- keyNames                                 ]-                  char '>'+                  _   <- char '>'                   return key  -- | A list of all special key names and their associated KeySyms.@@ -648,6 +651,7 @@                  , "XF86MailForward"                  , "XF86Pictures"                  , "XF86Music"+                 , "XF86TouchpadToggle"                  , "XF86_Switch_VT_1"                  , "XF86_Switch_VT_2"                  , "XF86_Switch_VT_3"
+ XMonad/Util/ExtensibleState.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.ExtensibleState+-- Copyright   :  (c) Daniel Schoepe 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  daniel.schoepe@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- Module for storing custom mutable state in xmonad.+--+-----------------------------------------------------------------------------++module XMonad.Util.ExtensibleState (+                              -- * Usage+                              -- $usage+                              put+                              , modify+                              , remove+                              , get+                              , gets+                              ) where++import Data.Typeable (typeOf,Typeable,cast)+import qualified Data.Map as M+import XMonad.Core+import qualified Control.Monad.State as State+import Data.Maybe (fromMaybe)++-- ---------------------------------------------------------------------+-- $usage+--+-- To utilize this feature in a contrib module, create a data type+-- and make it an instance of ExtensionClass. You can then use+-- the functions from this module for storing and retrieving your data:+--+-- > {-# LANGUAGE DeriveDataTypeable #-}+-- > import qualified XMonad.Util.ExtensibleState as XS+-- >+-- > data ListStorage = ListStorage [Integer] deriving Typeable+-- > instance ExtensionClass ListStorage where+-- >   initialValue = ListStorage []+-- >+-- > .. XS.put (ListStorage [23,42])+--+-- To retrieve the stored value call:+--+-- > .. XS.get+--+-- If the type can't be inferred from the usage of the retrieved data, you+-- have to add an explicit type signature:+--+-- > .. XS.get :: X ListStorage+--+-- To make your data persistent between restarts, the data type needs to be+-- an instance of Read and Show and the instance declaration has to be changed:+--+-- > data ListStorage = ListStorage [Integer] deriving (Typeable,Read,Show)+-- >+-- > instance ExtensionClass ListStorage where+-- >   initialValue = ListStorage []+-- >   extensionType = PersistentExtension+--+-- One should take care that the string representation of the chosen type+-- is unique among the stored values, otherwise it will be overwritten.+-- Normally these string representations contain fully qualified module names+-- when automatically deriving Typeable, so+-- name collisions should not be a problem in most cases.+-- A module should not try to store common datatypes(e.g. a list of Integers)+-- without a custom data type as a wrapper to avoid collisions with other modules+-- trying to store the same data type without a wrapper.+--++-- | Modify the map of state extensions by applying the given function.+modifyStateExts :: (M.Map String (Either String StateExtension)+                   -> M.Map String (Either String StateExtension))+                -> X ()+modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) }++-- | Apply a function to a stored value of the matching type or the initial value if there+-- is none.+modify :: ExtensionClass a => (a -> a) -> X ()+modify f = put . f =<< get++-- | Add a value to the extensible state field. A previously stored value with the same+-- type will be overwritten. (More precisely: A value whose string representation of its type+-- is equal to the new one's)+put :: ExtensionClass a => a -> X ()+put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v++-- | Try to retrieve a value of the requested type, return an initial value if there is no such value.+get :: ExtensionClass a => X a+get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables+  where toValue val = maybe initialValue id $ cast val+        getState' :: ExtensionClass a => a -> X a+        getState' k = do+          v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState+          case v of+            Just (Right (StateExtension val)) -> return $ toValue val+            Just (Right (PersistentExtension val)) -> return $ toValue val+            Just (Left str) | PersistentExtension x <- extensionType k -> do+                let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x+                put (val `asTypeOf` k)+                return val+            _ -> return $ initialValue+        safeRead str = case reads str of+                         [(x,"")] -> Just x+                         _ -> Nothing++gets :: ExtensionClass a => (a -> b) -> X b+gets = flip fmap get++-- | Remove the value from the extensible state field that has the same type as the supplied argument+remove :: ExtensionClass a => a -> X ()+remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
+ XMonad/Util/Font.hs view
@@ -0,0 +1,197 @@+{-# LANGUAGE CPP #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Font+-- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for abstracting a font facility over Core fonts and Xft+--+-----------------------------------------------------------------------------++module XMonad.Util.Font+    ( -- * Usage:+      -- $usage+      XMonadFont(..)+    , initXMF+    , releaseXMF+    , initCoreFont+    , releaseCoreFont+    , initUtf8Font+    , releaseUtf8Font+    , Align (..)+    , stringPosition+    , textWidthXMF+    , textExtentsXMF+    , printStringXMF+    , stringToPixel+    , fi+    ) where++import Prelude hiding (catch)+import XMonad+import Foreign+import Control.Applicative+import Control.Exception+import Data.Maybe++#ifdef XFT+import Data.List+import Graphics.X11.Xft+import Graphics.X11.Xrender+#endif++-- Hide the Core Font/Xft switching here+data XMonadFont = Core FontStruct+                | Utf8 FontSet+#ifdef XFT+                | Xft  XftFont+#endif++-- $usage+-- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples++-- | Get the Pixel value for a named color: if an invalid name is+-- given the black pixel will be returned.+stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel+stringToPixel d s = fromMaybe fallBack <$> io getIt+    where getIt    = initColor d s+          fallBack = blackPixel d (defaultScreen d)++econst :: a -> IOException -> a+econst = const++-- | Given a fontname returns the font structure. If the font name is+--  not valid the default font will be loaded and returned.+initCoreFont :: String -> X FontStruct+initCoreFont s = do+  d <- asks display+  io $ catch (getIt d) (fallBack d)+      where getIt    d = loadQueryFont d s+            fallBack d = econst $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++releaseCoreFont :: FontStruct -> X ()+releaseCoreFont fs = do+  d <- asks display+  io $ freeFont d fs++initUtf8Font :: String -> X FontSet+initUtf8Font s = do+  d <- asks display+  (_,_,fs) <- io $ catch (getIt d) (fallBack d)+  return fs+      where getIt    d = createFontSet d s+            fallBack d = econst $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++releaseUtf8Font :: FontSet -> X ()+releaseUtf8Font fs = do+  d <- asks display+  io $ freeFontSet d fs++-- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend+-- Example: 'xft: Sans-10'+initXMF :: String -> X XMonadFont+initXMF s =+#ifdef XFT+  if xftPrefix `isPrefixOf` s then+     do dpy <- asks display+        xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)+        return (Xft xftdraw)+  else+#endif+      fmap Utf8 $ initUtf8Font s+#ifdef XFT+  where xftPrefix = "xft:"+#endif++releaseXMF :: XMonadFont -> X ()+#ifdef XFT+releaseXMF (Xft xftfont) = do+  dpy <- asks display+  io $ xftFontClose dpy xftfont+#endif+releaseXMF (Utf8 fs) = releaseUtf8Font fs+releaseXMF (Core fs) = releaseCoreFont fs+++textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int+textWidthXMF _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s+textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s+#ifdef XFT+textWidthXMF dpy (Xft xftdraw) s = liftIO $ do+    gi <- xftTextExtents dpy xftdraw s+    return $ xglyphinfo_xOff gi+#endif++textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)+textExtentsXMF (Utf8 fs) s = do+  let (_,rl)  = wcTextExtents fs s+      ascent  = fi $ - (rect_y rl)+      descent = fi $ rect_height rl + (fi $ rect_y rl)+  return (ascent, descent)+textExtentsXMF (Core fs) s = do+  let (_,a,d,_) = textExtents fs s+  return (a,d)+#ifdef XFT+textExtentsXMF (Xft xftfont) _ = io $ do+  ascent  <- fi `fmap` xftfont_ascent  xftfont+  descent <- fi `fmap` xftfont_descent xftfont+  return (ascent, descent)+#endif++-- | String position+data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int+                deriving (Show, Read)++-- | Return the string x and y 'Position' in a 'Rectangle', given a+-- 'FontStruct' and the 'Align'ment+stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position)+stringPosition dpy fs (Rectangle _ _ w h) al s = do+  width <- textWidthXMF dpy fs s+  (a,d) <- textExtentsXMF fs s+  let y = fi $ ((h - fi (a + d)) `div` 2) + fi a;+      x = case al of+            AlignCenter -> fi (w `div` 2) - fi (width `div` 2)+            AlignLeft   -> 1+            AlignRight  -> fi (w - (fi width + 1));+            AlignRightOffset offset -> fi (w - (fi width + 1)) - fi offset;+  return (x,y)++printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String+            -> Position -> Position -> String  -> m ()+printStringXMF d p (Core fs) gc fc bc x y s = io $ do+    setFont d gc $ fontFromFontStruct fs+    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]+    setForeground d gc fc'+    setBackground d gc bc'+    drawImageString d p gc x y s+printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do+    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]+    setForeground d gc fc'+    setBackground d gc bc'+    io $ wcDrawImageString d p fs gc x y s+#ifdef XFT+printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do+  let screen   = defaultScreenOfDisplay dpy+      colormap = defaultColormapOfScreen screen+      visual   = defaultVisualOfScreen screen+  bcolor <- stringToPixel dpy bc+  (a,d)  <- textExtentsXMF fs s+  gi <- io $ xftTextExtents dpy font s+  io $ setForeground dpy gc bcolor+  io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))+                                (y - fi a)+                                (fi $ xglyphinfo_xOff gi)+                                (fi $ a + d)+  io $ withXftDraw dpy drw visual colormap $+         \draw -> withXftColorName dpy visual colormap fc $+                   \color -> xftDrawString draw color font x y s+#endif++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
− XMonad/Util/Font.hsc 
@@ -1,200 +0,0 @@-------------------------------------------------------------------------------- |--- Module      :  XMonad.Util.Font--- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen--- License     :  BSD-style (see xmonad/LICENSE)------ Maintainer  :  andrea.rossato@unibz.it--- Stability   :  unstable--- Portability :  unportable------ A module for abstracting a font facility over Core fonts and Xft-----------------------------------------------------------------------------------module XMonad.Util.Font-    ( -- * Usage:-      -- $usage-      XMonadFont(..)-    , initXMF-    , releaseXMF-    , initCoreFont-    , releaseCoreFont-    , initUtf8Font-    , releaseUtf8Font-    , Align (..)-    , stringPosition-    , textWidthXMF-    , textExtentsXMF-    , printStringXMF-    , stringToPixel-    , decodeInput-    , encodeOutput-    ) where--import XMonad-import Foreign-import Control.Applicative-import Data.Maybe--#ifdef XFT-import Data.List-import Graphics.X11.Xft-import Graphics.X11.Xrender-#endif--import Codec.Binary.UTF8.String (encodeString, decodeString)----- Hide the Core Font/Xft switching here-data XMonadFont = Core FontStruct-                | Utf8 FontSet-#ifdef XFT-                | Xft  XftFont-#endif---- $usage--- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples---- | Get the Pixel value for a named color: if an invalid name is--- given the black pixel will be returned.-stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel-stringToPixel d s = fromMaybe fallBack <$> io getIt-    where getIt    = initColor d s-          fallBack = blackPixel d (defaultScreen d)----- | Given a fontname returns the font structure. If the font name is---  not valid the default font will be loaded and returned.-initCoreFont :: String -> X FontStruct-initCoreFont s = do-  d <- asks display-  io $ catch (getIt d) (fallBack d)-      where getIt    d = loadQueryFont d s-            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"--releaseCoreFont :: FontStruct -> X ()-releaseCoreFont fs = do-  d <- asks display-  io $ freeFont d fs--initUtf8Font :: String -> X FontSet-initUtf8Font s = do-  d <- asks display-  (_,_,fs) <- io $ catch (getIt d) (fallBack d)-  return fs-      where getIt    d = createFontSet d s-            fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"--releaseUtf8Font :: FontSet -> X ()-releaseUtf8Font fs = do-  d <- asks display-  io $ freeFontSet d fs---- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend--- Example: 'xft: Sans-10'-initXMF :: String -> X XMonadFont-initXMF s =-#ifdef XFT-  if xftPrefix `isPrefixOf` s then-     do dpy <- asks display-        xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)-        return (Xft xftdraw)-  else-#endif-      fmap Utf8 $ initUtf8Font s-#ifdef XFT-  where xftPrefix = "xft:"-#endif--releaseXMF :: XMonadFont -> X ()-#ifdef XFT-releaseXMF (Xft xftfont) = do-  dpy <- asks display-  io $ xftFontClose dpy xftfont-#endif-releaseXMF (Utf8 fs) = releaseUtf8Font fs-releaseXMF (Core fs) = releaseCoreFont fs---textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int-textWidthXMF _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s-textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s-#ifdef XFT-textWidthXMF dpy (Xft xftdraw) s = liftIO $ do-    gi <- xftTextExtents dpy xftdraw s-    return $ xglyphinfo_xOff gi-#endif--textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)-textExtentsXMF (Utf8 fs) s = do-  let (_,rl)  = wcTextExtents fs s-      ascent  = fi $ - (rect_y rl)-      descent = fi $ rect_height rl + (fi $ rect_y rl)-  return (ascent, descent)-textExtentsXMF (Core fs) s = do-  let (_,a,d,_) = textExtents fs s-  return (a,d)-#ifdef XFT-textExtentsXMF (Xft xftfont) _ = io $ do-  ascent  <- fi `fmap` xftfont_ascent  xftfont-  descent <- fi `fmap` xftfont_descent xftfont-  return (ascent, descent)-#endif---- | String position-data Align = AlignCenter | AlignRight | AlignLeft---- | Return the string x and y 'Position' in a 'Rectangle', given a--- 'FontStruct' and the 'Align'ment-stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position)-stringPosition dpy fs (Rectangle _ _ w h) al s = do-  width <- textWidthXMF dpy fs s-  (a,d) <- textExtentsXMF fs s-  let y = fi $ ((h - fi (a + d)) `div` 2) + fi a;-      x = case al of-            AlignCenter -> fi (w `div` 2) - fi (width `div` 2)-            AlignLeft   -> 1-            AlignRight  -> fi (w - (fi width + 1));-  return (x,y)--printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String-            -> Position -> Position -> String  -> m ()-printStringXMF d p (Core fs) gc fc bc x y s = io $ do-    setFont d gc $ fontFromFontStruct fs-    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]-    setForeground d gc fc'-    setBackground d gc bc'-    drawImageString d p gc x y s-printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do-    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]-    setForeground d gc fc'-    setBackground d gc bc'-    io $ wcDrawImageString d p fs gc x y s-#ifdef XFT-printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do-  let screen   = defaultScreenOfDisplay dpy-      colormap = defaultColormapOfScreen screen-      visual   = defaultVisualOfScreen screen-  bcolor <- stringToPixel dpy bc-  (a,d)  <- textExtentsXMF fs s-  gi <- io $ xftTextExtents dpy font s-  io $ setForeground dpy gc bcolor-  io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))-                                (y - fi a)-                                (fi $ xglyphinfo_xOff gi)-                                (fi $ a + d)-  io $ withXftDraw dpy drw visual colormap $-         \draw -> withXftColorName dpy visual colormap fc $-                   \color -> xftDrawString draw color font x y s-#endif--decodeInput :: String -> String-decodeInput = decodeString--encodeOutput :: String -> String-encodeOutput = encodeString---- | Short-hand for 'fromIntegral'-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral
+ XMonad/Util/Image.hs view
@@ -0,0 +1,87 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Image+-- Copyright   :  (c) 2010 Alejandro Serrano+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  trupill@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Utilities for manipulating [[Bool]] as images+--+-----------------------------------------------------------------------------++module XMonad.Util.Image+    ( -- * Usage:+      -- $usage+      Placement(..),+      iconPosition,+      drawIcon,+    ) where++import XMonad+import XMonad.Util.Font (stringToPixel,fi)++-- | Placement of the icon in the title bar+data Placement = OffsetLeft Int Int   -- ^ An exact amount of pixels from the upper left corner+                 | OffsetRight Int Int  -- ^ An exact amount of pixels from the right left corner+                 | CenterLeft Int        -- ^ Centered in the y-axis, an amount of pixels from the left+                 | CenterRight Int       -- ^ Centered in the y-axis, an amount of pixels from the right+                   deriving (Show, Read)+                   +-- $usage+-- This module uses matrices of boolean values as images. When drawing them,+-- a True value tells that we want the fore color, and a False value that we+-- want the background color to be painted.+-- In the module we suppose that those matrices are represented as [[Bool]],+-- so the lengths of the inner lists must be the same.+--+-- See "Xmonad.Layout.Decoration" for usage examples++-- | Gets the ('width', 'height') of an image+imageDims :: [[Bool]] -> (Int, Int)+imageDims img = (length (head img), length img)++-- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing+--   the image given its 'Placement'+iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position)+iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y)+iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon =+  let (icon_w, _) = imageDims icon+  in (fi w - fi x - fi icon_w, fi y)+iconPosition (Rectangle _ _ _ h) (CenterLeft x) icon =+  let (_, icon_h) = imageDims icon+  in  (fi x, fi (h `div` 2) - fi (icon_h `div` 2))+iconPosition (Rectangle _ _ w h) (CenterRight x) icon =+  let (icon_w, icon_h) = imageDims icon+  in  (fi w - fi x - fi icon_w, fi (h `div` 2) - fi (icon_h `div` 2))++-- | Converts an image represented as [[Bool]] to a series of points+--   to be painted (the ones with True values)+iconToPoints :: [[Bool]] -> [Point]+iconToPoints icon =+  let labels_inside = map (zip (iterate (1+) 0)) icon+      filtered_inside = map (\l -> [x | (x, t) <- l, t]) labels_inside+      labels_outside = zip (iterate (1+) 0) filtered_inside+  in [Point x y | (y, l) <- labels_outside, x <- l]++-- | Displaces a point ('a', 'b') along a vector ('x', 'y')+movePoint :: Position -> Position -> Point -> Point+movePoint x y (Point a b) = Point (a + x) (b + y)++-- | Displaces a list of points along a vector 'x', 'y'+movePoints :: Position -> Position -> [Point] -> [Point]+movePoints x y points = map (movePoint x y) points++-- | Draw an image into a X surface+drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String+            ->String -> Position -> Position -> [[Bool]] -> m ()+drawIcon dpy drw gc fc bc x y icon = do+  let (i_w, i_h) = imageDims icon+  fcolor <- stringToPixel dpy fc+  bcolor <- stringToPixel dpy bc+  io $ setForeground dpy gc bcolor+  io $ fillRectangle dpy drw gc x y (fi i_w) (fi i_h)+  io $ setForeground dpy gc fcolor+  io $ drawPoints dpy drw gc (movePoints x y (iconToPoints icon)) coordModeOrigin
XMonad/Util/Loggers.hs view
@@ -52,7 +52,9 @@ import XMonad.Util.Font (Align (..)) import XMonad.Util.NamedWindows (getName) +import Prelude hiding (catch) import Control.Applicative ((<$>))+import Control.Exception import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe) import Data.Traversable (traverse)@@ -62,6 +64,9 @@ import System.Process (runInteractiveCommand) import System.Time +econst :: Monad m => a -> IOException -> m a+econst = const . return+ -- $usage -- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@: --@@ -116,7 +121,7 @@ --   At some point it would be nice to make this more general\/have --   fewer dependencies (assumes @\/usr\/bin\/acpi@ and @sed@ are installed.) battery :: Logger-battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'"+battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'"  -- | Get the current date and time, and format them via the --   given format string.  The format used is the same as that used@@ -138,7 +143,7 @@ -- | Create a 'Logger' from an arbitrary shell command. logCmd :: String -> Logger logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c-                   fmap Just (hGetLine out) `catch` (const $ return Nothing)+                   fmap Just (hGetLine out) `catch` econst Nothing                    -- no need to waitForProcess, we ignore SIGCHLD  -- | Get a count of filtered files in a directory.@@ -254,7 +259,7 @@     case a of        AlignCenter -> toL (take n $ padhalf l ++ l ++ cs)        AlignRight -> toL (reverse (take n $ reverse l ++ cs))-       AlignLeft -> toL (take n $ l ++ cs)+       _ -> toL (take n $ l ++ cs)   where     toL = return . Just     cs  = cycle str
XMonad/Util/NamedActions.hs view
@@ -42,27 +42,17 @@   import XMonad.Actions.Submap(submap)-import XMonad(KeySym, KeyMask, X, Layout, Message,-              XConfig(keys, layoutHook, modMask, terminal, workspaces, XConfig),-              io, spawn, whenJust, ChangeLayout(NextLayout), IncMasterN(..),-              Resize(..), kill, refresh, screenWorkspace, sendMessage, setLayout,-              windows, withFocused, controlMask, mod1Mask, mod2Mask, mod3Mask,-              mod4Mask, mod5Mask, shiftMask, xK_1, xK_9, xK_Return, xK_Tab, xK_c,-              xK_comma, xK_e, xK_h, xK_j, xK_k, xK_l, xK_m, xK_n, xK_p,-              xK_period, xK_q, xK_r, xK_space, xK_t, xK_w, keysymToString)-import System.Posix.Process(executeFile, forkProcess)+import XMonad+import System.Posix.Process(executeFile) import Control.Arrow(Arrow((&&&), second, (***)))-import Data.Bits(Bits((.&.), complement, (.|.)))-import Data.Function((.), const, ($), flip, id)-import Data.List((++), filter, zip, map, concatMap, null, unlines,-                 groupBy)+import Data.Bits(Bits((.&.), complement))+import Data.List (groupBy) import System.Exit(ExitCode(ExitSuccess), exitWith)  import Control.Applicative ((<*>))  import qualified Data.Map as M import qualified XMonad.StackSet as W-import qualified XMonad  -- $usage -- Here is an example config that demonstrates the usage of 'sendMessage'',@@ -212,7 +202,7 @@ -- | An action to send to 'addDescrKeys' for showing the keybindings. See also 'showKm' and 'showKmSimple' xMessage :: [((KeyMask, KeySym), NamedAction)] -> NamedAction xMessage x = addName "Show Keybindings" $ io $ do-    forkProcess $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing+    xfork $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing     return ()  -- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding
XMonad/Util/NamedScratchpad.hs view
@@ -22,18 +22,17 @@   customFloating,   NamedScratchpads,   namedScratchpadAction,+  allNamedScratchpadAction,   namedScratchpadManageHook,   namedScratchpadFilterOutWorkspace   ) where  import XMonad-import XMonad.Core-import XMonad.ManageHook (composeAll,doFloat) import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)  import Control.Monad (filterM)-import Data.Maybe (maybe,listToMaybe)+import Data.Maybe (listToMaybe)  import qualified XMonad.StackSet as W @@ -118,28 +117,34 @@ namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration                       -> String           -- ^ Scratchpad name                       -> X ()-namedScratchpadAction confs n-    | Just conf <- findByName confs n = withWindowSet $ \s -> do-        -- try to find it on the current workspace-        filterCurrent <- filterM (runQuery (query conf))-                            ( (maybe [] W.integrate . W.stack .-                                    W.workspace . W.current) s)-        case filterCurrent of-            (x:_) -> do-                -- create hidden workspace if it doesn't exist-                if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))-                    then addHiddenWorkspace scratchpadWorkspaceTag-                    else return ()-                -- push window there-                windows $ W.shiftWin scratchpadWorkspaceTag x-            [] -> do-                -- try to find it on all workspaces-                filterAll <- filterM (runQuery (query conf)) (W.allWindows s)-                case filterAll of-                    (x:_) -> windows $ W.shiftWin (W.currentTag s) x-                    []    -> runApplication conf+namedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ head ws) +allNamedScratchpadAction :: NamedScratchpads+                         -> String+                         -> X ()+allNamedScratchpadAction = someNamedScratchpadAction mapM_++someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ())+                          -> NamedScratchpads+                          -> String+                          -> X ()+someNamedScratchpadAction f confs n+    | Just conf <- findByName confs n = withWindowSet $ \s -> do+                     filterCurrent <- filterM (runQuery (query conf))+                                        ((maybe [] W.integrate . W.stack . W.workspace . W.current) s)+                     filterAll <- filterM (runQuery (query conf)) (W.allWindows s)+                     case filterCurrent of+                       [] -> do+                         case filterAll of+                           [] -> runApplication conf+                           _  -> f (windows . W.shiftWin (W.currentTag s)) filterAll+                       _ -> do+                         if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))+                             then addHiddenWorkspace scratchpadWorkspaceTag+                             else return ()+                         f (windows . W.shiftWin scratchpadWorkspaceTag) filterAll     | otherwise = return ()+  -- tag of the scratchpad workspace scratchpadWorkspaceTag :: String
XMonad/Util/Paste.hs view
@@ -28,8 +28,10 @@ import Control.Monad.Reader (asks) import XMonad.Operations (withFocused) import Data.Char (isUpper)-import Graphics.X11.Xlib.Misc (stringToKeysym)+import Data.Maybe (listToMaybe) import XMonad.Util.XSelection (getSelection)+import XMonad.Util.EZConfig (parseKey)+import Text.ParserCombinators.ReadP (readP_to_S)  {- $usage @@ -70,7 +72,8 @@    have trouble with any 'Char' outside ASCII. -} pasteChar :: KeyMask -> Char -> X ()-pasteChar m c = sendKey m $ stringToKeysym [c]+pasteChar m c = sendKey m $ maybe (stringToKeysym [c]) fst+                $ listToMaybe $ readP_to_S parseKey [c]  sendKey :: KeyMask -> KeySym -> X () sendKey = (withFocused .) . sendKeyWindow
+ XMonad/Util/PositionStore.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DeriveDataTypeable #-}++----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.PositionStore+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-- A utility module to store information about position and size of a window.+-- See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this.+--+-----------------------------------------------------------------------------++module XMonad.Util.PositionStore (+        getPosStore,+        modifyPosStore,++        posStoreInsert,+        posStoreMove,+        posStoreQuery,+        posStoreRemove,+        PositionStore,+    ) where++import XMonad+import qualified XMonad.Util.ExtensibleState as XS+import qualified Data.Map as M++-- Store window positions relative to the upper left screen edge+-- and windows sizes as well as positions as fractions of the screen size.+-- This way windows can be easily relocated and scaled when switching screens.++data PositionStore = PS (M.Map Window PosStoreRectangle)+                            deriving (Read,Show,Typeable)+data PosStoreRectangle = PSRectangle Double Double Double Double+                            deriving (Read,Show,Typeable)++instance ExtensionClass PositionStore where+  initialValue = PS M.empty+  extensionType = PersistentExtension++getPosStore :: X (PositionStore)+getPosStore = XS.get++modifyPosStore :: (PositionStore -> PositionStore) -> X ()+modifyPosStore = XS.modify++posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore+posStoreInsert (PS posStoreMap) w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) =+    let offsetX = x - srX+        offsetY = y - srY+    in PS $ M.insert w (PSRectangle (fromIntegral offsetX / fromIntegral srWh)+                                               (fromIntegral offsetY / fromIntegral srHt)+                                               (fromIntegral wh / fromIntegral srWh)+                                               (fromIntegral ht / fromIntegral srHt)) posStoreMap++posStoreRemove :: PositionStore -> Window -> PositionStore+posStoreRemove (PS posStoreMap) w = PS $ M.delete w posStoreMap++posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle+posStoreQuery (PS posStoreMap) w (Rectangle srX srY srWh srHt) = do+    (PSRectangle x y wh ht) <- M.lookup w posStoreMap+    let realWh = fromIntegral srWh * wh+        realHt = fromIntegral srHt * ht+        realOffsetX = fromIntegral srWh * x+        realOffsetY = fromIntegral srHt * y+    return (Rectangle (srX + round realOffsetX) (srY + round realOffsetY)+                        (round realWh) (round realHt))++posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore+posStoreMove posStore w x y oldSr newSr =+    case (posStoreQuery posStore w oldSr) of+        Nothing -> posStore     -- not in store, can't move -> do nothing+        Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr
XMonad/Util/Replace.hs view
@@ -19,7 +19,7 @@     ( -- * Usage       -- $usage       replace- +       -- * Notes       -- $shortcomings @@ -52,7 +52,7 @@ -- $getArgs -- You can use 'System.Environment.getArgs' to watch for an explicit -- @--replace@ flag:--- +-- -- > import XMonad -- > import XMonad.Util.Replace (replace) -- > import Control.Monad (when)
XMonad/Util/Run.hs view
@@ -31,11 +31,10 @@                           hPutStr, hPutStrLn  -- re-export for convenience                          ) where +import Codec.Binary.UTF8.String import System.Posix.IO-import System.Posix.Process (executeFile, forkProcess, createSession)-import System.Posix.Types (ProcessID)+import System.Posix.Process (createSession, executeFile, forkProcess) import Control.Concurrent (threadDelay)-import Control.Exception.Extensible (try,SomeException) import System.IO import System.Process (runInteractiveProcess) import XMonad@@ -53,9 +52,10 @@ -- "XMonad.Util.Dzen"  -- | Returns the output.-runProcessWithInput :: FilePath -> [String] -> String -> IO String-runProcessWithInput cmd args input = do-    (pin, pout, perr, _) <- runInteractiveProcess cmd args Nothing Nothing+runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String+runProcessWithInput cmd args input = io $ do+    (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd)+                                            (map encodeString args) Nothing Nothing     hPutStr pin input     hClose pin     output <- hGetContents pout@@ -65,11 +65,12 @@     -- no need to waitForProcess, we ignore SIGCHLD     return output --- | Wait is in µs (microseconds)-runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()-runProcessWithInputAndWait cmd args input timeout = do-    forkProcess $ do-        (pin, pout, perr, _) <- runInteractiveProcess cmd args Nothing Nothing+-- | Wait is in &#956; (microseconds)+runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m ()+runProcessWithInputAndWait cmd args input timeout = io $ do+    _ <- xfork $ do+        (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd)+                                            (map encodeString args) Nothing Nothing         hPutStr pin input         hFlush pin         threadDelay timeout@@ -88,7 +89,7 @@ seconds :: Rational -> Int seconds = fromEnum . (* 1000000) -{- | 'safeSpawn' bypasses "XMonad.Core"'s 'spawn' command, because spawn passes+{- | 'safeSpawn' bypasses 'spawn', because spawn passes strings to \/bin\/sh to be interpreted as shell commands. This is often what one wants, but in many cases the passed string will contain shell metacharacters which one does not want interpreted as such (URLs@@ -96,28 +97,31 @@ this case, it is more useful to specify a file or program to be run and a string to give it as an argument so as to bypass the shell and be certain the program will receive the string as you typed it.-unsafeSpawn is internally an alias for XMonad's 'spawn', to remind one that use-of it can be, well, unsafe.+ Examples:  > , ((modm, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png")-> , ((modm, xK_d    ), safeSpawn "firefox" "")+> , ((modm, xK_d    ), safeSpawn "firefox" [])  Note that the unsafeSpawn example must be unsafe and not safe because it makes use of shell interpretation by relying on @$HOME@ and interpolation, whereas the safeSpawn example can be safe because Firefox doesn't need any arguments if it is just being started. -} safeSpawn :: MonadIO m => FilePath -> [String] -> m ()-safeSpawn prog args = liftIO $ do-    try $ forkProcess $ executeFile prog True args Nothing :: IO (Either SomeException ProcessID)-    return ()+safeSpawn prog args = io $ void_ $ forkProcess $ do+  uninstallSignalHandlers+  _ <- createSession+  executeFile (encodeString prog) True (map encodeString args) Nothing+    where void_ = (>> return ()) -- TODO: replace with Control.Monad.void / void not in ghc6 apparently --- | Like 'safeSpawn', but only takes a program (and no arguments for it). eg.+-- | Simplified 'safeSpawn'; only takes a program (and no arguments): ----- > safeSpawnProg "firefox"+-- > , ((modm, xK_d    ), safeSpawnProg "firefox") safeSpawnProg :: MonadIO m => FilePath -> m () safeSpawnProg = flip safeSpawn [] +-- | An alias for 'spawn'; the name emphasizes that one is calling out to a+--   Turing-complete interpreter which may do things one dislikes; for details, see 'safeSpawn'. unsafeSpawn :: MonadIO m => String -> m () unsafeSpawn = spawn @@ -132,16 +136,14 @@ safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t [options, " -e " ++ command]  -- | Launch an external application through the system shell and return a @Handle@ to its standard input.-spawnPipe :: String -> IO Handle-spawnPipe x = do+spawnPipe :: MonadIO m => String -> m Handle+spawnPipe x = io $ do     (rd, wr) <- createPipe     setFdOption wr CloseOnExec True     h <- fdToHandle wr     hSetBuffering h LineBuffering-    forkProcess $ do-        createSession-        uninstallSignalHandlers-        dupTo rd stdInput-        executeFile "/bin/sh" False ["-c", x] Nothing+    _ <- xfork $ do+          _ <- dupTo rd stdInput+          executeFile "/bin/sh" False ["-c", encodeString x] Nothing     closeFd rd     return h
XMonad/Util/Scratchpad.hs view
@@ -24,7 +24,6 @@   ) where  import XMonad-import XMonad.Core import qualified XMonad.StackSet as W import XMonad.Util.NamedScratchpad
+ XMonad/Util/SpawnOnce.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE DeriveDataTypeable #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.SpawnOnce+-- Copyright   :  (c) Spencer Janssen 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  spencerjanssen@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- A module for spawning a command once, and only once.  Useful to start+-- status bars and make session settings inside startupHook.+--+-----------------------------------------------------------------------------++module XMonad.Util.SpawnOnce (spawnOnce) where++import XMonad+import Data.Set as Set+import qualified XMonad.Util.ExtensibleState as XS+import Control.Monad++data SpawnOnce = SpawnOnce { unspawnOnce :: (Set String) }+    deriving (Read, Show, Typeable)++instance ExtensionClass SpawnOnce where+    initialValue = SpawnOnce Set.empty+    extensionType = PersistentExtension++-- | The first time 'spawnOnce' is executed on a particular command, that+-- command is executed.  Subsequent invocations for a command do nothing.+spawnOnce :: String -> X ()+spawnOnce xs = do+    b <- XS.gets (Set.member xs . unspawnOnce)+    when (not b) $ do+        spawn xs+        XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)
+ XMonad/Util/Stack.hs view
@@ -0,0 +1,340 @@+{-# LANGUAGE PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Stack+-- Copyright   :  Quentin Moser <moserq@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  orphaned+-- Stability   :  unstable+-- Portability :  unportable+--+-- Utility functions for manipulating @Maybe Stack@s.+--+-----------------------------------------------------------------------------++module XMonad.Util.Stack ( -- * Usage+                           -- | This is a developer-oriented module, intended to be used+                           -- for writing new extentions.+                           Zipper+                         , emptyZ+                         , singletonZ++                           -- * Conversions+                         , fromIndex+                         , toIndex+                         , fromTags+                         , toTags++                           -- * 'Zipper' manipulation functions+                           -- ** Insertion, movement+                         , insertUpZ+                         , insertDownZ+                         , swapUpZ+                         , swapDownZ+                         , swapMasterZ+                           -- ** Focus movement+                         , focusUpZ+                         , focusDownZ+                         , focusMasterZ+                           -- ** Extraction+                         , getFocusZ+                         , getIZ+                           -- ** Sorting+                         , sortZ+                         , sortByZ+                           -- ** Maps+                         , mapZ+                         , mapZ_+                         , mapZM+                         , mapZM_+                         , onFocusedZ+                         , onFocusedZM+                         , onIndexZ+                         , onIndexZM+                           -- ** Filters+                         , filterZ+                         , filterZ_+                         , deleteFocusedZ+                         , deleteIndexZ+                           -- ** Folds+                         , foldrZ+                         , foldlZ+                         , foldrZ_+                         , foldlZ_+                         , elemZ++                           -- * Other utility functions+                         , getI+                         , tagBy+                         , fromE+                         , mapE+                         , mapE_+                         , mapEM+                         , mapEM_+                         ) where++import qualified XMonad.StackSet as W+import Control.Monad (liftM)+import Data.List (sortBy)++++type Zipper a = Maybe (W.Stack a)++emptyZ :: Zipper a+emptyZ = Nothing++singletonZ :: a -> Zipper a+singletonZ a = Just $ W.Stack a [] []++-- * Conversions++-- | Create a stack from a list, and the 0-based index of the focused element.+-- If the index is out of bounds, focus will go to the first element.+fromIndex :: [a] -> Int -> Zipper a+fromIndex as i = fromTags $ zipWith ($) (replicate i Left ++ [Right] ++ repeat Left) as++-- | Turn a stack into a list and the index of its focused element.+toIndex :: Zipper a -> ([a], Maybe Int)+toIndex Nothing = ([], Nothing)+toIndex (Just s) = (W.integrate s, Just $ length $ W.up s)++-- | Create a stack from a list of 'Either'-tagged values. Focus will go to+-- the first 'Right' value, or if there is none, to the first 'Left' one.+fromTags :: [Either a a] -> Zipper a+fromTags = finalize . foldr step ([], Nothing, [])+    where step (Right a) (u, Just f, d) = ([], Just a, u++f:d)+          step (Right a) (u, Nothing, d) = (u, Just a, d)+          step (Left a) (u, Just f, d) = (a:u, Just f, d)+          step (Left a) (u, Nothing, d) = (u, Nothing, a:d)+          finalize (u, Just f, d) = Just $ W.Stack f (reverse u) d+          finalize (u, Nothing, a:d) = Just $ W.Stack a (reverse u) d+          finalize (_, Nothing, []) = Nothing++-- | Turn a stack into an 'Either'-tagged list. The focused element+-- will be tagged with 'Right', the others with 'Left'.+toTags :: Zipper a -> [Either a a]+toTags Nothing = []+toTags (Just s) = map Left (reverse . W.up $ s) ++ [Right . W.focus $ s]+                  ++ map Left (W.down s)+++-- * Zipper functions++-- ** Insertion, movement++-- | Insert an element before the focused one, and focus it+insertUpZ :: a -> Zipper a -> Zipper a+insertUpZ a Nothing = W.differentiate [a]+insertUpZ a (Just s) = Just s { W.focus = a , W.down = W.focus s : W.down s }++-- | Insert an element after the focused one, and focus it+insertDownZ :: a -> Zipper a -> Zipper a+insertDownZ a Nothing = W.differentiate [a]+insertDownZ a (Just s) = Just s { W.focus = a, W.up = W.focus s : W.up s }++-- | Swap the focused element with the previous one+swapUpZ :: Zipper a -> Zipper a+swapUpZ Nothing = Nothing+swapUpZ (Just s) | u:up <- W.up s = Just s { W.up = up, W.down = u:W.down s}+swapUpZ (Just s) = Just s { W.up = reverse (W.down s), W.down = [] }++-- | Swap the focused element with the next one+swapDownZ :: Zipper a -> Zipper a+swapDownZ Nothing = Nothing+swapDownZ (Just s) | d:down <- W.down s = Just s { W.down = down, W.up = d:W.up s }+swapDownZ (Just s) = Just s { W.up = [], W.down = reverse (W.up s) } ++-- | Swap the focused element with the first one+swapMasterZ :: Zipper a -> Zipper a+swapMasterZ Nothing = Nothing+swapMasterZ (Just (W.Stack f up down)) = Just $ W.Stack f [] (reverse up ++ down)++-- ** Focus movement++-- | Move the focus to the previous element+focusUpZ :: Zipper a -> Zipper a+focusUpZ Nothing = Nothing+focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s)+focusUpZ (Just s) | null $ W.down s = Just s+focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (reverse (init down) ++ [f]) []++-- | Move the focus to the next element+focusDownZ :: Zipper a -> Zipper a+focusDownZ Nothing = Nothing+focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down+focusDownZ (Just s) | null $ W.up s = Just s+focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (reverse (init up) ++ [f])++-- | Move the focus to the first element+focusMasterZ :: Zipper a -> Zipper a+focusMasterZ Nothing = Nothing+focusMasterZ (Just (W.Stack f up down)) | not $ null up+    = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)+focusMasterZ (Just s) = Just s++-- ** Extraction++-- | Get the focused element+getFocusZ :: Zipper a -> Maybe a+getFocusZ = fmap W.focus++-- | Get the element at a given index+getIZ :: Int -> Zipper a -> Maybe a+getIZ i = getI i . W.integrate'++-- ** Sorting++-- | Sort a stack of elements supporting 'Ord'+sortZ :: Ord a => Zipper a -> Zipper a+sortZ = sortByZ compare++-- | Sort a stack with an arbitrary sorting function+sortByZ :: (a -> a -> Ordering) -> Zipper a -> Zipper a+sortByZ f = fromTags . sortBy (adapt f) . toTags+    where adapt g e1 e2 = g (fromE e1) (fromE e2)++-- ** Maps+             +-- | Map a function over a stack. The boolean argument indcates whether+-- the current element is the focused one+mapZ :: (Bool -> a -> b) -> Zipper a -> Zipper b+mapZ f as = fromTags . map (mapE f) . toTags $ as++-- | 'mapZ' without the 'Bool' argument+mapZ_ :: (a -> b) -> Zipper a -> Zipper b+mapZ_ = mapZ . const++-- | Monadic version of 'mapZ'+mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b)+mapZM f as = fromTags `liftM` (mapM (mapEM f) . toTags) as+++-- | Monadic version of 'mapZ_'+mapZM_ :: Monad m => (a -> m b) -> Zipper a -> m (Zipper b)+mapZM_ = mapZM . const++-- | Apply a function to the focused element+onFocusedZ :: (a -> a) -> Zipper a -> Zipper a+onFocusedZ f = mapZ $ \b a -> if b then f a else a++-- | Monadic version of 'onFocusedZ'+onFocusedZM :: Monad m => (a -> m a) -> Zipper a -> m (Zipper a)+onFocusedZM f = mapZM $ \b a -> if b then f a else return a++-- | Apply a function to the element at the given index+onIndexZ :: Int -> (a -> a) -> Zipper a -> Zipper a+onIndexZ i _ as | i < 0 = as+onIndexZ i f as = case splitAt i $ toTags as of+                    (before, []) -> fromTags before+                    (before, a:after) -> fromTags $ before ++ mapE (const f) a : after++-- | Monadic version of 'onIndexZ'+onIndexZM :: Monad m => Int -> (a -> m a) -> Zipper a -> m (Zipper a)+onIndexZM i f as = case splitAt i $ toTags as of+                     (before, []) -> return $ fromTags before+                     (before, a:after) -> do a' <- mapEM (const f) a+                                             return $ fromTags $ before ++ a' : after++-- ** Filters++-- | Fiter a stack according to a predicate. The refocusing behavior+-- mimics XMonad's usual one. The boolean argument indicates whether the current+-- element is the focused one.+filterZ :: (Bool -> a -> Bool) -> Zipper a -> Zipper a+filterZ _ Nothing = Nothing+filterZ p (Just s) = case ( p True (W.focus s)+                          , filter (p False) (W.up s)+                          , filter (p False) (W.down s) ) of+                       (True, up', down') -> Just s { W.up = up', W.down = down' }+                       (False, [], []) -> Nothing+                       (False, f:up', []) -> Just s { W.focus = f, W.up = up', W.down = [] }+                       (False, up', f:down') ->  Just s { W.focus = f+                                                        , W.up = up'+                                                        , W.down = down' }++-- | 'filterZ' without the 'Bool' argument+filterZ_ :: (a -> Bool) -> Zipper a -> Zipper a+filterZ_ = filterZ . const++-- | Delete the focused element+deleteFocusedZ :: Zipper a -> Zipper a+deleteFocusedZ = filterZ (\b _ -> not b)++-- | Delete the ith element+deleteIndexZ :: Int -> Zipper a -> Zipper a+deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z+                       number j ea = mapE (\_ a -> (j,a)) ea+                   in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered++-- ** Folds++-- | Analogous to 'foldr'. The 'Bool' argument to the step functions indicates+-- whether the current element is the focused one+foldrZ :: (Bool -> a -> b -> b) -> b -> Zipper a -> b+foldrZ _ b Nothing = b+foldrZ f b (Just s) = let b1 = foldr (f False) b (W.down s)+                          b2 = f True (W.focus s) b1+                          b3 = foldl (flip $ f False) b2 (W.up s)+                      in b3++-- | Analogous to 'foldl'. The 'Bool' argument to the step functions indicates+-- whether the current element is the focused one+foldlZ :: (Bool -> b -> a -> b) -> b -> Zipper a -> b+foldlZ _ b Nothing = b+foldlZ f b (Just s) = let b1 = foldr (flip $ f False) b (W.up s)+                          b2 = f True b1 (W.focus s)+                          b3 = foldl (f False) b2 (W.down s)+                      in b3++-- | 'foldrZ' without the 'Bool' argument.+foldrZ_ :: (a -> b -> b) -> b -> Zipper a -> b+foldrZ_ = foldrZ . const++-- | 'foldlZ' without the 'Bool' argument.+foldlZ_ :: (b -> a -> b) -> b -> Zipper a -> b+foldlZ_ = foldlZ . const++-- | Find whether an element is present in a stack.+elemZ :: Eq a => a -> Zipper a -> Bool+elemZ a as = foldlZ_ step False as+    where step True _ = True+          step False a' = a' == a+++-- * Other utility functions++-- | Safe version of '!!'+getI :: Int -> [a] -> Maybe a+getI _ [] = Nothing+getI 0 (a:_) = Just a+getI i (_:as) = getI (i-1) as++-- | Map a function across both 'Left's and 'Right's.+-- The 'Bool' argument is 'True' in a 'Right', 'False'+-- in a 'Left'.+mapE :: (Bool -> a -> b) -> Either a a -> Either b b+mapE f (Left a) = Left $ f False a+mapE f (Right a) = Right $ f True a++mapE_ :: (a -> b) -> Either a a -> Either b b+mapE_ = mapE . const++-- | Monadic version of 'mapE'+mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b)+mapEM f (Left a) = Left `liftM` f False a+mapEM f (Right a) = Right `liftM` f True a++mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b)+mapEM_ = mapEM . const++-- | Get the @a@ from an @Either a a@+fromE :: Either a a -> a+fromE (Right a) = a+fromE (Left a) = a++-- | Tag the element with 'Right' if the property is true, 'Left' otherwise+tagBy :: (a -> Bool) -> a -> Either a a+tagBy p a = if p a then Right a else Left a
XMonad/Util/Timer.hs view
@@ -23,7 +23,6 @@ import Control.Applicative import Control.Concurrent import Data.Unique-import System.Posix.Process (forkProcess)  -- $usage -- This module can be used to setup a timer to handle deferred events.@@ -36,7 +35,7 @@ startTimer :: Rational -> X TimerId startTimer s = io $ do   u   <- hashUnique <$> newUnique-  forkProcess $ do+  xfork $ do     d   <- openDisplay ""     rw  <- rootWindow d $ defaultScreen d     threadDelay (fromEnum $ s * 1000000)
XMonad/Util/WindowProperties.hs view
@@ -49,15 +49,7 @@  -- | Does given window have this property? hasProperty :: Property -> Window -> X Bool-hasProperty (Title s)     w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w-hasProperty (Resource s)  w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w-hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w-hasProperty (Role s)      w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE"-hasProperty (Machine s)   w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_CLIENT_MACHINE"-hasProperty (And p1 p2)   w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 }-hasProperty (Or p1 p2)    w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 }-hasProperty (Not p1)      w = do { r1 <- hasProperty p1 w; return $ not r1 }-hasProperty (Const b)     _ = return b+hasProperty p w = runQuery (propertyToQuery p) w  -- | Does the focused window have this property? focusedHasProperty :: Property -> X Bool
XMonad/Util/WorkspaceCompare.hs view
@@ -8,15 +8,18 @@ -- Stability   :  unstable -- Portability :  unportable --+-----------------------------------------------------------------------------  module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort                                     , getWsIndex                                     , getWsCompare                                     , getWsCompareByTag+                                    , getXineramaPhysicalWsCompare                                     , getXineramaWsCompare                                     , mkWsSort                                     , getSortByIndex                                     , getSortByTag+                                    , getSortByXineramaPhysicalRule                                     , getSortByXineramaRule ) where  import XMonad@@ -25,6 +28,7 @@ import Data.Monoid import Data.Ord import Data.Maybe+import Data.Function  type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering type WorkspaceSort = [WindowSpace] -> [WindowSpace]@@ -41,12 +45,7 @@ getWsCompare :: X WorkspaceCompare getWsCompare = do     wsIndex <- getWsIndex-    return $ \a b -> f (wsIndex a) (wsIndex b) `mappend` compare a b-  where-    f Nothing Nothing   = EQ-    f (Just _) Nothing  = LT-    f Nothing (Just _)  = GT-    f (Just x) (Just y) = compare x y+    return $ mconcat [compare `on` wsIndex, compare]  -- | A simple comparison function that orders workspaces --   lexicographically by tag.@@ -57,10 +56,17 @@ --   and screen id. It produces the same ordering as --   'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'. getXineramaWsCompare :: X WorkspaceCompare-getXineramaWsCompare = do+getXineramaWsCompare = getXineramaWsCompare' False++-- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens.+getXineramaPhysicalWsCompare :: X WorkspaceCompare+getXineramaPhysicalWsCompare = getXineramaWsCompare' True++getXineramaWsCompare' :: Bool -> X WorkspaceCompare+getXineramaWsCompare' phy = do     w <- gets windowset     return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of-        (True, True)   -> comparing (tagToSid (onScreen w)) a b+        (True, True)   -> cmpPosition phy w a b         (False, False) -> compare a b         (True, False)  -> LT         (False, True)  -> GT@@ -68,6 +74,10 @@     onScreen w =  S.current w : S.visible w     isOnScreen a w  = a `elem` map (S.tag . S.workspace) (onScreen w)     tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s+    cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b+    cmpPosition True w a b = comparing (rect.(tagToSid $ onScreen w)) a b+      where rect i = let (Rectangle x y _ _) = screens !! fromIntegral i in (y,x)+            screens = map (screenRect . S.screenDetail) $ sortBy (comparing S.screen) $ S.current w : S.visible w  -- | Create a workspace sorting function from a workspace comparison --   function.@@ -91,4 +101,8 @@ --   sorted by tag. getSortByXineramaRule :: X WorkspaceSort getSortByXineramaRule = mkWsSort getXineramaWsCompare++-- | Like 'getSortByXineramaRule', but uses physical locations for screens.+getSortByXineramaPhysicalRule :: X WorkspaceSort+getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare
XMonad/Util/XSelection.hs view
@@ -9,7 +9,7 @@ Portability :  unportable  A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).-'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils, available:+'getSelection' is an adaptation of Hxsel.hs and Hxput.hs from the XMonad-utils, available:  > $ darcs get <http://gorgias.mine.nu/repos/xmonad-utils> -}@@ -20,13 +20,10 @@                                  promptSelection,                                  safePromptSelection,                                  transformPromptSelection,-                                 transformSafePromptSelection,-                                 putSelection) where+                                 transformSafePromptSelection) where -import Control.Concurrent (forkIO) import Control.Exception.Extensible as E (catch,SomeException(..))-import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)-import Data.Char (ord)+import Control.Monad (liftM, join) import Data.Maybe (fromMaybe) import XMonad import XMonad.Util.Run (safeSpawn, unsafeSpawn)@@ -42,23 +39,13 @@     > , ((modm .|. shiftMask, xK_b), promptSelection "firefox") -   There are a number of known problems with XSelection:--    * Unicode handling is busted. But it's still better than calling-      'chr' to translate to ASCII, at least.-      As near as I can tell, the mangling happens when the String is-      outputted somewhere, such as via promptSelection's passing through-      the shell, or GHCi printing to the terminal. utf-string has IO functions-      which can fix this, though I do not know have to use them here. It's-      a complex issue; see-      <http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>-      and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.+   Future improvements for XSelection: -    * Needs more elaborate functionality: Emacs' registers are nice; if you+   * More elaborate functionality: Emacs' registers are nice; if you       don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> -} --- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is--- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.+-- | Returns a String corresponding to the current mouse selection in X;+--   if there is none, an empty string is returned. getSelection :: MonadIO m => m String getSelection = io $ do   dpy <- openDisplay ""@@ -81,60 +68,25 @@                return $ decode . map fromIntegral . fromMaybe [] $ res        else destroyWindow dpy win >> return "" --- | Set the current X Selection to a specified string.-putSelection :: MonadIO m => String -> m ()-putSelection text = io $ do-  dpy <- openDisplay ""-  let dflt = defaultScreen dpy-  rootw  <- rootWindow dpy dflt-  win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0-  p <- internAtom dpy "PRIMARY" True-  ty <- internAtom dpy "UTF8_STRING" False-  xSetSelectionOwner dpy p win currentTime-  winOwn <- xGetSelectionOwner dpy p-  if winOwn == win-    then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return ()-    else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win-  return ()-                     where-                       processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO ()-                       processEvent dpy ty txt e = do-                                                      nextEvent dpy e-                                                      ev <- getEvent e-                                                      if ev_event_type ev == selectionRequest-                                                       then do print ev-                                                               allocaXEvent $ \replyPtr -> do-                                                                 changeProperty8 (ev_event_display ev)-                                                                                 (ev_requestor ev)-                                                                                 (ev_property ev)-                                                                                 ty-                                                                                 propModeReplace-                                                                                 (map (fromIntegral . ord) txt)-                                                                 setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev)-                                                                                        (ev_target ev) (ev_property ev) (ev_time ev)-                                                                 sendEvent dpy (ev_requestor ev) False noEventMask replyPtr-                                                                 sync dpy False-                                                       else do putStrLn "Unexpected Message Received"-                                                               print ev-                                                      processEvent dpy ty text e- {- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument.-This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to+  This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to          @promptSelection \"firefox\"@;-this would allow you to highlight a URL string and then immediately open it up in Firefox.+  this would allow you to highlight a URL string and then immediately open it up in Firefox. -'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text-to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the-shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more-details on the advantages and disadvantages of using safeSpawn. -}+  'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text+  to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the+  shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more+  details on the advantages and disadvantages of using safeSpawn. -} promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () promptSelection = unsafePromptSelection safePromptSelection app = join $ io $ liftM (safeSpawn app . return) getSelection unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection -{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X.-One example is to wrap code, such as a command line action copied out of the browser to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@.--}+{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the +     first is a function that transforms strings, and the second is the application to run.+     The transformer essentially transforms the selection in X.+     One example is to wrap code, such as a command line action copied out of the browser+     to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. -} transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X () transformPromptSelection f app = join $ io $ liftM (safeSpawn app . return) (fmap f getSelection) transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)
XMonad/Util/XUtils.hs view
@@ -2,6 +2,7 @@ -- | -- Module      :  XMonad.Util.XUtils -- Copyright   :  (c) 2007 Andrea Rossato+--                    2010 Alejandro Serrano -- License     :  BSD-style (see xmonad/LICENSE) -- -- Maintainer  :  andrea.rossato@unibz.it@@ -25,6 +26,7 @@     , deleteWindows     , paintWindow     , paintAndWrite+    , paintTextAndIcons     , stringToPixel     , fi     ) where@@ -32,11 +34,12 @@ import Data.Maybe import XMonad import XMonad.Util.Font+import XMonad.Util.Image import Control.Monad  -- $usage--- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage--- examples+-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or +-- "XMonad.Layout.Decoration" for usage examples  -- | Compute the weighted average the colors of two given Pixel values. averagePixels :: Pixel -> Pixel -> Double -> X Pixel@@ -60,6 +63,11 @@   case m of     Just em -> io $ selectInput d win em     Nothing -> io $ selectInput d win exposureMask+  -- @@@ ugly hack to prevent compositing+  whenX (return $ isJust m) $ flip catchX (return ()) $ do+    wINDOW_TYPE <- getAtom "_NET_WM_WINDOW_TYPE"+    dESKTOP <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"+    io $ changeProperty32 d win wINDOW_TYPE aTOM propModeReplace [fi dESKTOP]   return win  -- | Map a window@@ -101,9 +109,10 @@             -> String     -- ^ Border color             -> X () paintWindow w wh ht bw c bc =-    paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing+    paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing Nothing --- | Fill a window with a rectangle and a border, and write a string at given position+-- | Fill a window with a rectangle and a border, and write+-- | a number of strings to given positions paintAndWrite :: Window     -- ^ The window where to draw               -> XMonadFont -- ^ XMonad Font for drawing               -> Dimension  -- ^ Window width@@ -113,19 +122,50 @@               -> String     -- ^ Border color               -> String     -- ^ String color               -> String     -- ^ String background color-              -> Align      -- ^ String 'Align'ment-              -> String     -- ^ String to be printed+              -> [Align]    -- ^ String 'Align'ments+              -> [String]   -- ^ Strings to be printed               -> X ()-paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do+paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do     d <- asks display-    (x,y) <- stringPosition d fs (Rectangle 0 0 wh ht) al str-    paintWindow' w (Rectangle x y wh ht) bw bc borc ms-    where ms    = Just (fs,ffc,fbc,str)+    strPositions <- forM (zip als strs) $ \(al, str) ->+        stringPosition d fs (Rectangle 0 0 wh ht) al str+    let ms = Just (fs,ffc,fbc, zip strs strPositions)+    paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms Nothing +-- | Fill a window with a rectangle and a border, and write+-- | a number of strings and a number of icons to given positions+paintTextAndIcons :: Window      -- ^ The window where to draw+                  -> XMonadFont  -- ^ XMonad Font for drawing+                  -> Dimension   -- ^ Window width+                  -> Dimension   -- ^ Window height+                  -> Dimension   -- ^ Border width+                  -> String      -- ^ Window background color+                  -> String      -- ^ Border color+                  -> String      -- ^ String color+                  -> String      -- ^ String background color+                  -> [Align]     -- ^ String 'Align'ments+                  -> [String]    -- ^ Strings to be printed+                  -> [Placement] -- ^ Icon 'Placements'+                  -> [[[Bool]]]  -- ^ Icons to be printed+                  -> X ()+paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do+    d <- asks display+    strPositions <- forM (zip als strs) $ \(al, str) ->+        stringPosition d fs (Rectangle 0 0 wh ht) al str+    let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons)+        ms = Just (fs,ffc,fbc, zip strs strPositions)+        is = Just (ffc, fbc, zip iconPositions icons)+    paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is+ -- This stuff is not exported -paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,String) -> X ()-paintWindow' win (Rectangle x y wh ht) bw color b_color str = do+-- | Paints a titlebar with some strings and icons+-- drawn inside it.+-- Not exported.+paintWindow' :: Window -> Rectangle -> Dimension -> String -> String+                -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) +                -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X ()+paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do   d  <- asks display   p  <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d)   gc <- io $ createGC d p@@ -138,9 +178,16 @@   -- and now again   io $ setForeground d gc color'   io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2))-  when (isJust str) $ do-    let (xmf,fc,bc,s) = fromJust str-    printStringXMF d p xmf gc fc bc x y s+  -- paint strings+  when (isJust strStuff) $ do+    let (xmf,fc,bc,strAndPos) = fromJust strStuff+    forM_ strAndPos $ \(s, (x, y)) ->+        printStringXMF d p xmf gc fc bc x y s+  -- paint icons+  when (isJust iconStuff) $ do+    let (fc, bc, iconAndPos) = fromJust iconStuff+    forM_ iconAndPos $ \((x, y), icon) ->+      drawIcon d p gc fc bc x y icon   -- copy the pixmap over the window   io $ copyArea      d p win gc 0 0 wh ht 0 0   -- free the pixmap and GC@@ -162,6 +209,3 @@            createWindow d rw x y w h 0 (defaultDepthOfScreen s)                         inputOutput visual attrmask attributes --- | Short-hand for 'fromIntegral'-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral
+ scripts/window-properties.sh view
@@ -0,0 +1,15 @@+#! /bin/sh+# Script to print common window properties in ManageHook format,+# via xprop.  All xprop options may be used, although anything other+# than -display, -id, and -name is probably a bad idea.+#+# Written and placed into the public domain by Brandon S Allbery+# KF8NH <allbery.b@gmail.com>+#++exec xprop -notype \+  -f WM_NAME        8s ':\n  title =\? $0\n' \+  -f WM_CLASS       8s ':\n  appName =\? $0\n  className =\? $1\n' \+  -f WM_WINDOW_ROLE 8s ':\n  stringProperty "WM_WINDOW_ROLE" =\? $0\n' \+  WM_NAME WM_CLASS WM_WINDOW_ROLE \+  ${1+"$@"}
+ tests/ManageDocks.hs view
@@ -0,0 +1,21 @@+module ManageDocks where+import XMonad+import XMonad.Hooks.ManageDocks+import Test.QuickCheck+import Foreign.C.Types+import Properties++instance Arbitrary CLong where+    arbitrary = fromIntegral `fmap` (arbitrary :: Gen Int)+instance Arbitrary RectC where+    arbitrary = do+        (x,y) <- arbitrary+        NonNegative w <- arbitrary+        NonNegative h <- arbitrary+        return $ RectC (x,y,x+w,y+h)++prop_r2c_c2r :: RectC -> Bool+prop_r2c_c2r r = r2c (c2r r) == r++prop_c2r_r2c :: Rectangle -> Bool+prop_c2r_r2c r = c2r (r2c r) == r
+ tests/Selective.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}+module Selective where++-- Tests for limitSelect-related code in L.LimitWindows.+-- To run these tests, export (select,update,Selection(..),updateAndSelect) from+-- L.LimitWindows.++import XMonad.Layout.LimitWindows+import XMonad.StackSet hiding (focusUp, focusDown, filter)+import Control.Applicative ((<$>))+import Test.QuickCheck+import Control.Arrow (second)++instance Arbitrary (Stack Int) where+    arbitrary = do+                    xs <- arbNat+                    ys <- arbNat+                    return $ Stack { up=[xs-1,xs-2..0], focus=xs, down=[xs+1..xs+ys] }+    coarbitrary = undefined++instance Arbitrary (Selection a) where+    arbitrary = do+                    nm <- arbNat+                    st <- arbNat+                    nr <- arbPos+                    return $ Sel nm (st+nm) nr+    coarbitrary = undefined++arbNat = abs <$> arbitrary+arbPos = (+1) . abs <$> arbitrary++-- as many windows as possible should be selected +-- (when the selection is normalized)+prop_select_length sel (stk :: Stack Int) =+    (length . integrate $ select sel' stk) == ((nMaster sel' + nRest sel') `min` length (integrate stk))+    where sel' = update sel stk++-- update normalizes selections (is idempotent)+prop_update_idem sel (stk :: Stack Int) = sel' == update sel' stk+    where sel' = update sel stk++-- select selects the master pane+prop_select_master sel (stk :: Stack Int) = +    take (nMaster sel) (integrate stk) == take (nMaster sel) (integrate $ select sel stk)++-- the focus should always be selected in normalized selections+prop_select_focus sel (stk :: Stack Int) = focus stk == (focus $ select sel' stk)+    where sel' = update sel stk++-- select doesn't change order (or duplicate elements)+-- relies on the Arbitrary instance for Stack Int generating increasing stacks+prop_select_increasing sel (stk :: Stack Int) =+    let res = integrate $ select sel stk+     in and . zipWith (<) res $ tail res++-- selection has the form [0..l] ++ [m..n]+-- relies on the Arbitrary instance for Stack Int generating stacks like [0..k]+prop_select_two_consec sel (stk :: Stack Int) =+    let wins = integrate $ select sel stk+     in (length . filter not . zipWith ((==) . (+1)) wins $ tail wins) <= 1++-- update preserves invariants on selections+prop_update_nm sel (stk :: Stack Int) = nMaster (update sel stk) >= 0+prop_update_start sel (stk :: Stack Int) = nMaster sel' <= start sel'+    where sel' = update sel stk+prop_update_nr sel (stk :: Stack Int) = nRest (update sel stk) >= 0++-- moving the focus to a window that's already selected doesn't change the selection+prop_update_focus_up sel (stk :: Stack Int) x' =+    (length (up stk) >= x) && ((up stk !! (x-1)) `elem` integrate stk') ==> +        sel' == update sel' (iterate focusUp stk !! x)+    where+        x = 1 + abs x'+        sel' = update sel stk+        stk' = select sel' stk++prop_update_focus_down sel (stk :: Stack Int) x' =+    (length (down stk) >= x) && ((down stk !! (x-1)) `elem` integrate stk') ==> +        sel' == update sel' (iterate focusDown stk !! x)+    where+        x = 1 + abs x'+        sel' = update sel stk+        stk' = select sel' stk++focusUp stk = stk { up=tail (up stk), focus=head (up stk), down=focus stk:down stk }+focusDown stk = stk { down=tail (down stk), focus=head (down stk), up=focus stk:up stk }
+ tests/SwapWorkspaces.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE ScopedTypeVariables #-}+module SwapWorkspaces where++import Data.List(find,union)+import Data.Maybe(fromJust)+import Test.QuickCheck++import XMonad.StackSet+import Properties(T, NonNegative) -- requires tests/Properties.hs from xmonad-core+import XMonad.Actions.SwapWorkspaces++-- Ensures that no "loss of information" can happen from a swap.+prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+  t1 `tagMember` ss && t2 `tagMember` ss ==>+  ss == swap (swap ss)+  where swap = swapWorkspaces t1 t2++-- Degrade nicely when given invalid data.+prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+  not (t1 `tagMember` ss || t2 `tagMember` ss) ==>+  ss == swapWorkspaces t1 t2 ss++-- This doesn't pass yet. Probably should.+-- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+--   t1 `tagMember` ss && not (t2 `tagMember` ss) ==>+--   ss == swapWorkspaces t1 t2 ss++zipWorkspacesWith :: (Workspace i l a -> Workspace i l a -> n) -> StackSet i l a s sd ->+                     StackSet i l a s sd -> [n]+zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) :+                          zipWith f (map workspace $ visible s) (map workspace $ visible t) +++                          zipWith f (hidden s)  (hidden t)++-- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.+prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+  t1 `tagMember` ss && t2 `tagMember` ss ==>+  and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)+  where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2++-- swapWithCurrent stays on current+prop_swap_with_current (ss :: T) (t :: NonNegative Int) =+  t `tagMember` ss ==>+  layout before == layout after && stack before == stack after+  where before = workspace $ current ss+        after  = workspace $ current $ swapWithCurrent t ss++main = do+  putStrLn "Testing double swap"+  quickCheck prop_double_swap+  putStrLn "Testing invalid swap"+  quickCheck prop_invalid_swap+  -- putStrLn "Testing half-invalid swap"+  -- quickCheck prop_half_invalid_swap+  putStrLn "Testing swap only two"+  quickCheck prop_swap_only_two+  putStrLn "Testing swap with current"+  quickCheck prop_swap_with_current
+ tests/XPrompt.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE ScopedTypeVariables #-}+-------------------------------------+--+-- Tests for XPrompt and ShellPrompt+--+-------------------------------------+module XPrompt where++import Data.Char+import Test.QuickCheck++import Data.List++import XMonad.Prompt+import qualified XMonad.Prompt.Shell as S+import Properties+ +{-+instance Arbitrary Char where+    arbitrary     = choose ('\32', '\255')+    coarbitrary c = variant (ord c `rem` 4)++-}++doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p+deepCheck p = check (defaultConfig { configMaxTest = 10000}) p+deepestCheck p = check (defaultConfig { configMaxTest = 100000}) p++-- brute force check for exceptions+prop_split (str :: [Char]) =+    forAll (elements str) $ \e -> S.split e str == S.split e str++-- check if the first element of the new list is indeed the first part+-- of the string.+prop_spliInSubListsAt (x :: Int) (str :: [Char]) =+    x < length str ==> result == take x str+    where result = case splitInSubListsAt x str of+                     [] -> []+                     x -> head x++-- skipLastWord is complementary to getLastWord, unless the only space+-- in the string is the final character, in which case skipLastWord+-- and getLastWord will produce the same result.+prop_skipGetLastWord (str :: [Char]) =+    skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str+++-- newIndex and newCommand get only non empy lists+elemGen :: Gen ([String],String)+elemGen = do+  a <- arbitrary :: Gen [[Char]]+  let l = case filter (/= []) a of+            [] -> ["a"]+            x -> x+  e <- elements l+  return (l,e)++{- newIndex and newCommand have since been renamed or are no longer used++-- newIndex calculates the index of the next completion in the+-- completion list, so the index must be within the range of the+-- copletions list+prop_newIndex_range =+    forAll elemGen $ \(l,c) -> newIndex c l >= 0 &&  newIndex c l < length l+-}++-- this is actually the definition of newCommand...+-- just to check something.+{-+prop_newCommandIndex = +    forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l)))  == newCommand c l+-}++main = do+  putStrLn "Testing ShellPrompt.split"+  deepCheck prop_split+  putStrLn "Testing spliInSubListsAt"+  deepCheck prop_spliInSubListsAt+  putStrLn "Testing skip + get lastWord"+  deepCheck prop_skipGetLastWord+
+ tests/genMain.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE ViewPatterns #-}+{- | generate another Main from all modules in the current directory,+extracting all functions with @prop_@.++Usage (your QuickCheck-1 version may vary):++> ln -s ../../xmonad/tests/Properties.hs .+> runghc genMain.hs > Main.hs+> ghc -DTESTING -i.. -i. -package QuickCheck-1.2.0.0 Main.hs -e ':main 200'++-}+module Main where++import Control.Monad.List+import Data.Char+import Data.IORef+import Data.List+import qualified Data.Set as S+import System.Directory+import System.FilePath+import Text.PrettyPrint.HughesPJ++main = do+    imports <- newIORef S.empty+    props <- runListT $ do+        f @ ((isUpper -> True) : (takeExtension -> ".hs"))+            <- ListT (getDirectoryContents ".")+        guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"]+        let b = takeBaseName f+        nesting <- io $ newIORef 0+        decl : _ <- ListT $ (map words . lines) `fmap` readFile f+        case decl of+            "{-" -> io $ modifyIORef nesting succ+            "-}" -> io $ modifyIORef nesting pred+            _ -> return ()+        0 <- io $ readIORef nesting+        guard $ "prop_" `isPrefixOf` decl+        io $ modifyIORef imports (S.insert b)+        return (b ++ "." ++ decl)+    imports <- S.toList `fmap` readIORef imports+    print $ genModule imports props++genModule :: [String] -> [String] -> Doc+genModule imports props = vcat [header,imports', main ]+    where+        header = text "module Main where"+        imports' = text "import Test.QuickCheck; import Data.Maybe; \+                            \import System.Environment; import Text.Printf; \+                            \import Properties hiding (main); import Control.Monad"+                $$ vcat [ text "import qualified" <+> text im | im <- imports ]+        props' = [ parens $ doubleQuotes (text p) <> comma <> text "mytest" <+> text p+                            | p <- props ]+        main = hang (text "main = do") 4 $+                    text "n <- maybe (return 100) readIO . listToMaybe =<< getArgs"+                    $$+                    hang (text "let props = ") 8+                        (brackets $ foldr1 (\x xs -> x <> comma $$ xs) props')+                    $$+                    text "(results, passed) <- liftM unzip $ \+                            \mapM (\\(s,a) -> printf \"%-40s: \" s >> a n) props"+                    $$+                    text "printf \"Passed %d tests!\\n\" (sum passed)"+                    $$+                    text "when (any not results) $ fail \"Not all tests passed!\""++io x = liftIO x
− tests/test_SwapWorkspaces.hs 
@@ -1,56 +0,0 @@-{-# OPTIONS -fglasgow-exts #-}--import Data.List(find,union)-import Data.Maybe(fromJust)-import Test.QuickCheck--import StackSet-import Properties(T, NonNegative)-import XMonad.SwapWorkspaces---- Ensures that no "loss of information" can happen from a swap.-prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =-  t1 `tagMember` ss && t2 `tagMember` ss ==>-  ss == swap (swap ss)-  where swap = swapWorkspaces t1 t2---- Degrade nicely when given invalid data.-prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =-  not (t1 `tagMember` ss || t2 `tagMember` ss) ==>-  ss == swapWorkspaces t1 t2 ss---- This doesn't pass yet. Probably should.--- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =---   t1 `tagMember` ss && not (t2 `tagMember` ss) ==>---   ss == swapWorkspaces t1 t2 ss--zipWorkspacesWith :: (Workspace i l a -> Workspace i l a -> n) -> StackSet i l a s sd ->-                     StackSet i l a s sd -> [n]-zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) :-                          zipWith f (map workspace $ visible s) (map workspace $ visible t) ++-                          zipWith f (hidden s)  (hidden t)---- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.-prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =-  t1 `tagMember` ss && t2 `tagMember` ss ==>-  and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)-  where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2---- swapWithCurrent stays on current-prop_swap_with_current (ss :: T) (t :: NonNegative Int) =-  t `tagMember` ss ==>-  layout before == layout after && stack before == stack after-  where before = workspace $ current ss-        after  = workspace $ current $ swapWithCurrent t ss--main = do-  putStrLn "Testing double swap"-  quickCheck prop_double_swap-  putStrLn "Testing invalid swap"-  quickCheck prop_invalid_swap-  -- putStrLn "Testing half-invalid swap"-  -- quickCheck prop_half_invalid_swap-  putStrLn "Testing swap only two"-  quickCheck prop_swap_only_two-  putStrLn "Testing swap with current"-  quickCheck prop_swap_with_current
− tests/test_XPrompt.hs 
@@ -1,75 +0,0 @@-{-# OPTIONS -fglasgow-exts #-}-------------------------------------------- Tests for XPrompt and ShellPrompt-------------------------------------------import Data.Char-import Test.QuickCheck--import Data.List--import XMonad.XPrompt-import qualified XMonad.ShellPrompt as S- -instance Arbitrary Char where-    arbitrary     = choose ('\32', '\255')-    coarbitrary c = variant (ord c `rem` 4)---doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p-deepCheck p = check (defaultConfig { configMaxTest = 10000}) p-deepestCheck p = check (defaultConfig { configMaxTest = 100000}) p---- brute force check for exceptions-prop_split (str :: [Char]) =-    forAll (elements str) $ \e -> S.split e str == S.split e str---- check if the first element of the new list is indeed the first part--- of the string.-prop_spliInSubListsAt (x :: Int) (str :: [Char]) =-    x < length str ==> result == take x str-    where result = case splitInSubListsAt x str of-                     [] -> []-                     x -> head x---- skipLastWord is complementary to getLastWord, unless the only space--- in the string is the final character, in which case skipLastWord--- and getLastWord will produce the same result.-prop_skipGetLastWord (str :: [Char]) =-    skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str---- newIndex and newCommand get only non empy lists-elemGen :: Gen ([String],String)-elemGen = do-  a <- arbitrary :: Gen [[Char]]-  let l = case filter (/= []) a of-            [] -> ["a"]-            x -> x-  e <- elements l-  return (l,e)---- newIndex calculates the index of the next completion in the--- completion list, so the index must be within the range of the--- copletions list-prop_newIndex_range =-    forAll elemGen $ \(l,c) -> newIndex c l >= 0 &&  newIndex c l < length l---- this is actually the definition of newCommand...--- just to check something.-prop_newCommandIndex = -    forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l)))  == newCommand c l--main = do-  putStrLn "Testing ShellPrompt.split"-  deepCheck prop_split-  putStrLn "Testing spliInSubListsAt"-  deepCheck prop_spliInSubListsAt-  putStrLn "Testing newIndex + newCommand"-  deepCheck prop_newCommandIndex-  putStrLn "Testing skip + get lastWord"-  deepCheck prop_skipGetLastWord-  putStrLn "Testing range of XPrompt.newIndex"-  deepCheck prop_newIndex_range-
xmonad-contrib.cabal view
@@ -1,5 +1,5 @@ name:               xmonad-contrib-version:            0.9.2+version:            0.10 homepage:           http://xmonad.org/ synopsis:           Third party extensions for xmonad description:@@ -22,12 +22,16 @@ author:             Spencer Janssen maintainer:         spencerjanssen@gmail.com extra-source-files: README scripts/generate-configs scripts/run-xmonad.sh+                    scripts/window-properties.sh                     scripts/xinitrc scripts/xmonad-acpi.c-                    scripts/xmonad-clock.c tests/test_SwapWorkspaces.hs-                    tests/test_XPrompt.hs+                    scripts/xmonad-clock.c+                    tests/genMain.hs+                    tests/ManageDocks.hs+                    tests/Selective.hs+                    tests/SwapWorkspaces.hs+                    tests/XPrompt.hs cabal-version:      >= 1.2.1 build-type:         Simple-tested-with:        GHC == 6.12.4, GHC == 7.0.1  flag small_base   description: Choose the new smaller, split-up base package.@@ -57,13 +61,19 @@         extensions: ForeignFunctionInterface         cpp-options: -DXFT -    build-depends:      mtl >= 1 && < 3, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.9.1, xmonad<0.10, utf8-string-    ghc-options:        -fwarn-tabs -Wall+    build-depends:      mtl >= 1 && < 3, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.10, xmonad<0.11, utf8-string++    if true+        ghc-options:    -fwarn-tabs -Wall+     extensions:         ForeignFunctionInterface      if flag(testing)         ghc-options:    -fwarn-tabs -Werror +    if impl(ghc >= 6.12.1)+        ghc-options:    -fno-warn-unused-do-bind+     if impl (ghc == 6.10.1) && arch (x86_64)         ghc-options:    -O0 @@ -71,6 +81,7 @@                         XMonad.Doc.Configuring                         XMonad.Doc.Extending                         XMonad.Doc.Developing+                        XMonad.Actions.BluetileCommands                         XMonad.Actions.Commands                         XMonad.Actions.ConstrainedResize                         XMonad.Actions.CopyWindow@@ -81,6 +92,8 @@                         XMonad.Actions.DeManage                         XMonad.Actions.DwmPromote                         XMonad.Actions.DynamicWorkspaces+                        XMonad.Actions.DynamicWorkspaceGroups+                        XMonad.Actions.DynamicWorkspaceOrder                         XMonad.Actions.FindEmptyWorkspace                         XMonad.Actions.FlexibleManipulate                         XMonad.Actions.FlexibleResize@@ -88,6 +101,7 @@                         XMonad.Actions.FloatSnap                         XMonad.Actions.FocusNth                         XMonad.Actions.GridSelect+                        XMonad.Actions.GroupNavigation                         XMonad.Actions.MessageFeedback                         XMonad.Actions.MouseGestures                         XMonad.Actions.MouseResize@@ -97,8 +111,9 @@                         XMonad.Actions.PhysicalScreens                         XMonad.Actions.Plane                         XMonad.Actions.Promote-                        XMonad.Actions.RotSlaves                         XMonad.Actions.RandomBackground+                        XMonad.Actions.KeyRemap+                        XMonad.Actions.RotSlaves                         XMonad.Actions.Search                         XMonad.Actions.SimpleDate                         XMonad.Actions.SinkAll@@ -107,36 +122,46 @@                         XMonad.Actions.SwapWorkspaces                         XMonad.Actions.TagWindows                         XMonad.Actions.TopicSpace-                        XMonad.Actions.UpdatePointer                         XMonad.Actions.UpdateFocus+                        XMonad.Actions.UpdatePointer                         XMonad.Actions.Warp+                        XMonad.Actions.WindowBringer+                        XMonad.Actions.WindowGo                         XMonad.Actions.WindowMenu                         XMonad.Actions.WindowNavigation-                        XMonad.Actions.WindowGo-                        XMonad.Actions.WindowBringer                         XMonad.Actions.WithAll                         XMonad.Actions.WorkspaceCursors+                        XMonad.Actions.WorkspaceNames                         XMonad.Config.Arossato                         XMonad.Config.Azerty+                        XMonad.Config.Bluetile                         XMonad.Config.Desktop                         XMonad.Config.Droundy                         XMonad.Config.Gnome                         XMonad.Config.Kde                         XMonad.Config.Sjanssen                         XMonad.Config.Xfce+                        XMonad.Hooks.CurrentWorkspaceOnTop+                        XMonad.Hooks.DebugKeyEvents                         XMonad.Hooks.DynamicHooks                         XMonad.Hooks.DynamicLog                         XMonad.Hooks.EwmhDesktops                         XMonad.Hooks.FadeInactive+                        XMonad.Hooks.FadeWindows                         XMonad.Hooks.FloatNext+                        XMonad.Hooks.ICCCMFocus                         XMonad.Hooks.InsertPosition                         XMonad.Hooks.ManageDocks                         XMonad.Hooks.ManageHelpers+                        XMonad.Hooks.Minimize                         XMonad.Hooks.Place+                        XMonad.Hooks.PositionStoreHooks                         XMonad.Hooks.RestoreMinimized+                        XMonad.Hooks.ScreenCorners                         XMonad.Hooks.Script-                        XMonad.Hooks.SetWMName                         XMonad.Hooks.ServerMode+                        XMonad.Hooks.SetWMName+                        XMonad.Hooks.ToggleHook                         XMonad.Hooks.UrgencyHook                         XMonad.Hooks.WorkspaceByPos                         XMonad.Hooks.XPropManage@@ -144,26 +169,37 @@                         XMonad.Layout.AutoMaster                         XMonad.Layout.BorderResize                         XMonad.Layout.BoringWindows+                        XMonad.Layout.ButtonDecoration                         XMonad.Layout.CenteredMaster                         XMonad.Layout.Circle-                        XMonad.Layout.Cross                         XMonad.Layout.Column                         XMonad.Layout.Combo                         XMonad.Layout.ComboP+                        XMonad.Layout.Cross                         XMonad.Layout.Decoration+                        XMonad.Layout.DecorationAddons                         XMonad.Layout.DecorationMadness                         XMonad.Layout.Dishes+                        XMonad.Layout.DraggingVisualizer                         XMonad.Layout.DragPane+                        XMonad.Layout.Drawer                         XMonad.Layout.DwmStyle                         XMonad.Layout.FixedColumn+                        XMonad.Layout.Fullscreen                         XMonad.Layout.Gaps                         XMonad.Layout.Grid                         XMonad.Layout.GridVariants+                        XMonad.Layout.Groups+                        XMonad.Layout.Groups.Examples+                        XMonad.Layout.Groups.Helpers+                        XMonad.Layout.Groups.Wmii                         XMonad.Layout.HintedGrid                         XMonad.Layout.HintedTile                         XMonad.Layout.IM+                        XMonad.Layout.ImageButtonDecoration                         XMonad.Layout.IndependentScreens                         XMonad.Layout.LayoutBuilder+                        XMonad.Layout.LayoutBuilderP                         XMonad.Layout.LayoutCombinators                         XMonad.Layout.LayoutHints                         XMonad.Layout.LayoutModifier@@ -179,6 +215,7 @@                         XMonad.Layout.Mosaic                         XMonad.Layout.MosaicAlt                         XMonad.Layout.MouseResizableTile+                        XMonad.Layout.MultiColumns                         XMonad.Layout.MultiToggle                         XMonad.Layout.MultiToggle.Instances                         XMonad.Layout.Named@@ -186,37 +223,42 @@                         XMonad.Layout.NoFrillsDecoration                         XMonad.Layout.OneBig                         XMonad.Layout.PerWorkspace+                        XMonad.Layout.PositionStoreFloat                         XMonad.Layout.Reflect+                        XMonad.Layout.Renamed                         XMonad.Layout.ResizableTile                         XMonad.Layout.ResizeScreen                         XMonad.Layout.Roledex-                        XMonad.Layout.Simplest+                        XMonad.Layout.ShowWName                         XMonad.Layout.SimpleDecoration                         XMonad.Layout.SimpleFloat+                        XMonad.Layout.Simplest+                        XMonad.Layout.SimplestFloat                         XMonad.Layout.Spacing                         XMonad.Layout.Spiral                         XMonad.Layout.Square-                        XMonad.Layout.ShowWName                         XMonad.Layout.StackTile                         XMonad.Layout.SubLayouts-                        XMonad.Layout.Tabbed                         XMonad.Layout.TabBarDecoration+                        XMonad.Layout.Tabbed                         XMonad.Layout.ThreeColumns                         XMonad.Layout.ToggleLayouts+                        XMonad.Layout.TrackFloating                         XMonad.Layout.TwoPane                         XMonad.Layout.WindowArranger                         XMonad.Layout.WindowNavigation+                        XMonad.Layout.WindowSwitcherDecoration                         XMonad.Layout.WorkspaceDir-                        XMonad.Layout.SimplestFloat-                        XMonad.Prompt.Directory+                        XMonad.Layout.ZoomRow                         XMonad.Prompt                         XMonad.Prompt.AppendFile                         XMonad.Prompt.AppLauncher-                        XMonad.Prompt.Input+                        XMonad.Prompt.Directory+                        XMonad.Prompt.DirExec                         XMonad.Prompt.Email+                        XMonad.Prompt.Input                         XMonad.Prompt.Layout                         XMonad.Prompt.Man-                        XMonad.Prompt.DirExec                         XMonad.Prompt.RunOrRaise                         XMonad.Prompt.Shell                         XMonad.Prompt.Ssh@@ -228,22 +270,27 @@                         XMonad.Util.CustomKeys                         XMonad.Util.Dmenu                         XMonad.Util.Dzen+                        XMonad.Util.ExtensibleState                         XMonad.Util.EZConfig                         XMonad.Util.Font+                        XMonad.Util.Image                         XMonad.Util.Invisible                         XMonad.Util.Loggers                         XMonad.Util.NamedActions                         XMonad.Util.NamedScratchpad                         XMonad.Util.NamedWindows-                        XMonad.Util.StringProp+                        XMonad.Util.Paste+                        XMonad.Util.PositionStore+                        XMonad.Util.Replace                         XMonad.Util.Run                         XMonad.Util.Scratchpad+                        XMonad.Util.SpawnOnce+                        XMonad.Util.Stack+                        XMonad.Util.StringProp                         XMonad.Util.Themes                         XMonad.Util.Timer                         XMonad.Util.Types                         XMonad.Util.WindowProperties                         XMonad.Util.WorkspaceCompare-                        XMonad.Util.Paste-                        XMonad.Util.Replace                         XMonad.Util.XSelection                         XMonad.Util.XUtils