From 01ca103d6817aad3788e1c1f76daf9b83fd905a5 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Fri, 9 Nov 2007 16:21:24 +0100 Subject: add withWorkspace prompt, which automatically creates workspace if nonexistent. darcs-hash:20071109152124-72aca-966fc515a4e1f52fc16929680e152c27d20fb60c.gz --- XMonad/Actions/DynamicWorkspaces.hs | 47 +++++++++++++++++++++++-------------- XMonad/Config/Droundy.hs | 14 ++--------- 2 files changed, 31 insertions(+), 30 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs index 855467a..e64185d 100644 --- a/XMonad/Actions/DynamicWorkspaces.hs +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -17,6 +17,7 @@ module XMonad.Actions.DynamicWorkspaces ( -- * Usage -- $usage addWorkspace, removeWorkspace, + withWorkspace, selectWorkspace, renameWorkspace, toNthWorkspace, withNthWorkspace ) where @@ -25,12 +26,11 @@ import Control.Monad.Reader ( asks ) import Control.Monad.State ( gets ) import Data.List ( sort ) -import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet, config, layoutHook ) +import XMonad ( X, XState(..), WindowSet, config, layoutHook ) import XMonad.Operations import XMonad.StackSet hiding (filter, modify, delete) -import Graphics.X11.Xlib ( Window ) import XMonad.Prompt.Workspace -import XMonad.Prompt ( XPConfig ) +import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) ) -- $usage -- You can use this module with the following in your Config.hs file: @@ -48,8 +48,20 @@ import XMonad.Prompt ( XPConfig ) -- > ++ -- > zip (zip (repeat (modMask .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) -allPossibleTags :: [WorkspaceId] -allPossibleTags = map (:"") ['0'..] +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 + +withWorkspace :: XPConfig -> (String -> X ()) -> X () +withWorkspace c job = do ws <- gets (workspaces . windowset) + let ts = sort $ map tag ws + job' t | t `elem` ts = job t + | otherwise = addHiddenWorkspace t >> job t + mkXPrompt (Wor "") c (mkCompl ts) job' renameWorkspace :: XPConfig -> X () renameWorkspace conf = workspacePrompt conf $ \w -> @@ -72,15 +84,17 @@ withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windows selectWorkspace :: XPConfig -> X () selectWorkspace conf = workspacePrompt conf $ \w -> - do l <- asks (layoutHook . config) - windows $ \s -> if tagMember w s - then greedyView w s - else addWorkspace' w l s + do s <- gets windowset + if tagMember w s + then windows $ greedyView w + else addWorkspace w + +addWorkspace :: String -> X () +addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag) -addWorkspace :: Layout Window -> X () -addWorkspace l = do s <- gets windowset - let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags - windows (addWorkspace' newtag l) +addHiddenWorkspace :: String -> X () +addHiddenWorkspace newtag = do l <- asks (layoutHook . config) + windows (addHiddenWorkspace' newtag l) removeWorkspace :: X () removeWorkspace = do s <- gets windowset @@ -91,11 +105,8 @@ removeWorkspace = do s <- gets windowset windows (removeWorkspace' (tag torem)) _ -> return () -addWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd -addWorkspace' newtag l s@(StackSet { current = scr@(Screen { workspace = w }) - , hidden = ws }) - = s { current = scr { workspace = Workspace newtag l Nothing } - , hidden = w:ws } +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 } removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc }) diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index 5e72ac0..95d10e1 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -43,7 +43,6 @@ import XMonad.Layout.WorkspaceDir import XMonad.Layout.ToggleLayouts import XMonad.Prompt -import XMonad.Prompt.Workspace import XMonad.Prompt.Shell import XMonad.Actions.CopyWindow @@ -70,8 +69,6 @@ keys x = M.fromList $ , ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default - , ((modMask x, xK_n ), refresh) -- %! Resize viewed windows to the correct size - -- move focus up or down the window stack , ((modMask x, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window , ((modMask x, xK_j ), windows W.focusDown) -- %! Move focus to the next window @@ -112,15 +109,12 @@ keys x = M.fromList $ , ((modMask x .|. shiftMask, xK_x ), changeDir myXPConfig) , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) , ((modMask x .|. shiftMask, xK_v ), selectWorkspace myXPConfig) - , ((modMask x, xK_m ), workspacePrompt myXPConfig (windows . W.shift)) - , ((modMask x .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . copy)) + , ((modMask x, xK_m ), withWorkspace myXPConfig (windows . W.shift)) + , ((modMask x .|. shiftMask, xK_m ), withWorkspace myXPConfig (windows . copy)) , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig) , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) - , ((modMask x .|. controlMask, xK_f), sendMessage (JumpToLayout "Full")) ] - -- % Extension-provided key bindings lists - ++ zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) ++ @@ -137,12 +131,8 @@ mouseBindings x = M.fromList $ -- mod-button3 %! Set the window to floating mode and resize by dragging , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w)) -- you may also bind events to the mouse scroll wheel (button4 and button5) - - -- % Extension-provided mouse bindings ] --- % Extension-provided definitions - config :: XConfig config = defaultConfig { borderWidth = 1 -- Width of the window border in pixels. -- cgit v1.2.3