From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- XMonad/Actions/Commands.hs | 114 +++++++++++++++++++ XMonad/Actions/ConstrainedResize.hs | 58 ++++++++++ XMonad/Actions/CopyWindow.hs | 79 ++++++++++++++ XMonad/Actions/CycleWS.hs | 102 +++++++++++++++++ XMonad/Actions/DeManage.hs | 58 ++++++++++ XMonad/Actions/DwmPromote.hs | 47 ++++++++ XMonad/Actions/DynamicWorkspaces.hs | 107 ++++++++++++++++++ XMonad/Actions/FindEmptyWorkspace.hs | 72 ++++++++++++ XMonad/Actions/FlexibleManipulate.hs | 122 +++++++++++++++++++++ XMonad/Actions/FlexibleResize.hs | 67 ++++++++++++ XMonad/Actions/FloatKeys.hs | 112 +++++++++++++++++++ XMonad/Actions/FocusNth.hs | 48 ++++++++ XMonad/Actions/MouseGestures.hs | 116 ++++++++++++++++++++ XMonad/Actions/RotSlaves.hs | 60 ++++++++++ XMonad/Actions/RotView.hs | 53 +++++++++ XMonad/Actions/SimpleDate.hs | 39 +++++++ XMonad/Actions/SinkAll.hs | 36 ++++++ XMonad/Actions/Submap.hs | 71 ++++++++++++ XMonad/Actions/SwapWorkspaces.hs | 55 ++++++++++ XMonad/Actions/TagWindows.hs | 205 +++++++++++++++++++++++++++++++++++ XMonad/Actions/Warp.hs | 74 +++++++++++++ XMonad/Actions/WindowBringer.hs | 84 ++++++++++++++ XMonad/Actions/WmiiActions.hs | 102 +++++++++++++++++ 23 files changed, 1881 insertions(+) create mode 100644 XMonad/Actions/Commands.hs create mode 100644 XMonad/Actions/ConstrainedResize.hs create mode 100644 XMonad/Actions/CopyWindow.hs create mode 100644 XMonad/Actions/CycleWS.hs create mode 100644 XMonad/Actions/DeManage.hs create mode 100644 XMonad/Actions/DwmPromote.hs create mode 100644 XMonad/Actions/DynamicWorkspaces.hs create mode 100644 XMonad/Actions/FindEmptyWorkspace.hs create mode 100644 XMonad/Actions/FlexibleManipulate.hs create mode 100644 XMonad/Actions/FlexibleResize.hs create mode 100644 XMonad/Actions/FloatKeys.hs create mode 100644 XMonad/Actions/FocusNth.hs create mode 100644 XMonad/Actions/MouseGestures.hs create mode 100644 XMonad/Actions/RotSlaves.hs create mode 100644 XMonad/Actions/RotView.hs create mode 100644 XMonad/Actions/SimpleDate.hs create mode 100644 XMonad/Actions/SinkAll.hs create mode 100644 XMonad/Actions/Submap.hs create mode 100644 XMonad/Actions/SwapWorkspaces.hs create mode 100644 XMonad/Actions/TagWindows.hs create mode 100644 XMonad/Actions/Warp.hs create mode 100644 XMonad/Actions/WindowBringer.hs create mode 100644 XMonad/Actions/WmiiActions.hs (limited to 'XMonad/Actions') diff --git a/XMonad/Actions/Commands.hs b/XMonad/Actions/Commands.hs new file mode 100644 index 0000000..eaf6624 --- /dev/null +++ b/XMonad/Actions/Commands.hs @@ -0,0 +1,114 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Commands +-- Copyright : (c) David Glasser 2007 +-- License : BSD3 +-- +-- Maintainer : glasser@mit.edu +-- Stability : stable +-- Portability : portable +-- +-- Allows you to run internal xmonad commands (X () actions) using +-- a dmenu menu in addition to key bindings. Requires dmenu and +-- the Dmenu XMonad.Actions module. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Commands ( + -- * Usage + -- $usage + commandMap, + runCommand, + runCommand', + workspaceCommands, + screenCommands, + defaultCommands + ) where + +import XMonad +import XMonad.Operations +import XMonad.StackSet hiding (workspaces) +import XMonad.Util.Dmenu (dmenu) +import XMonad.Layouts + +import Control.Monad.Reader +import qualified Data.Map as M +import System.Exit +import Data.Maybe + +-- $usage +-- +-- To use, modify your Config.hs to: +-- +-- > import XMonad.Actions.Commands +-- +-- and add a keybinding to the runCommand action: +-- +-- > , ((modMask .|. controlMask, xK_y), runCommand commands) +-- +-- and define the list commands: +-- +-- > commands :: [(String, X ())] +-- > commands = defaultCommands +-- +-- A popup menu of internal xmonad commands will appear. You can +-- change the commands by changing the contents of the list +-- 'commands'. (If you like it enough, you may even want to get rid +-- of many of your other key bindings!) + +-- %def commands :: [(String, X ())] +-- %def commands = defaultCommands +-- %import XMonad.Actions.Commands +-- %keybind , ((modMask .|. controlMask, xK_y), runCommand commands) + +commandMap :: [(String, X ())] -> M.Map String (X ()) +commandMap c = M.fromList c + +workspaceCommands :: X [(String, X ())] +workspaceCommands = asks (workspaces . config) >>= \spaces -> return + [((m ++ show i), windows $ f i) + | i <- spaces + , (f, m) <- [(view, "view"), (shift, "shift")] ] + +screenCommands :: [(String, X ())] +screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f)) + | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes + , (f, m) <- [(view, "screen"), (shift, "screen-to-")] + ] + +defaultCommands :: X [(String, X ())] +defaultCommands = do + wscmds <- workspaceCommands + return $ wscmds ++ screenCommands ++ otherCommands + where + sr = broadcastMessage ReleaseResources + otherCommands = + [ ("shrink" , sendMessage Shrink ) + , ("expand" , sendMessage Expand ) + , ("next-layout" , sendMessage NextLayout ) + , ("default-layout" , asks (layoutHook . config) >>= setLayout ) + , ("restart-wm" , sr >> restart Nothing True ) + , ("restart-wm-no-resume", sr >> restart Nothing False ) + , ("xterm" , spawn =<< asks (terminal . config) ) + , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) + , ("kill" , kill ) + , ("refresh" , refresh ) + , ("focus-up" , windows $ focusUp ) + , ("focus-down" , windows $ focusDown ) + , ("swap-up" , windows $ swapUp ) + , ("swap-down" , windows $ swapDown ) + , ("swap-master" , windows $ swapMaster ) + , ("sink" , withFocused $ windows . sink ) + , ("quit-wm" , io $ exitWith ExitSuccess ) + ] + +runCommand :: [(String, X ())] -> X () +runCommand cl = do + let m = commandMap cl + choice <- dmenu (M.keys m) + fromMaybe (return ()) (M.lookup choice m) + +runCommand' :: String -> X () +runCommand' c = do + m <- fmap commandMap defaultCommands + fromMaybe (return ()) (M.lookup c m) diff --git a/XMonad/Actions/ConstrainedResize.hs b/XMonad/Actions/ConstrainedResize.hs new file mode 100644 index 0000000..cb49d0a --- /dev/null +++ b/XMonad/Actions/ConstrainedResize.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.ConstrainedResize +-- Copyright : (c) Dougal Stanton +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you constrain the aspect ratio of a floating +-- window by holding shift while you resize. +-- +-- Useful for making a nice circular XClock window. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.ConstrainedResize ( + -- * Usage + -- $usage + XMonad.Actions.ConstrainedResize.mouseResizeWindow +) where + +import XMonad +import XMonad.Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage +-- Put something like this in your Config.hs file: +-- +-- > import qualified XMonad.Actions.ConstrainedResize as Sqr +-- > mouseBindings = M.fromList +-- > [ ... +-- > , ((modMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) +-- > , ((modMask .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) ] +-- +-- The line without the shiftMask replaces the standard mouse resize function call, so it's +-- not completely necessary but seems neater this way. + +-- %import qualified XMonad.Actions.ConstrainedResize as Sqr +-- %mousebind , ((modMask, button3), (\\w -> focus w >> Sqr.mouseResizeWindow w False)) +-- %mousebind , ((modMask .|. shiftMask, button3), (\\w -> focus w >> Sqr.mouseResizeWindow w True)) + +-- | Resize (floating) window with optional aspect ratio constraints. +mouseResizeWindow :: Window -> Bool -> X () +mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) + mouseDrag (\ex ey -> do + let x = ex - fromIntegral (wa_x wa) + y = ey - fromIntegral (wa_y wa) + sz = if c then (max x y, max x y) else (x,y) + io $ resizeWindow d w `uncurry` + applySizeHints sh sz) + (float w) diff --git a/XMonad/Actions/CopyWindow.hs b/XMonad/Actions/CopyWindow.hs new file mode 100644 index 0000000..cb6a619 --- /dev/null +++ b/XMonad/Actions/CopyWindow.hs @@ -0,0 +1,79 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.CopyWindow +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a binding to duplicate a window on multiple workspaces, +-- providing dwm-like tagging functionality. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.CopyWindow ( + -- * Usage + -- $usage + copy, kill1 + ) where + +import Prelude hiding ( filter ) +import Control.Monad.State ( gets ) +import qualified Data.List as L +import XMonad +import XMonad.Operations ( windows, kill ) +import XMonad.StackSet + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Actions.CopyWindow +-- +-- > -- mod-[1..9] @@ Switch to workspace N +-- > -- mod-shift-[1..9] @@ Move client to workspace N +-- > -- mod-control-shift-[1..9] @@ Copy client to workspace N +-- > [((m .|. modMask, k), f i) +-- > | (i, k) <- zip workspaces [xK_1 ..] +-- > , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] +-- +-- you may also wish to redefine the binding to kill a window so it only +-- removes it from the current workspace, if it's present elsewhere: +-- +-- > , ((modMask .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window + +-- %import XMonad.Actions.CopyWindow +-- %keybind -- comment out default close window binding above if you uncomment this: +-- %keybind , ((modMask .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window +-- %keybindlist ++ +-- %keybindlist -- mod-[1..9] @@ Switch to workspace N +-- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N +-- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N +-- %keybindlist [((m .|. modMask, k), f i) +-- %keybindlist | (i, k) <- zip workspaces [xK_1 ..] +-- %keybindlist , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] + +-- | copy. Copy a window to a new workspace. +copy :: WorkspaceId -> WindowSet -> WindowSet +copy n = copy' + where copy' s = if n `tagMember` s && n /= tag (workspace (current s)) + then maybe s (go s) (peek s) + else s + go s w = view (tag (workspace (current s))) $ insertUp' w $ view n s + insertUp' a s = modify (Just $ Stack a [] []) + (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s + +-- | Remove the focussed window from this workspace. If it's present in no +-- other workspace, then kill it instead. If we do kill it, we'll get a +-- delete notify back from X. +-- +-- There are two ways to delete a window. Either just kill it, or if it +-- supports the delete protocol, send a delete event (e.g. firefox) +-- +kill1 :: X () +kill1 = do ss <- gets windowset + whenJust (peek ss) $ \w -> if member w $ delete'' w ss + then windows $ delete'' w + else kill + where delete'' w = modify Nothing (filter (/= w)) diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs new file mode 100644 index 0000000..6e854bc --- /dev/null +++ b/XMonad/Actions/CycleWS.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.CycleWS +-- Copyright : (c) Joachim Breitner , +-- Nelson Elhage (`toggleWS' function) +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Joachim Breitner +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle forward or backward through the list +-- of workspaces, and to move windows there. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.CycleWS ( + -- * Usage + -- $usage + nextWS, + prevWS, + shiftToNext, + shiftToPrev, + toggleWS, + ) where + +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( gets ) +import Data.List ( sortBy, findIndex ) +import Data.Maybe ( fromMaybe ) +import Data.Ord ( comparing ) + +import XMonad hiding (workspaces) +import qualified XMonad (workspaces) +import XMonad.StackSet hiding (filter) +import XMonad.Operations + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Actions.CycleWS +-- +-- > , ((modMask, xK_Right), nextWS) +-- > , ((modMask, xK_Left), prevWS) +-- > , ((modMask .|. shiftMask, xK_Right), shiftToNext) +-- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev) +-- > , ((modMask, xK_t), toggleWS) +-- +-- If you want to follow the moved window, you can use both actions: +-- +-- > , ((modMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) +-- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) +-- + +-- %import XMonad.Actions.CycleWS +-- %keybind , ((modMask, xK_Right), nextWS) +-- %keybind , ((modMask, xK_Left), prevWS) +-- %keybind , ((modMask .|. shiftMask, xK_Right), shiftToNext) +-- %keybind , ((modMask .|. shiftMask, xK_Left), shiftToPrev) +-- %keybind , ((modMask, xK_t), toggleWS) + + +-- | Switch to next workspace +nextWS :: X () +nextWS = switchWorkspace 1 + +-- | Switch to previous workspace +prevWS :: X () +prevWS = switchWorkspace (-1) + +-- | Move focused window to next workspace +shiftToNext :: X () +shiftToNext = shiftBy 1 + +-- | Move focused window to previous workspace +shiftToPrev :: X () +shiftToPrev = shiftBy (-1) + +-- | Toggle to the workspace displayed previously +toggleWS :: X () +toggleWS = windows $ view =<< tag . head . hidden + +switchWorkspace :: Int -> X () +switchWorkspace d = wsBy d >>= windows . greedyView + +shiftBy :: Int -> X () +shiftBy d = wsBy d >>= windows . shift + +wsBy :: Int -> X (WorkspaceId) +wsBy d = do + ws <- gets windowset + spaces <- asks (XMonad.workspaces . config) + let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws) + let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs + let next = orderedWs !! ((now + d) `mod` length orderedWs) + return $ tag next + +wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int +wsIndex spaces ws = findIndex (== tag ws) spaces + +findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int +findWsIndex ws wss = findIndex ((== tag ws) . tag) wss diff --git a/XMonad/Actions/DeManage.hs b/XMonad/Actions/DeManage.hs new file mode 100644 index 0000000..9bff48a --- /dev/null +++ b/XMonad/Actions/DeManage.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DeManage +-- Copyright : (c) Spencer Janssen +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides a method to cease management of a window, without +-- unmapping it. This is especially useful for applications like kicker and +-- gnome-panel. +-- +-- To make a panel display correctly with xmonad: +-- +-- * Determine the pixel size of the panel, add that value to defaultGaps +-- +-- * Launch the panel +-- +-- * Give the panel window focus, then press mod-d +-- +-- * Convince the panel to move\/resize to the correct location. Changing the +-- panel's position setting several times seems to work. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DeManage ( + -- * Usage + -- $usage + demanage + ) where + +import qualified XMonad.StackSet as W +import XMonad +import XMonad.Operations +import Control.Monad.State +import Graphics.X11 (Window) + +-- $usage +-- To use demanage, add this import: +-- +-- > import XMonad.Actions.DeManage +-- +-- And add a keybinding to it: +-- +-- > , ((modMask, xK_d ), withFocused demanage) +-- + +-- %import XMonad.Actions.DeManage +-- %keybind , ((modMask, xK_d ), withFocused demanage) + +-- | Stop managing the current focused window. +demanage :: Window -> X () +demanage w = do + -- use modify to defeat automatic 'unmanage' calls. + modify (\s -> s { windowset = W.delete w (windowset s) }) + refresh diff --git a/XMonad/Actions/DwmPromote.hs b/XMonad/Actions/DwmPromote.hs new file mode 100644 index 0000000..dfe7cc6 --- /dev/null +++ b/XMonad/Actions/DwmPromote.hs @@ -0,0 +1,47 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DwmPromote +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : arcatan@kapsi.fi +-- Stability : unstable +-- Portability : unportable +-- +-- Dwm-like swap function for xmonad. +-- +-- Swaps focused window with the master window. If focus is in the +-- master, swap it with the next window in the stack. Focus stays in the +-- master. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DwmPromote ( + -- * Usage + -- $usage + dwmpromote + ) where + +import XMonad +import XMonad.Operations (windows) +import XMonad.StackSet + +-- $usage +-- +-- To use, modify your Config.hs to: +-- +-- > import XMonad.Actions.DwmPromote +-- +-- and add a keybinding or substitute promote with dwmpromote: +-- +-- > , ((modMask, xK_Return), dwmpromote) + +-- %import XMonad.Actions.DwmPromote +-- %keybind , ((modMask, xK_Return), dwmpromote) + +dwmpromote :: X () +dwmpromote = windows $ modify' $ + \c -> case c of + Stack _ [] [] -> c + Stack t [] (x:rs) -> Stack x [] (t:rs) + Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs new file mode 100644 index 0000000..6aa3fb9 --- /dev/null +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -0,0 +1,107 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DynamicWorkspaces +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to add and delete workspaces. Note that you may only +-- delete a workspace that is already empty. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DynamicWorkspaces ( + -- * Usage + -- $usage + addWorkspace, removeWorkspace, + selectWorkspace, renameWorkspace, + toNthWorkspace, withNthWorkspace + ) where + +import Control.Monad.State ( gets ) +import Data.List ( sort ) + +import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet ) +import XMonad.Operations +import XMonad.StackSet hiding (filter, modify, delete) +import Graphics.X11.Xlib ( Window ) +import XMonad.Prompt.Workspace +import XMonad.Prompt ( XPConfig ) + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Actions.DynamicWorkspaces +-- +-- > , ((modMask .|. shiftMask, xK_n), selectWorkspace defaultXPConfig layoutHook) +-- > , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace) +-- > , ((modMask .|. shiftMask .|. controlMask, xK_r), renameWorkspace defaultXPConfig) +-- +-- > -- mod-[1..9] %! Switch to workspace N +-- > -- mod-shift-[1..9] %! Move client to workspace N +-- > ++ +-- > zip (zip (repeat modMask) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) +-- > ++ +-- > zip (zip (repeat (modMask .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) + +allPossibleTags :: [WorkspaceId] +allPossibleTags = map (:"") ['0'..] + +renameWorkspace :: XPConfig -> X () +renameWorkspace conf = workspacePrompt conf $ \w -> + windows $ \s -> let sett wk = wk { tag = w } + setscr scr = scr { workspace = sett $ workspace scr } + sets q = q { current = setscr $ current q } + in sets $ removeWorkspace' w s + +toNthWorkspace :: (String -> X ()) -> Int -> X () +toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset) + case drop wnum ws of + (w:_) -> job w + [] -> return () + +withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () +withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset) + case drop wnum ws of + (w:_) -> windows $ job w + [] -> return () + +selectWorkspace :: XPConfig -> Layout Window -> X () +selectWorkspace conf l = workspacePrompt conf $ \w -> + windows $ \s -> if tagMember w s + then greedyView w s + else addWorkspace' w l s + +addWorkspace :: Layout Window -> X () +addWorkspace l = do s <- gets windowset + let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags + windows (addWorkspace' newtag l) + +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 () + +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 } + +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 }) + , hidden = (w:ws) }) + | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } } + , hidden = ws } + where meld Nothing Nothing = Nothing + meld x Nothing = x + meld Nothing x = x + meld (Just x) (Just y) = differentiate (integrate x ++ integrate y) +removeWorkspace' _ s = s diff --git a/XMonad/Actions/FindEmptyWorkspace.hs b/XMonad/Actions/FindEmptyWorkspace.hs new file mode 100644 index 0000000..a0fb621 --- /dev/null +++ b/XMonad/Actions/FindEmptyWorkspace.hs @@ -0,0 +1,72 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FindEmptyWorkspace +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : arcatan@kapsi.fi +-- Stability : unstable +-- Portability : unportable +-- +-- Find an empty workspace in XMonad. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.FindEmptyWorkspace ( + -- * Usage + -- $usage + viewEmptyWorkspace, tagToEmptyWorkspace + ) where + +import Control.Monad.State +import Data.List +import Data.Maybe ( isNothing ) + +import XMonad +import XMonad.StackSet + +import XMonad.Operations + +-- $usage +-- +-- To use, modify your Config.hs to: +-- +-- > import XMonad.Actions.FindEmptyWorkspace +-- +-- and add a keybinding: +-- +-- > , ((modMask, xK_m ), viewEmptyWorkspace) +-- > , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) +-- +-- Now you can jump to an empty workspace with mod-m. Mod-shift-m will +-- tag the current window to an empty workspace and view it. + +-- %import XMonad.Actions.FindEmptyWorkspace +-- %keybind , ((modMask, xK_m ), viewEmptyWorkspace) +-- %keybind , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) + + +-- | Find the first hidden empty workspace in a StackSet. Returns +-- Nothing if all workspaces are in use. Function searches currently +-- focused workspace, other visible workspaces (when in Xinerama) and +-- hidden workspaces in this order. +findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a) +findEmptyWorkspace = find (isNothing . stack) . allWorkspaces + where + allWorkspaces ss = (workspace . current) ss : + (map workspace . visible) ss ++ hidden ss + +withEmptyWorkspace :: (WorkspaceId -> X ()) -> X () +withEmptyWorkspace f = do + ws <- gets windowset + whenJust (findEmptyWorkspace ws) (f . tag) + +-- | Find and view an empty workspace. Do nothing if all workspaces are +-- in use. +viewEmptyWorkspace :: X () +viewEmptyWorkspace = withEmptyWorkspace (windows . view) + +-- | Tag current window to an empty workspace and view it. Do nothing if +-- all workspaces are in use. +tagToEmptyWorkspace :: X () +tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs new file mode 100644 index 0000000..b7fa25d --- /dev/null +++ b/XMonad/Actions/FlexibleManipulate.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FlexibleManipulate +-- Copyright : (c) Michael Sloan +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you move and resize floating windows without warping the mouse. +-- +----------------------------------------------------------------------------- + +-- Based on the FlexibleResize code by Lukas Mai (Mauke) + +module XMonad.Actions.FlexibleManipulate ( + -- * Usage + -- $usage + mouseWindow, discrete, linear, resize, position +) where + +import XMonad +import XMonad.Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage +-- Add this import to your Config.hs file: +-- +-- > import qualified XMonad.Actions.FlexibleManipulate as Flex +-- +-- Set one of the mouse button bindings up like this: +-- +-- > mouseBindings = M.fromList +-- > [ ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) ], ... +-- +-- Flex.linear indicates that positions between the edges and the middle +-- indicate a combination scale\/position. +-- Flex.discrete indicates that there are discrete pick regions. (window +-- is divided by thirds for each axis) +-- Flex.resize performs only resize of the window, based on which quadrant +-- the mouse is in +-- Flex.position is similar to the built-in mouseMoveWindow +-- +-- You can also write your own function for this parameter. It should take +-- a value between 0 and 1 indicating position, and return a value indicating +-- the corresponding position if plain Flex.linear was used. + +-- %import qualified XMonad.Actions.FlexibleManipulate as Flex +-- %mousebind , ((modMask, button1), (\\w -> focus w >> Flex.mouseWindow Flex.linear w)) + +discrete, linear, resize, position :: Double -> Double + +discrete x | x < 0.33 = 0 + | x > 0.66 = 1 + | otherwise = 0.5 + +linear = id + +resize x = if x < 0.5 then 0 else 1 +position = const 0.5 + +mouseWindow :: (Double -> Double) -> Window -> X () +mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs + sh <- io $ getWMNormalHints d w + pointer <- io $ queryPointer d w >>= return . pointerPos + + 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 + atl = ((1, 1) - fc) * mul + abr = fc * mul + mouseDrag (\ex ey -> io $ do + let offset = (fromIntegral ex, fromIntegral ey) - pointer + npos = wpos + offset * atl + nbr = (wpos + wsize) + offset * abr + ntl = minP (nbr - (32, 32)) npos --minimum size + nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl) + moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth + return ()) + (float w) + + float w + + where + pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt + winAttrs :: WindowAttributes -> [Pnt] + winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] + + +-- I'd rather I didn't have to do this, but I hate writing component 2d math +type Pnt = (Double, Double) + +pairUp :: [a] -> [(a,a)] +pairUp [] = [] +pairUp [_] = [] +pairUp (x:y:xs) = (x, y) : (pairUp xs) + +mapP :: (a -> b) -> (a, a) -> (b, b) +mapP f (x, y) = (f x, f y) +zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) +zipP f (ax,ay) (bx,by) = (f ax bx, f ay by) + +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 + +instance Fractional Pnt where + fromRational = const undefined + recip = mapP recip diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs new file mode 100644 index 0000000..9f111f7 --- /dev/null +++ b/XMonad/Actions/FlexibleResize.hs @@ -0,0 +1,67 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FlexibleResize +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you resize floating windows from any corner. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.FlexibleResize ( + -- * Usage + -- $usage + XMonad.Actions.FlexibleResize.mouseResizeWindow +) where + +import XMonad +import XMonad.Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Foreign.C.Types + +-- $usage +-- Put something like this in your Config.hs file: +-- +-- > import qualified XMonad.Actions.FlexibleResize as Flex +-- > mouseBindings = M.fromList +-- > [ ... +-- > , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) ] + +-- %import qualified XMonad.Actions.FlexibleResize as Flex +-- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w)) + +mouseResizeWindow :: Window -> X () +mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w + let + [pos_x, pos_y, width, height] = map (fromIntegral . ($ wa)) [wa_x, wa_y, wa_width, wa_height] + west = firstHalf ix width + north = firstHalf iy height + (cx, fx, gx) = mkSel west width pos_x + (cy, fy, gy) = mkSel north height pos_y + io $ warpPointer d none w 0 0 0 0 cx cy + mouseDrag (\ex ey -> do + wa' <- io $ getWindowAttributes d w + let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] + io $ moveResizeWindow d w (fx px (fromIntegral ex)) + (fy py (fromIntegral ey)) + `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) + (float w) + where + firstHalf :: CInt -> Position -> Bool + firstHalf a b = fromIntegral a * 2 <= b + cfst = curry fst + csnd = curry snd + mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Position) + mkSel b k p = + if b + then (0, csnd, ((k + p) -) . fromIntegral) + else (k, cfst, subtract p . fromIntegral) diff --git a/XMonad/Actions/FloatKeys.hs b/XMonad/Actions/FloatKeys.hs new file mode 100644 index 0000000..52ca90e --- /dev/null +++ b/XMonad/Actions/FloatKeys.hs @@ -0,0 +1,112 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FloatKeys +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Move and resize floating windows. +----------------------------------------------------------------------------- + +module XMonad.Actions.FloatKeys ( + -- * Usage + -- $usage + keysMoveWindow, + keysMoveWindowTo, + keysResizeWindow, + keysAbsResizeWindow) where + +import XMonad.Operations +import XMonad +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage +-- > import XMonad.Actions.FloatKeys +-- +-- > , ((modMask, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) +-- > , ((modMask, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) +-- > , ((modMask .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) +-- > , ((modMask .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) +-- > , ((modMask, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) +-- +-- +-- keysMoveWindow (dx, dy) moves the window by dx pixels to the right and dy pixels down +-- +-- keysMoveWindowTo (x, y) (gx, gy) moves the window relative point (gx, gy) to the point (x,y) +-- where (gx,gy) gives a position relative to the window border, i.e. +-- gx = 0 is the left border and gx = 1 the right border +-- gy = 0 is the top border and gy = 1 the bottom border +-- +-- examples on a 1024x768 screen: keysMoveWindowTo (512,384) (1%2, 1%2) centers the window on screen +-- keysMoveWindowTo (1024,0) (1, 0) puts it into the top right corner +-- +-- keysResizeWindow (dx, dy) (gx, gy) changes the width by dx and the height by dy leaving the window +-- relative point (gx, gy) fixed +-- +-- examples: keysResizeWindow (10, 0) (0, 0) makes the window 10 pixels larger to the right +-- keysResizeWindow (10, 0) (0, 1%2) does the same, unless sizeHints are applied +-- keysResizeWindow (10, 10) (1%2, 1%2) adds 5 pixels on each side +-- keysResizeWindow (-10, -10) (0, 1) shrinks the window in direction of the bottom-left corner +-- +-- keysAbsResizeWindow (dx, dy) (ax, ay) changes the width by dx and the height by dy leaving the screen +-- absolut point (ax, ay) fixed +-- +-- examples on a 1024x768 screen: keysAbsResizeWindow (10, 10) (0, 0) enlarge the window and if it is not in the top-left corner it will also be moved away +-- +keysMoveWindow :: D -> Window -> X () +keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx)) + (fromIntegral (fromIntegral (wa_y wa) + dy)) + float w + +keysMoveWindowTo :: P -> G -> Window -> X () +keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa))) + (y - round (gy * fromIntegral (wa_height wa))) + float w + +type G = (Rational, Rational) +type P = (Position, Position) + +keysResizeWindow :: D -> G -> Window -> X () +keysResizeWindow = keysMoveResize keysResizeWindow' + +keysAbsResizeWindow :: D -> D -> Window -> X () +keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow' + +keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D) +keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh)) + where + (nw, nh) = applySizeHints sh (w + dx, h + dy) + nx :: Rational + nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w + ny :: Rational + ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h + +keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D) +keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh)) + where + (nw, nh) = applySizeHints sh (w + dx, h + dy) + nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw + ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh + +keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X () +keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa) + wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa) + (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize + io $ resizeWindow d w `uncurry` wn_dim + io $ moveWindow d w `uncurry` wn_pos + float w + diff --git a/XMonad/Actions/FocusNth.hs b/XMonad/Actions/FocusNth.hs new file mode 100644 index 0000000..42336ef --- /dev/null +++ b/XMonad/Actions/FocusNth.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FocusNth +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Focus the nth window on the screen. +----------------------------------------------------------------------------- + +module XMonad.Actions.FocusNth ( + -- * Usage + -- $usage + focusNth) where + +import XMonad.StackSet +import XMonad.Operations +import XMonad + +-- $usage +-- > import XMonad.Actions.FocusNth + +-- > -- mod4-[1..9] @@ Switch to window N +-- > ++ [((mod4Mask, k), focusNth i) +-- > | (i, k) <- zip [0 .. 8] [xK_1 ..]] + +-- %import XMonad.Actions.FocusNth +-- %keybdindextra ++ +-- %keybdindextra -- mod4-[1..9] @@ Switch to window N +-- %keybdindextra [((mod4Mask, k), focusNth i) +-- %keybdindextra | (i, k) <- zip [0 .. 8] [xK_1 ..]] + +focusNth :: Int -> X () +focusNth = windows . modify' . focusNth' + +focusNth' :: Int -> Stack a -> Stack a +focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s + | otherwise = listToStack n (integrate s) + +listToStack :: Int -> [a] -> Stack a +listToStack n l = Stack t ls rs + where (t:rs) = drop n l + ls = reverse (take n l) + + diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs new file mode 100644 index 0000000..32d7e60 --- /dev/null +++ b/XMonad/Actions/MouseGestures.hs @@ -0,0 +1,116 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.MouseGestures +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Support for simple mouse gestures +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.MouseGestures ( + -- * Usage + -- $usage + Direction(..), + mouseGesture +) where + +import XMonad +import XMonad.Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import Control.Monad.Reader +import Data.IORef +import qualified Data.Map as M +import Data.Map (Map) + +import System.IO + +-- $usage +-- In your Config.hs: +-- +-- > import XMonad.Actions.MouseGestures +-- > ... +-- > mouseBindings = M.fromList $ +-- > [ ... +-- > , ((modMask .|. shiftMask, button3), mouseGesture gestures) +-- > ] +-- > where +-- > gestures = M.fromList +-- > [ ([], focus) +-- > , ([U], \w -> focus w >> windows W.swapUp) +-- > , ([D], \w -> focus w >> windows W.swapDown) +-- > , ([R, D], \_ -> sendMessage NextLayout) +-- > ] +-- +-- This is just an example, of course. You can use any mouse button and +-- gesture definitions you want. + +data Direction = L | U | R | D + deriving (Eq, Ord, Show, Read, Enum, Bounded) + +type Pos = (Position, Position) + +delta :: Pos -> Pos -> Position +delta (ax, ay) (bx, by) = max (d ax bx) (d ay by) + where + d a b = abs (a - b) + +dir :: Pos -> Pos -> Direction +dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax) + where + trans :: Double -> Direction + trans x + | rg (-3/4) (-1/4) x = D + | rg (-1/4) (1/4) x = R + | rg (1/4) (3/4) x = U + | otherwise = L + rg a z x = a <= x && x < z + +debugging :: Int +debugging = 0 + +collect :: IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X () +collect st nx ny = do + let np = (nx, ny) + stx@(op, ds) <- io $ readIORef st + when (debugging > 0) $ io $ putStrLn $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") + case ds of + [] + | insignificant np op -> return () + | otherwise -> io $ writeIORef st (op, [(dir op np, np, op)]) + (d, zp, ap_) : ds' + | insignificant np zp -> return () + | otherwise -> do + let + d' = dir zp np + ds'' + | d == d' = (d, np, ap_) : ds' + | otherwise = (d', np, zp) : ds + io $ writeIORef st (op, ds'') + where + insignificant a b = delta a b < 10 + +extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction] +extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs + +mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X () +mouseGesture tbl win = withDisplay $ \dpy -> do + root <- asks theRoot + let win' = if win == none then root else win + acc <- io $ do + qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win' + when (debugging > 1) $ putStrLn $ show "queryPointer" ++ show qp + when (debugging > 1 && win' == none) $ putStrLn $ show "mouseGesture" ++ "zomg none" + newIORef ((fromIntegral ix, fromIntegral iy), []) + mouseDrag (collect acc) $ do + when (debugging > 0) $ io $ putStrLn $ show "" + gest <- io $ liftM extract $ readIORef acc + case M.lookup gest tbl of + Nothing -> return () + Just f -> f win' diff --git a/XMonad/Actions/RotSlaves.hs b/XMonad/Actions/RotSlaves.hs new file mode 100644 index 0000000..95ef1f4 --- /dev/null +++ b/XMonad/Actions/RotSlaves.hs @@ -0,0 +1,60 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.RotSlaves +-- Copyright : (c) Hans Philipp Annen , Mischa Dieterle +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Hans Philipp Annen +-- Stability : unstable +-- Portability : unportable +-- +-- Rotate all windows except the master window +-- and keep the focus in place. +----------------------------------------------------------------------------- +module XMonad.Actions.RotSlaves ( + -- $usag + rotSlaves', rotSlavesUp, rotSlavesDown, + rotAll', rotAllUp, rotAllDown + ) where + +import XMonad.StackSet +import XMonad.Operations +import XMonad + +-- $usage +-- +-- To use this module, import it with: +-- +-- > import XMonad.Actions.RotSlaves +-- +-- and add a keybinding: +-- +-- > , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) +-- +-- +-- This operation will rotate all windows except the master window, while the focus +-- stays where it is. It is useful together with the TwoPane-Layout (see XMonad.Actions.TwoPane). + +-- %import XMonad.Actions.RotSlaves +-- %keybind , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) + +-- | Rotate the windows in the current stack excluding the first one +rotSlavesUp,rotSlavesDown :: X () +rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l])) +rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l))) + +rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a +rotSlaves' _ s@(Stack _ [] []) = s +rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus +rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise + where (master:ws) = integrate s + (revls',t':rs') = splitAt (length ls) (master:(f ws)) + +-- | Rotate the windows in the current stack +rotAllUp,rotAllDown :: X () +rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l])) +rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l))) + +rotAll' :: ([a] -> [a]) -> Stack a -> Stack a +rotAll' f s = Stack r (reverse revls) rs + where (revls,r:rs) = splitAt (length (up s)) (f (integrate s)) diff --git a/XMonad/Actions/RotView.hs b/XMonad/Actions/RotView.hs new file mode 100644 index 0000000..6d4f8ea --- /dev/null +++ b/XMonad/Actions/RotView.hs @@ -0,0 +1,53 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.RotView +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle through non-empty workspaces. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.RotView ( + -- * Usage + -- $usage + rotView + ) where + +import Control.Monad.State ( gets ) +import Data.List ( sortBy, find ) +import Data.Maybe ( isJust ) +import Data.Ord ( comparing ) + +import XMonad +import XMonad.StackSet hiding (filter) +import XMonad.Operations + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Actions.RotView +-- +-- > , ((modMask .|. shiftMask, xK_Right), rotView True) +-- > , ((modMask .|. shiftMask, xK_Left), rotView False) + +-- %import XMonad.Actions.RotView +-- %keybind , ((modMask .|. shiftMask, xK_Right), rotView True) +-- %keybind , ((modMask .|. shiftMask, xK_Left), rotView False) + +rotView :: Bool -> X () +rotView forward = do + ws <- gets windowset + let currentTag = tag . workspace . current $ ws + sortWs = sortBy (comparing tag) + isNotEmpty = isJust . stack + sorted = sortWs (hidden ws) + pivoted = let (a,b) = span ((< currentTag) . tag) sorted in b ++ a + pivoted' | forward = pivoted + | otherwise = reverse pivoted + nextws = find isNotEmpty pivoted' + whenJust nextws (windows . view . tag) diff --git a/XMonad/Actions/SimpleDate.hs b/XMonad/Actions/SimpleDate.hs new file mode 100644 index 0000000..a30d78b --- /dev/null +++ b/XMonad/Actions/SimpleDate.hs @@ -0,0 +1,39 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.SimpleDate +-- Copyright : (c) Don Stewart 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : dons@cse.unsw.edu.au +-- Stability : stable +-- Portability : portable +-- +-- An example external contrib module for XMonad. +-- Provides a simple binding to dzen2 to print the date as a popup menu. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.SimpleDate ( + -- * Usage + -- $usage + date + ) where + +import XMonad + +-- $usage +-- To use, modify your Config.hs to: +-- +-- > import XMonad.Actions.SimpleDate +-- +-- and add a keybinding: +-- +-- > , ((modMask, xK_d ), date) +-- +-- a popup date menu will now be bound to mod-d + +-- %import XMonad.Actions.SimpleDate +-- %keybind , ((modMask, xK_d ), date) + +date :: X () +date = spawn "(date; sleep 10) | dzen2" diff --git a/XMonad/Actions/SinkAll.hs b/XMonad/Actions/SinkAll.hs new file mode 100644 index 0000000..c193ad0 --- /dev/null +++ b/XMonad/Actions/SinkAll.hs @@ -0,0 +1,36 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XmonadContrib.SinkAll +-- License : BSD3-style (see LICENSE) +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a simple binding that pushes all floating windows on the current +-- workspace back into tiling. +----------------------------------------------------------------------------- + +module XMonad.Actions.SinkAll ( + -- * Usage + -- $usage + sinkAll) where + +import XMonad.Operations +import XMonad +import XMonad.StackSet + +import Graphics.X11.Xlib + +-- $usage +-- > import XMonad.Actions.SinkAll +-- > keys = [ ((modMask .|. shiftMask, xK_t), sinkAll) ] + +-- %import XMonad.Actions.SinkAll +-- %keybind , ((modMask .|. shiftMask, xK_t), sinkAll) + +sinkAll :: X () +sinkAll = withAll sink + +-- Apply a function to all windows on current workspace. +withAll :: (Window -> WindowSet -> WindowSet) -> X () +withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in foldr f ws all' diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs new file mode 100644 index 0000000..98d44c6 --- /dev/null +++ b/XMonad/Actions/Submap.hs @@ -0,0 +1,71 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Submap +-- Copyright : (c) Jason Creighton +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Jason Creighton +-- Stability : unstable +-- Portability : unportable +-- +-- A module that allows the user to create a sub-mapping of keys bindings. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Submap ( + -- * Usage + -- $usage + submap + ) where + +import Control.Monad.Reader + +import XMonad +import XMonad.Operations (cleanMask) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import qualified Data.Map as M + +{- $usage +Allows you to create a sub-mapping of keys. Example: + +> , ((modMask, xK_a), submap . M.fromList $ +> [ ((0, xK_n), spawn "mpc next") +> , ((0, xK_p), spawn "mpc prev") +> , ((0, xK_z), spawn "mpc random") +> , ((0, xK_space), spawn "mpc toggle") +> ]) + +So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the +submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are, +of course, free to use any combination of modifiers in the submapping. However, +anyModifier will not work, because that is a special value passed to XGrabKey() +and not an actual modifier. +-} + +-- %import XMonad.Actions.Submap +-- %keybind , ((modMask, xK_a), submap . M.fromList $ +-- %keybind [ ((0, xK_n), spawn "mpc next") +-- %keybind , ((0, xK_p), spawn "mpc prev") +-- %keybind , ((0, xK_z), spawn "mpc random") +-- %keybind , ((0, xK_space), spawn "mpc toggle") +-- %keybind ]) + +submap :: M.Map (KeyMask, KeySym) (X ()) -> X () +submap keys = do + XConf { theRoot = root, display = d } <- ask + + io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime + + (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do + maskEvent d keyPressMask p + KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p + keysym <- keycodeToKeysym d code 0 + if isModifierKey keysym + then nextkey + else return (m, keysym) + + io $ ungrabKeyboard d currentTime + + m' <- cleanMask m + whenJust (M.lookup (m', s) keys) id diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs new file mode 100644 index 0000000..3f0ca35 --- /dev/null +++ b/XMonad/Actions/SwapWorkspaces.hs @@ -0,0 +1,55 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.SwapWorkspaces +-- Copyright : (c) Devin Mullins +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you swap workspace tags, so you can keep related ones next to +-- each other, without having to move individual windows. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.SwapWorkspaces ( + -- * Usage + -- $usage + swapWithCurrent, + swapWorkspaces + ) where + +import XMonad.StackSet + +-- $usage +-- Add this import to your Config.hs: +-- +-- > import XMonad.Actions.SwapWorkspaces +-- +-- Throw this in your keys definition: +-- +-- > ++ +-- > [((modMask .|. controlMask, k), windows $ swapWithCurrent i) +-- > | (i, k) <- zip workspaces [xK_1 ..]] + +-- %import XMonad.Actions.SwapWorkspaces +-- %keybindlist ++ +-- %keybindlist [((modMask .|. controlMask, k), windows $ swapWithCurrent i) +-- %keybindlist | (i, k) <- zip workspaces [xK_1 ..]] +-- +-- After installing this update, if you're on workspace 1, hitting mod-ctrl-5 +-- will swap workspaces 1 and 5. + +-- | Swaps the currently focused workspace with the given workspace tag, via +-- @swapWorkspaces@. +swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd +swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s + +-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new +-- one with the two corresponding workspaces' tags swapped. +swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd +swapWorkspaces t1 t2 = mapWorkspace swap + where swap w = if tag w == t1 then w { tag = t2 } + else if tag w == t2 then w { tag = t1 } + else w diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs new file mode 100644 index 0000000..938eb10 --- /dev/null +++ b/XMonad/Actions/TagWindows.hs @@ -0,0 +1,205 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.TagWindows +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Functions for tagging windows and selecting them by tags. +----------------------------------------------------------------------------- + +module XMonad.Actions.TagWindows ( + -- * Usage + -- $usage + addTag, delTag, unTag, + setTags, getTags, hasTag, + withTaggedP, withTaggedGlobalP, withFocusedP, + withTagged , withTaggedGlobal , + focusUpTagged, focusUpTaggedGlobal, + focusDownTagged, focusDownTaggedGlobal, + shiftHere, shiftToScreen, + tagPrompt, + tagDelPrompt + ) where + +import Data.List (nub,concat,sortBy) + +import Control.Monad.State +import XMonad.StackSet hiding (filter) +import XMonad.Operations (windows, withFocused) + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonad.Prompt +import XMonad hiding (workspaces) + +-- $usage +-- +-- To use window tags add in your Config.hs: +-- +-- > import XMonad.Actions.TagWindows +-- > import XMonad.Prompt -- to use tagPrompt +-- +-- and add keybindings like as follows: +-- +-- > , ((modMask, xK_f ), withFocused (addTag "abc")) +-- > , ((modMask .|. controlMask, xK_f ), withFocused (delTag "abc")) +-- > , ((modMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) +-- > , ((modMask, xK_d ), withTaggedP "abc" (shiftWin "2")) +-- > , ((modMask .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) +-- > , ((modMask .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") +-- > , ((modMask, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) +-- > , ((modMask .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) +-- > , ((modMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) +-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) +-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) +-- > , ((modWinMask .|. controlMask, xK_g), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- +-- NOTE: Tags are saved as space seperated string and split with 'unwords' thus +-- if you add a tag "a b" the window will have the tags "a" and "b" but not "a b". + +-- %import XMonad.Actions.TagWindows +-- %import XMonad.Prompt -- to use tagPrompt + +-- set multiple tags for a window at once (overriding any previous tags) +setTags :: [String] -> Window -> X () +setTags = setTag . unwords + +-- set a tag for a window (overriding any previous tags) +-- writes it to the "_XMONAD_TAGS" window property +setTag :: String -> Window -> X () +setTag s w = withDisplay $ \d -> + io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s + +-- read all tags of a window +-- reads from the "_XMONAD_TAGS" window property +getTags :: Window -> X [String] +getTags w = withDisplay $ \d -> + io $ catch (internAtom d "_XMONAD_TAGS" False >>= + getTextProperty d w >>= + wcTextPropertyToTextList d) + (\_ -> return [[]]) + >>= return . words . unwords + +-- check a window for the given tag +hasTag :: String -> Window -> X Bool +hasTag s w = (s `elem`) `liftM` getTags w + +-- add a tag to the existing ones +addTag :: String -> Window -> X () +addTag s w = do + tags <- getTags w + if (s `notElem` tags) then setTags (s:tags) w else return () + +-- remove a tag from a window, if it exists +delTag :: String -> Window -> X () +delTag s w = do + tags <- getTags w + setTags (filter (/= s) tags) w + +-- remove all tags +unTag :: Window -> X () +unTag = setTag "" + +-- Move the focus in a group of windows, which share the same given tag. +-- The Global variants move through all workspaces, whereas the other +-- ones operate only on the current workspace +focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X () +focusUpTagged = focusTagged' (reverse . wsToList) +focusDownTagged = focusTagged' wsToList +focusUpTaggedGlobal = focusTagged' (reverse . wsToListGlobal) +focusDownTaggedGlobal = focusTagged' wsToListGlobal + +-- +wsToList :: (Ord i) => StackSet i l a s sd -> [a] +wsToList ws = crs ++ cls + where + (crs, cls) = (cms down, cms (reverse . up)) + cms f = maybe [] f (stack . workspace . current $ ws) + +wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a] +wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls]) + where + curtag = tag . workspace . current $ ws + (crs, cls) = (cms down, cms (reverse . up)) + cms f = maybe [] f (stack . workspace . current $ ws) + (lws, rws) = (mws (<), mws (>)) + mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws + sortByTag = sortBy (\x y -> compare (tag x) (tag y)) + +focusTagged' :: (WindowSet -> [Window]) -> String -> X () +focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>= + maybe (return ()) (windows . focusWindow) + +findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a) +findM _ [] = return Nothing +findM p (x:xs) = do b <- p x + if b then return (Just x) else findM p xs + +-- apply a pure function to windows with a tag +withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X () +withTaggedP t f = withTagged' t (winMap f) +withTaggedGlobalP t f = withTaggedGlobal' t (winMap f) + +winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X () +winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw)) + +withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X () +withTagged t f = withTagged' t (mapM_ f) +withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f) + +withTagged' :: String -> ([Window] -> X ()) -> X () +withTagged' t m = gets windowset >>= + filterM (hasTag t) . integrate' . stack . workspace . current >>= m + +withTaggedGlobal' :: String -> ([Window] -> X ()) -> X () +withTaggedGlobal' t m = gets windowset >>= + filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m + +withFocusedP :: (Window -> WindowSet -> WindowSet) -> X () +withFocusedP f = withFocused $ windows . f + +shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd +shiftHere w s = shiftWin (tag . workspace . current $ s) w s + +shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd +shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of + [] -> s + (t:_) -> shiftWin (tag . workspace $ t) w s + +data TagPrompt = TagPrompt + +instance XPrompt TagPrompt where + showXPrompt TagPrompt = "Select Tag: " + + +tagPrompt :: XPConfig -> (String -> X ()) -> X () +tagPrompt c f = do + sc <- tagComplList + mkXPrompt TagPrompt c (mkComplFunFromList' sc) f + +tagComplList :: X [String] +tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>= + mapM getTags >>= + return . nub . concat + + +tagDelPrompt :: XPConfig -> X () +tagDelPrompt c = do + sc <- tagDelComplList + if (sc /= []) + then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s)) + else return () + +tagDelComplList :: X [String] +tagDelComplList = gets windowset >>= maybe (return []) getTags . peek + + +mkComplFunFromList' :: [String] -> String -> IO [String] +mkComplFunFromList' l [] = return l +mkComplFunFromList' l s = + return $ filter (\x -> take (length s) x == s) l diff --git a/XMonad/Actions/Warp.hs b/XMonad/Actions/Warp.hs new file mode 100644 index 0000000..bc7bacc --- /dev/null +++ b/XMonad/Actions/Warp.hs @@ -0,0 +1,74 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Warp +-- Copyright : (c) daniel@wagner-home.com +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : daniel@wagner-home.com +-- Stability : unstable +-- Portability : unportable +-- +-- This can be used to make a keybinding that warps the pointer to a given +-- window or screen. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Warp ( + -- * Usage + -- $usage + warpToScreen, + warpToWindow + ) where + +import Data.Ratio +import Data.List +import Control.Monad.RWS +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import XMonad.Operations +import XMonad +import XMonad.StackSet as W + +{- $usage +This can be used to make a keybinding that warps the pointer to a given +window or screen. For example, I've added the following keybindings to +my Config.hs: + +> , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window +> +>-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 +> +> [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) +> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] + +Note that warping to a particular screen may change the focus. +-} + +-- %import XMonad.Actions.Warp +-- %keybind , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window +-- %keybindlist ++ +-- %keybindlist -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 +-- %keybindlist [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) +-- %keybindlist | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] + +fraction :: (Integral a, Integral b) => Rational -> a -> b +fraction f x = floor (f * fromIntegral x) + +warp :: Window -> Position -> Position -> X () +warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y + +warpToWindow :: Rational -> Rational -> X () +warpToWindow h v = + withDisplay $ \d -> + withFocused $ \w -> do + wa <- io $ getWindowAttributes d w + warp w (fraction h (wa_width wa)) (fraction v (wa_height wa)) + +warpToScreen :: ScreenId -> Rational -> Rational -> X () +warpToScreen n h v = do + root <- asks theRoot + (StackSet {current = x, visible = xs}) <- gets windowset + whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs) + $ \r -> + warp root (rect_x r + fraction h (rect_width r)) + (rect_y r + fraction v (rect_height r)) diff --git a/XMonad/Actions/WindowBringer.hs b/XMonad/Actions/WindowBringer.hs new file mode 100644 index 0000000..bec4f0a --- /dev/null +++ b/XMonad/Actions/WindowBringer.hs @@ -0,0 +1,84 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WindowBringer +-- Copyright : Devin Mullins +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Stability : unstable +-- Portability : unportable +-- +-- dmenu operations to bring windows to you, and bring you to windows. +-- That is to say, it pops up a dmenu with window names, in case you forgot +-- where you left your XChat. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.WindowBringer ( + -- * Usage + -- $usage + gotoMenu, bringMenu, windowMapWith + ) where + +import Control.Monad.State (gets) +import Data.Char (toLower) +import qualified Data.Map as M +import Graphics.X11.Xlib (Window()) + +import XMonad.Operations (windows) +import qualified XMonad.StackSet as W +import XMonad (X) +import qualified XMonad as X +import XMonad.Util.Dmenu (dmenuMap) +import XMonad.Util.NamedWindows (getName) + +-- $usage +-- +-- Place in your Config.hs: +-- +-- > import XMonad.Actions.WindowBringer +-- +-- and in the keys definition: +-- +-- > , ((modMask .|. shiftMask, xK_g ), gotoMenu) +-- > , ((modMask .|. shiftMask, xK_b ), bringMenu) + +-- %import XMonad.Actions.WindowBringer +-- %keybind , ((modMask .|. shiftMask, xK_g ), gotoMenu) +-- %keybind , ((modMask .|. shiftMask, xK_b ), bringMenu) + +-- | Pops open a dmenu with window titles. Choose one, and you will be +-- taken to the corresponding workspace. +gotoMenu :: X () +gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView) + where workspaceMap = windowMapWith (W.tag . fst) + +-- | Pops open a dmenu with window titles. Choose one, and it will be +-- dragged, kicking and screaming, into your current workspace. +bringMenu :: X () +bringMenu = windowMap >>= actionMenu (windows . bringWindow) + where windowMap = windowMapWith snd + bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws + +-- | Calls dmenuMap to grab the appropriate element from the Map, and hands it +-- off to action if found. +actionMenu :: (a -> X ()) -> M.Map String a -> X () +actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action + +-- | Generates a Map from window name to . For use with +-- dmenuMap. +windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a) +windowMapWith value = do -- TODO: extract the pure, creamy center. + ws <- gets X.windowset + M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws) + where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws) + keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w + +-- | Returns the window name as will be listed in dmenu. +-- Lowercased, for your convenience (since dmenu is case-sensitive). +-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user +-- know where he's going. +decorateName :: X.WindowSpace -> Window -> X String +decorateName ws w = do + name <- fmap (map toLower . show) $ getName w + return $ name ++ " [" ++ W.tag ws ++ "]" diff --git a/XMonad/Actions/WmiiActions.hs b/XMonad/Actions/WmiiActions.hs new file mode 100644 index 0000000..d98003b --- /dev/null +++ b/XMonad/Actions/WmiiActions.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WmiiActions +-- Copyright : (c) Juraj Hercek +-- License : BSD3 +-- +-- Maintainer : Juraj Hercek +-- Stability : unstable +-- Portability : unportable +-- +-- Provides `actions' as known from Wmii window manager ( +-- ). It also provides slightly better interface for +-- running dmenu on xinerama screens. If you want to use xinerama functions, +-- you have to apply following patch (see Dmenu.hs extension): +-- . Don't forget to +-- recompile dmenu afterwards ;-). +----------------------------------------------------------------------------- + +module XMonad.Actions.WmiiActions ( + -- * Usage + -- $usage + wmiiActions + , wmiiActionsXinerama + , executables + , executablesXinerama + ) where + +import XMonad +import XMonad.Util.Dmenu (dmenu, dmenuXinerama) +import XMonad.Util.Run (runProcessWithInput) + +import Control.Monad (filterM, liftM, liftM2) +import System.Directory (getDirectoryContents, doesFileExist, getPermissions, executable) + +-- $usage +-- +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Actions.WmiiActions +-- +-- and add following to the list of keyboard bindings: +-- +-- > ,((modMask, xK_a), wmiiActions "/home/joe/.wmii-3.5/") +-- +-- or, if you are using xinerama, you can use +-- +-- > ,((modMask, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/") +-- +-- however, make sure you have also xinerama build of dmenu (for more +-- information see "XMonad.Util.Dmenu" extension). + +-- | The 'wmiiActions' function takes the file path as a first argument and +-- executes dmenu with all executables found in the provided path. +wmiiActions :: FilePath -> X () +wmiiActions path = + wmiiActionsDmenu path dmenu + +-- | The 'wmiiActionsXinerama' does the same as 'wmiiActions', but it shows +-- dmenu only on workspace which currently owns focus. +wmiiActionsXinerama :: FilePath -> X () +wmiiActionsXinerama path = + wmiiActionsDmenu path dmenuXinerama + +wmiiActionsDmenu :: FilePath -> ([String] -> X String) -> X () +wmiiActionsDmenu path dmenuBrand = + let path' = path ++ "/" in + getExecutableFileList path' >>= dmenuBrand >>= spawn . (path' ++) + +getExecutableFileList :: FilePath -> X [String] +getExecutableFileList path = + io $ getDirectoryContents path >>= + filterM (\x -> let x' = path ++ x in + liftM2 (&&) + (doesFileExist x') + (liftM executable (getPermissions x'))) + +{- +getExecutableFileList :: FilePath -> X [String] +getExecutableFileList path = + io $ getDirectoryContents path >>= + filterM (doesFileExist . (path ++)) >>= + filterM (liftM executable . getPermissions . (path ++)) +-} + +-- | The 'executables' function runs dmenu_path script providing list of +-- executable files accessible from $PATH variable. +executables :: X () +executables = executablesDmenu dmenu + +-- | The 'executablesXinerama' function does the same as 'executables' function +-- but on workspace which currently owns focus. +executablesXinerama :: X () +executablesXinerama = executablesDmenu dmenuXinerama + +executablesDmenu :: ([String] -> X String) -> X () +executablesDmenu dmenuBrand = + getExecutablesList >>= dmenuBrand >>= spawn + +getExecutablesList :: X [String] +getExecutablesList = + io $ liftM lines $ runProcessWithInput "dmenu_path" [] "" + -- cgit v1.2.3