Xmonad/Config archive/Mntnoe's xmonad.hs
< Xmonad | Config archive
Jump to navigation
Jump to search
You download the whole configuration (icons inclusive) from my blog.
xmonad.hs
{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses #-}
-------------------------------------------------------------------------- {{{
-- |
-- Module : xmonad
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Modular xmonad config.
--
-- Highlights:
-- * pager with icons for DynamicLog
-- * per application configuration
-- * minimize windows
--
-- Requires xmonad 0.9. Note that this work is not finished.
-- There are still lot of things I want to behave differently,
-- and I need to do some cleanup here and there.
--
-- Still, I hope you can get inspired by some of my ideas. Enjoy :-)
--
-------------------------------------------------------------------------- }}}
-- IMPORTS {{{
-- Haskell modules
import Control.Monad (when, liftM)
import Data.IORef (IORef)
import Data.List
import Data.Maybe (isJust)
import qualified Data.Map as M
import System.IO (Handle)
-- XMonad modules
import XMonad hiding ( (|||) )
import XMonad.Actions.CycleSelectedLayouts
import XMonad.Actions.CycleWS
import XMonad.Actions.FloatKeys
import XMonad.Actions.FloatSnap
import XMonad.Actions.SwapWorkspaces (swapWithCurrent)
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers (doCenterFloat)
import XMonad.Hooks.Place
import XMonad.Hooks.RestoreMinimized
import XMonad.Hooks.ServerMode
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.Reflect
import XMonad.Layout.ResizableTile
import qualified XMonad.StackSet as W
import XMonad.Util.Run (hPutStrLn)
import XMonad.Util.WorkspaceCompare (getSortByTag)
-- Custom modules
import App
import BorderColors
import Commands
import DMenu
import Panel
import Config
import IM
import Layout
import MyApps
import Pager
import Utils
import Workspace
-- }}}
-- MAIN {{{
main :: IO ()
main = do
host <- getHost
pipes <- spawnPanels
xmonad $ withUrgencyHook NoUrgencyHook $ ewmh $ myXConfig host pipes
-- }}}
-- SETTINGS {{{
-- | Layout to show initially, and when issuing the according keybinding. My
-- desktop is widescreen, but not my laptop.
defaultLayout Laptop = "Tall"
defaultLayout Netbook = "Wide"
cycledLayouts Laptop = ["Mirror", defaultLayout Laptop]
cycledLayouts Netbook = ["Accordion", "Tall", defaultLayout Netbook]
myWorkspaces = map show [1..8] ++ [hiddenWorkspaceTag, summonWorkspaceTag]
-- Colors
myNormalBorderColor = defaultBG
myFocusedBorderColor = "#3939ff"
masterBorderColor = "#ff1010"
floatBorderColor = "#10c010"
myPlacement = withGaps (22, 0, 0, 0) $ smart (0.5,0.5)
myXConfig host pipes = XConfig
{ terminal = "xterm" -- unused
, focusFollowsMouse = True
, borderWidth = 3
, modMask = mod5Mask -- unused
, numlockMask = mod2Mask
, workspaces = myWorkspaces
, normalBorderColor = myNormalBorderColor
, focusedBorderColor = myFocusedBorderColor
, keys = myKeys host
, mouseBindings = myMouseBindings
, handleEventHook = myHandleEventHook
, layoutHook = myLayoutHook
, manageHook = myManageHook host
, logHook = myLogHook host pipes
, startupHook = myStartupHook host
}
-- }}}
-- KEYS/MOUSE {{{
-- | The keybindings are optimized for the Colemak (<http://colemak.com>)
-- keyboard layout. The keys are placed in the right side of the keyboard,
-- using right alt as the modifier.
myKeys host _ = M.fromList $
makeKeys apps
++
[ ((i , xK_comma), runCommand)
, ((i , xK_slash), dmenuRun)
, ((u , xK_h), hideSummonWindows apps)
-- See https://addons.mozilla.org/en-US/firefox/addon/61262.
, ((is, xK_f), spawn "firefox -unfocus")
-- Enhance clipboard functionality in xterm (otherwise, xterm easily
-- "forgets" the selection). Also, xclip will remember the selection
-- even if the host app exits.
, ((i , xK_z), spawn "xclip -selection primary -o | xclip -selection clipboard -i")
-- FLOATING WINDOWS
, ((u , xK_p), placeFocused $ myPlacement)
, ((u , xK_b), withFocused $ windows . W.sink)
-- WINDOW HANDLING
, ((i , xK_j), windows W.focusDown >> warpToWindow')
, ((i , xK_k), windows W.focusUp >> warpToWindow')
, ((is, xK_j), windows W.swapMaster)
, ((i , xK_h), swapOrRaise)
, ((is, xK_h), swapOrLower)
, ((i , xK_s), windows $ hideFocused)
, ((i , xK_r), windows $ restoreLast)
, ((is, xK_n), kill)
, ((mod1Mask, xK_F4), kill)
-- LAYOUT MESSAGES
, ((i , xK_space), cycleThroughLayouts $ cycledLayouts host)
, ((is, xK_space), sendMessage $ JumpToLayout $ defaultLayout host)
, ((u , xK_n), sendMessage $ JumpToLayout "NoBorders")
, ((u , xK_u), sendMessage $ ToggleStruts)
, ((im, xK_Right), sendMessage Shrink)
, ((im, xK_Left), sendMessage Expand)
, ((im, xK_Down), sendMessage MirrorShrink)
, ((im, xK_Up), sendMessage MirrorExpand)
, ((i , xK_Left), withFocused $ keysMoveWindow (-300, 0))
, ((i , xK_Right), withFocused $ keysMoveWindow ( 300, 0))
, ((i , xK_Up), withFocused $ keysMoveWindow ( 0, -200))
, ((i , xK_Down), withFocused $ keysMoveWindow ( 0, 200))
, ((is, xK_Left), withFocused $ snapMove L Nothing)
, ((is, xK_Right), withFocused $ snapMove R Nothing)
, ((is, xK_Up), withFocused $ snapMove U Nothing)
, ((is, xK_Down), withFocused $ snapMove D Nothing)
-- SESSION
, ((i , xK_Delete), spawn "gnome-session-save --shutdown-dialog")
, ((is, xK_BackSpace), spawn "gnome-session-save --logout")
, ((i , xK_BackSpace), killPanels >> restart "xmonad" True)
-- WORKSPACES
-- Note that I have swapped Y and J in my modified Colemak keyboard layout.
, ((i , xK_y), doWithWS W.greedyView Prev EmptyWS)
, ((is, xK_y), doWithWS shiftView Prev EmptyWS)
, ((im, xK_y), doWithWS swapWithCurrent Prev EmptyWS)
, ((i , xK_u), doWithWS W.greedyView Prev NonEmptyWS)
, ((is, xK_u), doWithWS shiftView Prev NonEmptyWS)
, ((im, xK_u), doWithWS swapWithCurrent Prev NonEmptyWS)
, ((i , xK_i), doWithWS W.greedyView Next NonEmptyWS)
, ((is, xK_i), doWithWS shiftView Next NonEmptyWS)
, ((im, xK_I), doWithWS swapWithCurrent Next NonEmptyWS)
, ((i , xK_o), doWithWS W.greedyView Next EmptyWS)
, ((is, xK_o), doWithWS shiftView Next EmptyWS)
, ((im, xK_o), doWithWS swapWithCurrent Next EmptyWS)
, ((i , xK_l), doWithWS shiftView Next EmptyWS)
, ((is, xK_l), doWithWS W.shift Next EmptyWS)
, ((i , xK_7), swapNextScreen')
, ((i , xK_8), toggleWS)
, ((i , xK_9), screenWorkspace 0 >>= flip whenJust (windows . W.view) >> warpToWindow')
, ((is, xK_9), screenWorkspace 0 >>= flip whenJust (windows . shiftViewUngreedy) >> warpToWindow')
, ((i , xK_0), screenWorkspace 1 >>= flip whenJust (windows . W.view) >> warpToWindow')
, ((is, xK_0), screenWorkspace 1 >>= flip whenJust (windows . shiftViewUngreedy) >> warpToWindow')
]
-- MOUSE
myMouseBindings _ = M.fromList $
[ ((mod5Mask, button1), focusAnd mouseMoveWindow $ snapMagicMove (Just 50) (Just 50))
, ((mod5Mask .|. shiftMask, button1), focusAnd mouseMoveWindow $ snapMagicResize [L,R,U,D] (Just 50) (Just 50))
, ((mod5Mask, button3), focusAnd mouseResizeWindow $ snapMagicResize [R,D] (Just 50) (Just 50))
]
where
-- | Focus and raise the window before performing a mouse operation.
focusAnd job1 job2 w = focus w >> windows W.swapMaster >> job1 w >> job2 w
-- }}}
-- LAYOUTHOOK {{{
myLayoutHook
= avoidStruts
$ smartBorders
$ withIM (1/5) (Role "gimp-toolbox")
( (named "Wide" $ Mirror $ ResizableTall 1 (3/40) (2/3) [])
||| (named "Tall" $ reflectHoriz $ ResizableTall 1 (3/40) (4/7) [])
||| (named "Mirror" $ ResizableTall 1 (3/40) (4/7) [])
||| (twoAccordion)
||| (named "NoBorders" $ noBorders Full)
)
-- }}}
-- MANAGEHOOK {{{
myManageHook xs = composeAll
[ floats --> doCenterFloat
, className =? "MPlayer" --> doFloat
, ignores --> doIgnore
, appManageHook apps
, manageDocks
]
where
floats = foldr1 (<||>)
[ checkDialog
, title =? "." <&&> ( className =? "" <||> appName =? "." )
, title =? "VLC media player"
, className =? "Nautilus" <&&> fmap (not . isSuffixOf " - File Browser") title
, className =? "Firefox" <&&> fmap (/="Navigator") appName
, flip fmap className $ flip elem
[ "Gnome_swallow"
, "Gdmsetup"
, "Xmessage"
, "Zenity"
]
]
ignores = foldr1 (<||>)
[ className =? "Gnome-typing-monitor"
]
-- }}}
-- HANDLEEVENTHOOK {{{
myHandleEventHook = do
restoreMinimizedEventHook
serverModeEventHook' smCommands
-- }}}
-- STARTUP HOOK {{{
myStartupHook :: Host -> X ()
myStartupHook host = do
broadcastMessage $ JumpToLayout $ defaultLayout $ host
refresh
-- }}}
-- LOGHOOK {{{
myLogHook :: Host -> [Handle] -> X ()
myLogHook host pipes = do
-- I found it least confusing when coloring the master window only. This
-- makes it easy to tell which window has focus, without moving your eyes
-- to the border of the screen, as the coloring is based on the window
-- position.
colorWhen isMaster masterBorderColor
-- Make it easy to distinguish between floating and non-floating windows.
-- Sometimes I accidently makes a window floating without moving it out of
-- its position.
colorWhen isFloat floatBorderColor
mapM_ (\pipe -> dynamicLogString (myPP host) >>= io . hPutStrLn pipe) pipes
-- TODO: refactor
myPP host = defaultPP
{ ppCurrent = highlight
, ppVisible = pad 2
-- ppHidden overwrites colors of ppUrgent
, ppHidden = pad 6
, ppHiddenNoWindows = pad 2
, ppUrgent = pad 6 . ((dzenColor "#01ce02" "#fcfb03") (adjust " ! ")++) -- temporary solution
, ppTitle = pad 2
, ppLayout = ifNonDefault host (highlight . adjust)
, ppWsSep = ""
, ppSep = " "
, ppSort = getSortByTag
, ppOrder = order
, ppExtras = [ labeledPager $ myPP host
]
}
where
-- Ignore the original workspace list and use labeledPager instead.
order (_:l:t:ws:[]) = (" " ++ ws):l:adjust t:[]
order xs = ["Error in order list: " ++ show xs]
-- Hide the layout label when default layout is used.
ifNonDefault host f s
| s == defaultLayout host = ""
| otherwise = f s
highlight x = leftIcon ++ dzenColor hilightFG hilightBG x ++ rightIcon
-- Called every time a text string is shown, making the font appear vertically
-- aligned with the icons.
adjust x = "^p(;+2)" ++ x ++ "^p()"
pad w x = concat ["^p(", show w, ")", x, "^p(", show w, ")"]
-- }}}
-- vim: set ft=haskell fdm=marker fdl=1 fdc=4:
lib/App.hs
-------------------------------------------------------------------------- {{{
-- |
-- Module : App
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Per application configuration. See MyApps for use.
--
-------------------------------------------------------------------------- }}}
module App
( App (..)
, AppType (..)
, nullApp
, raiseApp
, jumpToOrRestore
, hideSummonWindows
, summonWindow
, hideFocused
, restoreLast
, appManageHook
, makeKeys
) where
-- Haskell modules
import Control.Monad (filterM)
import Data.Maybe
import Data.List
-- XMonad modules
import XMonad
import XMonad.Actions.WindowGo
import XMonad.Core
import XMonad.ManageHook (composeAll)
import qualified XMonad.StackSet as W
-- Custom modules
import Config
import Utils
-- | Holds WM related configuration for a given application.
data App = App
{ cmd :: X () -- ^ Command used to launch the application.
, appType :: AppType -- ^ See AppType.
, query :: Query Bool -- ^ Used to identify the windows owned by the application.
, key :: (ButtonMask, KeySym) -- ^ Key binding to launch the application. (0,0) if no key
-- binding is associated.
, icon :: String -- ^ Relative path to the XPM icon used by the Pager module.
, hook :: Maybe ManageHook -- ^ Application ManageHook.
}
-- | Used when toggling between applications of type Summon.
-- As they are floating, it makes sense to only show one
-- at a time.
instance Eq App where
(==) App { appType = Summon a _ }
App { appType = Summon b _ } = a == b
_ == _ = False
data AppType = OpenNew -- ^ Open a new instance of the application each time.
| JumpTo -- ^ Jump to the workspace containing the application.
| Summon -- ^ Summon the application to the current workspace.
-- They are typically floating, and used for
-- "transient" tasks.
String -- Identifier.
[App] -- Applications to replace when toggling.
-- | Default to these settings when entries are omitted.
nullApp = App
{ cmd = return ()
, appType = OpenNew
, query = return False
, key = (0, 0)
, icon = defaultIcon
, hook = Nothing
}
-- Focus an application. How this happens is specified by the application's AppType.
raiseApp App
{ appType = OpenNew
, cmd = c
} = c
raiseApp App
{ appType = JumpTo
, query = q
, cmd = c
} = jumpToOrRestore c q
raiseApp app@App
{ appType = Summon _ apps
, query = q
} = summonWindow (filterSummonedApps apps) app
-- | Raise a window as follows.
-- If there exists a matching window
-- * that is hidden, shift it to the current workspace.
-- * on the current workspace, hide it.
-- * on another workspace, jump to it.
-- Otherwise launch the application.
-- TODO: This behavior made it impossible to cycle between two windows,
-- as we now hide the current window instead of jumping to the next.
-- I'll have to rethink this one eventually, but as I seldomly need
-- to cycle between windows of the same app, it is not a big
-- problem at the moment.
jumpToOrRestore c q = flip (ifWindows q) c $ \ws -> withWindowSet $ \s -> dispatch ws s
where
dispatch ws s =
case hidden of
[] -> jumpToOrHide
hws -> shiftToCurrent hws
where
hidden = filter (\w -> fromMaybe "" (W.findTag w s) == hiddenWorkspaceTag) ws
shiftToCurrent hws = mapM_ (windows . W.shiftWin (W.currentTag s)) hws
cws = maybe [] W.integrate $ W.stack $ W.workspace $ W.current s
jumpToOrHide =
case cws `intersect` ws of
[] -> jumpTo $ W.peek s
iws -> mapM_ (windows . W.shiftWin hiddenWorkspaceTag) iws
jumpTo (Just w) | w `elem` ws =
let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
in windows $ W.focusWindow y
jumpTo _ = windows . W.focusWindow . head $ ws
-- | Hide all windows on the current workspace of the AppType Summon.
hideSummonWindows :: [App] -> X ()
hideSummonWindows apps = withWindowSet $ \s -> do
let ws = (maybe [] W.integrate . W.stack . W.workspace . W.current) s
sWinsQuery = foldr1 (<||>) $ map query $ filterSummonedApps apps
sWins <- filterM (runQuery sWinsQuery) ws
mapM_ (windows . W.shiftWin summonWorkspaceTag) sWins
-- | Shift the specified app to the current workspace or hide it.
summonWindow :: [App] -- ^ Apps of type Summon to replace.
-> App -- ^ App to summon.
-> X ()
summonWindow apps app = withWindowSet $ \s -> do
let ws = (maybe [] W.integrate . W.stack . W.workspace . W.current) s
q = query app
o = foldr1 (<||>) $ map query $ filter (app/=) apps
matchingWins <- filterM (runQuery q) ws
otherWins <- filterM (runQuery o) ws
case matchingWins of
(x:_) -> do
hideSummonWindows apps
[] -> do
mapM_ (windows . W.shiftWin summonWorkspaceTag) otherWins
filterAll <- filterM (runQuery (query app)) (W.allWindows s)
case filterAll of
(x:_) -> windows $ W.shiftWin (W.currentTag s) x
[] -> cmd app
-- | Hide the focused window. A hidden window is placed on a workspace that is
-- treated specially by all other workspace handling commands used.
hideFocused :: WindowSet -> WindowSet
hideFocused = W.shift hiddenWorkspaceTag
-- | Restore the window that was hidden most recently, like pushing and pulling
-- from a stack.
restoreLast :: WindowSet -> WindowSet
restoreLast s = maybe s (flip (W.shiftWin $ W.currentTag s) s) $ getHidden s
where
getHidden s
= listToMaybe
$ maybe [] (W.integrate' . W.stack)
$ listToMaybe
$ filter (\wsp -> W.tag wsp == hiddenWorkspaceTag)
$ W.workspaces s
-- | Run all the hooks associated with the applications.
appManageHook :: [App] -> ManageHook
appManageHook = composeAll . fmap makeQueriedHook . filter hasHook
where
hasHook app = isJust $ hook app
makeQueriedHook app@App
{ query = q
, hook = Just h
} = q --> h
makeQueriedHook _ = idHook -- never reached
-- | Generate the keybinding list from a list of Apps.
makeKeys :: [App] -> [((ButtonMask, KeySym), X ())]
makeKeys apps = map makeKey $ filter hasKey apps
where
makeKey app = (key app, raiseApp app)
hasKey app = key app /= (0, 0)
filterSummonedApps = filter (isSummonedApp . appType)
where
isSummonedApp (Summon _ _) = True
isSummonedApp _ = False
lib/BorderColors.hs
{-# LANGUAGE FlexibleContexts #-}
-------------------------------------------------------------------------- {{{
-- |
-- Module : BorderColors
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Application specific border colors for XMonad. You can color any kind of
-- windows, but I found it least confusing when coloring the master window
-- only. This makes it easy to tell which window has focus, without moving
-- your eyes to the border of the screen, breaking your work flow.
--
-------------------------------------------------------------------------- }}}
module BorderColors (colorWhen) where
-- Haskell modules
import Control.Monad (when)
-- XMonad modules
import XMonad
-- | Set the border color when the query is satisfied. Should be added to the
-- ManageHook.
colorWhen :: Query Bool -> String -> X ()
colorWhen q cl = withFocused $ \w -> runQuery q w >>= flip when (setWindowBorder' cl w)
-- | Give set the border color of a window to the given HTML color code.
setWindowBorder' ::(MonadReader XConf m, MonadIO m) => String -> Window -> m ()
setWindowBorder' c w = do
XConf { display = d } <- ask
~(Just pc) <- io $ initColor d c
io $ setWindowBorder d w pc
lib/Commands.hs
-------------------------------------------------------------------------- {{{
-- |
-- Module : Commands
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Settings for XMonad.Actions.Commands.
--
-------------------------------------------------------------------------- }}}
module Commands where
-- Haskell modules
import qualified Data.Map as M
import Data.IORef (IORef)
import Data.List
import Data.Maybe
import System.Exit (exitWith, ExitCode(..) )
-- XMonad modules
import XMonad
import XMonad.Actions.Commands hiding (workspaceCommands)
import XMonad.Actions.WindowGo
import qualified XMonad.StackSet as W
-- Custom modules
import App
import Config
import DMenu
-- | Given a list of command\/action pairs, prompt the user to choose a
-- command and return the corresponding action.
-- runCommand :: [(String, X ())] -> X ()
runCommand = do
let m = commandMap $ dmenuCommands
choice <- dmenu (M.keys m)
fromMaybe (return ()) (M.lookup choice m)
-- | Commands for DMenu.
dmenuCommands :: [(String, X ())]
dmenuCommands =
[ ("view-summon" , windows $ W.view summonWorkspaceTag)
, ("view-hidden" , windows $ W.view hiddenWorkspaceTag)
-- , ("restart" , restart "xmonad" True)
, ("restart-no-resume" , restart "xmonad" False)
, ("refresh" , refresh)
, ("quit" , io $ exitWith ExitSuccess)
]
-- | Commands for ServerMode.
-- TODO: integrate with dzen.
smCommands :: X [(String, X ())]
smCommands = do
wsCmds <- workspaceCommands
return $ take 10 (cycle wsCmds) ++ otherCommands
where
otherCommands =
[ ("focus-vim" , raiseNext q_vims)
]
q_vims = className =? "Gvim" <||> (className =? "XTerm" <&&> fmap (isPrefixOf "vim:") title)
-- | Generate a list of commands to switch to.
workspaceCommands :: X [(String, X ())]
workspaceCommands = do
ws <- asks $ workspaces . config
return $ map makeEntry ws
where
makeEntry w = ("view-" ++ w, windows $ W.view w)
-- -- | Generate a list of commands dealing with multiple screens.
-- 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-")]
-- ]
lib/Config.hs
-------------------------------------------------------------------------- {{{
-- |
-- Module : Config
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Static module configuration which I am too lazy to pass around.
--
-------------------------------------------------------------------------- }}}
module Config where
-- XMonad modules
import XMonad
-- GUI
font = "Consolas-9:rgba=rgb"
defaultBG = "#dbdbdb"
defaultFG = "#000000"
hilightBG = "#5e8eba"
hilightFG = "#ffffff"
-- PANEL
wTrayer = 100
wConky = 140
wHbar = 280 -- width of piped dzen
height = "18"
hbar = "hbar -cmbdt | "
conkyrc = "/home/mntnoe/.conkyrc-dzen"
-- KEYS
i = mod5Mask -- (I)SO_LEVEL5_SHIFT
u = mod4Mask -- S(U)PER
s = shiftMask
m = mod1Mask
c = controlMask
is = i .|. s
im = i .|. m
ic = i .|. c
us = u .|. s
-- APP
-- | Workspace containing "hidden" windows. Treated specially by workspace handling commands.
hiddenWorkspaceTag :: String
hiddenWorkspaceTag = "H"
-- | Workspace containing "summoned" windows. Treated specially by workspace handling commands.
summonWorkspaceTag :: String
summonWorkspaceTag = "S"
-- ICONS
-- | The icons located here are simply 16x16 XPM icons from hicolor, gnome and gnome-colors.
-- TODO: refactor
iconPath = "/home/mntnoe/.xmonad/icons/default/"
hilightIconPath = "/home/mntnoe/.xmonad/icons/hilight/"
grayIconPath = "/home/mntnoe/.xmonad/icons/gray/"
defaultIcon = "apps/application-default-icon.xpm"
defaultSepIcon = "^i(/home/mntnoe/.xmonad/icons/default-sep.xpm)"
hilightSepIcon = "^i(/home/mntnoe/.xmonad/icons/hilight-sep.xpm)"
leftIcon = "^i(/home/mntnoe/.xmonad/icons/left.xpm)"
rightIcon = "^i(/home/mntnoe/.xmonad/icons/right.xpm)"
lib/DMenu.hs
-------------------------------------------------------------------------- {{{
-- |
-- Module : DMenu
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- DMenu helper functions.
--
-------------------------------------------------------------------------- }}}
module DMenu (dmenu, dmenuRun) where
-- Haskell modules
import Data.List (intercalate)
-- XMonad modules
import XMonad
import XMonad.Util.Run
-- Custom modules
import Config
import Utils
dmenu :: [String] -> X (String)
dmenu opts = run "dmenu" (dmenuArgs "Select:") opts
-- | Run command in path.
dmenuRun :: X ()
dmenuRun = do_ $ safeSpawn "dmenu_run" $ dmenuArgs "Run:"
dmenuArgs :: String -> [String]
dmenuArgs prompt =
[ "-b"
, "-fn" , font
, "-nb" , defaultBG
, "-nf" , defaultFG
, "-sb" , hilightBG
, "-sf" , hilightFG
, "-p" , prompt
]
run :: String -> [String] -> [String] -> X String
run cmd args opts = io $ runProcessWithInput cmd args (unlines opts)
lib/IM.hs
Skipped, as it is based on Xmonad.Layout.IM and only contains small modifications.
lib/Layout.hs
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
------------------------------------------------------------------------------
-- |
-- Module : Layout
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Custom layout algorithms.
--
------------------------------------------------------------------------------
module Layout (
twoAccordion
) where
-- XMonad modules
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.LimitWindows
-- Hacked Accordion layout. Useful for LaTeX editing, where you switch between
-- an editor window and a preview window. Accordion originally by
-- <glasser (@) mit.edu>.
twoAccordion = limitSlice 2 TwoAccordion
data TwoAccordion a = TwoAccordion deriving ( Read, Show )
instance LayoutClass TwoAccordion Window where
pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms
where
ups = W.up ws
dns = W.down ws
(top, allButTop) = splitVerticallyBy (1/3) sc
(center, bottom) = splitVerticallyBy (1/2) allButTop
(allButBottom, _) = splitVerticallyBy (2/3) sc
mainPane | ups /= [] && dns /= [] = center
| ups /= [] = allButTop
| dns /= [] = allButBottom
| otherwise = sc
tops = if ups /= [] then splitVertically (length ups) top else []
bottoms = if dns /= [] then splitVertically (length dns) bottom else []
description _ = "Accordion"
lib/MyApps.hs
-------------------------------------------------------------------------- {{{
-- |
-- Module : MyApps
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Per application configuration. See App.
--
-------------------------------------------------------------------------- }}}
module MyApps (apps) where
-- Haskell modules
import Data.List
-- XMonad modules
import XMonad
import XMonad.Hooks.ManageHelpers (doRectFloat, doCenterFloat)
import XMonad.StackSet (RationalRect (RationalRect))
-- Custom modules
import App
import Config
import Utils
apps =
-- Firefox
[ nullApp
{ cmd = spawn "firefox"
, appType = JumpTo
, key = (i, xK_f)
, query = className =? "Firefox"
, icon = "apps/firefox.xpm"
}
-- XTerm (new)
, nullApp
{ cmd = spawn "xterm"
, appType = OpenNew
, key = (i, xK_x)
}
-- XTerm (jump)
, nullApp
{ cmd = spawn "xterm"
, appType = JumpTo
, key = (i, xK_c)
, query = fmap (/="xterm-scratchpad") appName
<&&>
terminalWithTitle (\t -> not (isPrefixOf "root:" t)
&& not (isInfixOf "emerge" t)
&& not (isPrefixOf "vim:" t))
, icon = "apps/utilities-terminal.xpm"
}
-- XTerm (superuser)
, nullApp
{ query = terminalWithTitle (\t -> isPrefixOf "root:" t
|| isInfixOf "emerge" t)
, icon = "apps/gksu-root-terminal.xpm"
}
-- Vim
, nullApp
{ cmd = spawn "xvim"
, appType = JumpTo
, key = (i, xK_v)
, query = ( className =? "XTerm" <&&> fmap (isPrefixOf "vim:" ) title) <||> className =? "Gvim"
, icon = "apps/vim.xpm"
}
-- Scratchpad
, nullApp
{ cmd = spawn $ xterm "xterm-scratchpad" "screen -dRRS scratchpad"
, appType = Summon "scratchpad" apps
, key = (i, xK_Return)
, query = appName =? "xterm-scratchpad"
, hook = Just doCenterFloat
, icon = "apps/utilities-terminal.xpm"
}
-- Emacs
, nullApp
{ cmd = spawn "emacs"
, appType = JumpTo
, key = (i, xK_e)
, query = className =? "Emacs" <||> fmap (isPrefixOf "emacs:") title
, icon = "apps/emacs.xpm"
}
-- Gmail
, nullApp
{ cmd = spawn "prism gmail"
, appType = Summon "gmail" apps
, key = (u, xK_j)
, query = q_prism <&&> fmap ("Gmail" `isPrefixOf`) title
, hook = Just prismFloat
, icon = "apps/gmail.xpm"
}
-- Google Calendar
, nullApp
{ cmd = spawn "prism google.calendar"
, appType = Summon "gcal" apps
, key = (u, xK_k)
, query = q_prism <&&> fmap (\ x -> isPrefixOf "madsnoe.dk Calendar" x
|| isPrefixOf "Google Calendar" x) title
, hook = Just prismFloat
, icon = "apps/google-calendar.xpm"
}
-- Remember The Milk
, nullApp
{ cmd = spawn "prism remember.the.milk"
, appType = Summon "rtm" apps
, key = (u, xK_l)
, query = q_prism <&&> fmap (isPrefixOf "Remember The Milk") title
, hook = Just prismFloat
, icon = "apps/rtm.xpm"
}
-- Ordbogen.com
, nullApp
{ cmd = spawn "prism ordbogen.com"
, appType = Summon "ordbogen" apps
, key = (u, xK_semicolon)
, query = let prefix x = isPrefixOf "ordbogen" x || isPrefixOf "Ordbogen" x
in q_prism <&&> fmap prefix title
, hook = Just $ doCenterFloat' (4/10) (5/6)
, icon = "apps/ordbogen.xpm"
}
-- Nautilus
, nullApp
{ cmd = spawn "nautilus ~"
, appType = JumpTo
, key = (i, xK_d)
, query = className =? "Nautilus"
, icon = "apps/file-manager.xpm"
}
-- Eclipse
, nullApp
{ cmd = spawn "eclipse"
, appType = JumpTo
, key = (u, xK_g)
, query = let eclipse = className =? "Eclipse"
splash = title =? "." <&&> ( className =? "" <||> appName =? "." )
in eclipse <||> splash
, icon = "apps/eclipse.xpm"
}
-- XDvi
, nullApp
{ query = className =? "XDvi"
, icon = "apps/adobe.pdf.xpm"
}
-- Xpdf
, nullApp
{ query = className =? "Xpdf"
, icon = "apps/adobe.pdf.xpm"
}
-- Evince
, nullApp
{ query = className =? "Evince"
, icon = "apps/evince.xpm"
}
-- Acroread
, nullApp
{ query = className =? "Acroread"
, icon = "apps/adobe-reader.xpm"
}
-- MPlayer
, nullApp
{ query = className =? "MPlayer"
, icon = "apps/gnome-mplayer.xpm"
}
-- VLC
, nullApp
{ query = title =? "VLC media player"
, icon = "apps/vlc.xpm"
}
-- Gimp
, nullApp
{ query = className =? "Gimp"
, icon = "apps/gimp.xpm"
}
-- OpenOffice
, nullApp
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Writer") title
, icon = "apps/ooo-writer.xpm"
}
-- OpenOffice
, nullApp
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Calc") title
, icon = "apps/ooo-calc.xpm"
}
-- OpenOffice
, nullApp
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Base") title
, icon = "apps/ooo-base.xpm"
}
-- OpenOffice
, nullApp
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Draw") title
, icon = "apps/ooo-draw.xpm"
}
-- OpenOffice
, nullApp
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Impress") title
, icon = "apps/ooo-impress.xpm"
}
-- OpenOffice
, nullApp
{ query = className =? "OpenOffice.org 3.2"
, icon = "apps/ooo-gulls.xpm"
}
-- VirtualBox
, nullApp
{ query = className =? "VirtualBox"
, icon = "apps/vmware.xpm"
}
-- XChat
, nullApp
{ query = className =? "Xchat"
, icon = "apps/xchat-gnome.xpm"
}
-- Gnucash
, nullApp
{ appType = JumpTo
, query = className =? "Gnucash"
, icon = "apps/gnucash-icon.xpm"
}
-- Audacity
, nullApp
{ cmd = spawn "audacity"
, appType = JumpTo
, query = className =? "Audacity"
, icon = "apps/audacity.xpm"
}
-- Gnome-session
, nullApp
{ query = className =? "Gnome-session"
, icon = "apps/gnome-shutdown.xpm"
}
-- Rhythmbox
, nullApp
{ query = className =? "Rhythmbox"
, icon = "apps/rhythmbox.xpm"
}
-- MARK --
]
-- Auxiliary functions
terminalWithTitle p = className =? "XTerm" <&&> fmap p title
q_typing_mon = className =? "Gnome-typing-monitor"
q_nautilus_f = className =? "Nautilus" <&&> fmap (not . isSuffixOf " - File Browser") title
q_eclipse_spl = title =? "." <&&> ( className =? "" <||> appName =? "." )
q_prism = className =? "Prism"
q_xterms = className =? "XTerm"
prismFloat = doCenterFloat' (8/10) (5/6)
doCenterFloat' w h = doRectFloat $ RationalRect ((1 - w)/2) ((1 - h)/2) w h
lib/Pager.hs
------------------------------------------------------------------------------
-- |
-- Module : Pager
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- A pager for DynamicLog showing an for each window on each workspace.
-- TODO: Gets slow when there are many windows. Optimize! Not a problem
-- for casual use however.
--
------------------------------------------------------------------------------
module Pager (
labeledPager
) where
-- XMonad modules
import XMonad
import Data.Char (toLower)
import Data.Maybe ( isJust, fromMaybe )
import qualified Data.Map as M
import Data.Map ( (!) )
import Data.List
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.UrgencyHook
-- Custom modules
import App
import Config
import MyApps
import Utils
-- | The 'DynamicLog' logger to add to 'ppExtras' using the given pretty
-- printer and window label map.
labeledPager :: PP -> X (Maybe String)
labeledPager pp = do
s <- gets windowset
urgents <- readUrgents
sort' <- ppSort pp
wl <- queryWindows s windowLabelMap
return $ Just $ pprWindowSet' sort' urgents wl pp s
-- | like 'pprWindowSet', but append to each workspace the outcome of
-- 'printWindows'.
pprWindowSet' :: ([W.Workspace String l Window] -> [W.Workspace String l Window])
-- ^ sorting function
-> [Window] -- ^ urgent windows
-> M.Map Window String -- ^ window to symbol map
-> PP -- ^ pretty-Printer
-> W.StackSet String l Window sid sd -- ^ stack set
-> String
pprWindowSet' sort' urgents wl pp s
= sepBy (ppWsSep pp) . map fmt . sort' $
map W.workspace (W.current s : W.visible s) ++ W.hidden s
where
this = W.tag (W.workspace (W.current s))
visibles = map (W.tag . W.workspace) (W.visible s)
fmt ws = (printer ws) pp $ print path ws
where
path
| W.tag ws == this = hilightIconPath
| W.tag ws == summonWorkspaceTag = grayIconPath
| W.tag ws == hiddenWorkspaceTag = grayIconPath
| otherwise = iconPath
printer ws
| W.tag ws == this = ppCurrent
| W.tag ws `elem` visibles = ppVisible
| any (\x -> maybe False (== W.tag ws) (W.findTag x s)) urgents
= \ppC -> ppUrgent ppC . ppHidden ppC
| isJust (W.stack ws) = ppHidden
| otherwise = ppHiddenNoWindows
print path ws = printWindows path wl (W.integrate' $ W.stack ws)
-- | Output a list of strings, ignoring empty ones and separating the
-- rest with the given separator.
sepBy :: String -- ^ separator
-> [String] -- ^ fields to output
-> String
sepBy sep = concat . intersperse sep . filter (not . null)
-- | Print a concatenated string of symbols for a list of windows.
printWindows :: String -- ^ icon path
-> M.Map Window String -- ^ window to symbol map
-> [Window] -- ^ windows on the workspace
-> String
printWindows path wl ws = handleEmpty $ intercalate (icon path "sep.xpm") $ map (\w -> icon path $ fromMaybe defaultIcon (M.lookup w wl)) ws
where
icon path i = "^i(" ++ path ++ i ++ ")"
handleEmpty "" = "^ro(6x6)"
handleEmpty xs = xs
-- | Query each window in the 'WindowSet' and assign a symbol to it in a map.
queryWindows :: WindowSet -> [(String, Query Bool)] -> X (M.Map Window String)
queryWindows ws lm = do
mapM (qw lm) (W.allWindows ws) >>= return . M.fromList
where
qw :: [(String, Query Bool)] -> Window -> X (Window, String)
qw [] w = return (w, defaultIcon)
qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)
-- | Map windows to symbols for the pager. Symbols for floating windows are in
-- lower case.
windowLabelMap :: [(String, Query Bool)]
windowLabelMap =
map whenFloat windows ++ windows
where
whenFloat (l, q) = (map toLower l, isFloat <&&> q)
windows = zip (map icon apps) (map query apps)
lib/Panel.hs
------------------------------------------------------------------------------
-- |
-- Module : Dzen
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Functions for spawning dzen instances.
--
------------------------------------------------------------------------------
module Panel
( spawnPanels
, killPanels
, getScreenCount
) where
-- Haskell modules
import Control.Monad
import Data.List
import Foreign.C.Types (CInt)
import GHC.IOBase (Handle)
import System.Cmd
import System.Environment (getEnv)
import System.Posix.Files(fileExist)
-- XMonad modules
import Control.Monad
import Graphics.X11.Xlib
import Graphics.X11.Xinerama
import XMonad
import XMonad.Util.Run(spawnPipe)
-- Custom modules
import Config
import Utils
-- | Run before each restart of xmonad to ensure that there
-- will only be the expected panel instances running.
killPanels :: X ()
killPanels = do
spawn' "killall conky-cli"
spawn' "killall hbar"
spawn' "killall trayer"
return ()
-- | Spawn the applications that make the upper panel.
spawnPanels :: IO ([Handle])
spawnPanels = do
count <- getScreenCount'
pipes <- mapM (spawnDzenOnScreen count) [0..count-1]
spawnTrayer
return pipes
spawnTrayer = spawn' $ intercalate " "
[ "trayer"
, "--edge" , "top"
, "--align" , "right"
, "--widthtype" , "pixel"
, "--width" , show wTrayer
, "--heighttype" , "pixel"
, "--height" , height
, "--margin" , show $ wHbar + wConky
, "--transparent" , "true"
, "--alpha" , "0"
, "--tint" , convert $ defaultBG
, "--SetDockType" , "true"
, "--SetPartialStrut" , "true"
, "--expand" , "true"
]
where
convert ('#':xs) = '0':'x':xs
convert xs = xs
-- | spawn' two dzen instances at the top of the screen, reading input
-- from xmonad and hbar respectively.
spawnDzenOnScreen count screen = do
-- Unfortunately, only one instance of trayer is allowed.
let wTrayerMaybe = if screen == count - 1 then wTrayer else 0
(sx, sy, sw, sh) <- getScreenDim screen
pipes <- spawnPipe $ dzen
sy -- vertical position
sx -- horizontal position
(sw - wHbar - wTrayerMaybe - wConky) -- horizontal width
'l' -- text align
"" -- no actions
spawnDzenWithConky $ dzen
sy -- vertical position
(sx + sw - wHbar - wConky) -- horizontal position
wConky -- horizontal width
'r' -- text align
"" -- no actions
spawn' $ hbar ++ dzen
sy -- vertical position
(sx + sw - wHbar) -- horizontal position
wHbar -- horizontal width
'r' -- text align
"" -- no actions
return pipes
where
spawnDzenWithConky dest =
fileExist conkyrc >>=
(flip when $ do_ $ spawn' $ dzenWithConky conkyrc dest)
dzenWithConky conkyrc dest = intercalate " " ["conky-cli -c", conkyrc, "|", dest]
-- | Return a string that launches dzen with the given configuration.
dzen :: Num a => a -- ^ vertical position
-> a -- ^ horizontal position
-> a -- ^ horizontal width
-> Char -- ^ text align
-> String -- ^ actions
-> String
dzen y x w ta e =
intercalate " "
[ "dzen2"
, "-x" , show x
, "-w" , show w
, "-y" , show y
, "-h" , height
, "-fn" , quote font
, "-bg" , quote defaultBG
, "-fg" , quote defaultFG
, "-ta" , [ta]
, "-e" , quote e
]
-- | Get the number of available screens.
getScreenCount :: Num a => X a
getScreenCount = io getScreenCount'
getScreenCount' :: Num a => IO a
getScreenCount' = do
d <- openDisplay ""
screens <- getScreenInfo d
return $ fromIntegral $ length screens
-- | Return the dimensions (x, y, width, height) of screen n.
getScreenDim :: Num a => Int -> IO (a, a, a, a)
getScreenDim n = do
d <- openDisplay ""
screens <- getScreenInfo d
closeDisplay d
let rn = screens!!(min (abs n) (length screens - 1))
case screens of
[] -> return $ (0, 0, 1024, 768) -- fallback
[r] -> return $ (fromIntegral $ rect_x r , fromIntegral $ rect_y r , fromIntegral $ rect_width r , fromIntegral $ rect_height r )
otherwise -> return $ (fromIntegral $ rect_x rn, fromIntegral $ rect_y rn, fromIntegral $ rect_width rn, fromIntegral $ rect_height rn)
-- | Run the command in the background, ensuring that the
-- value returned is always 0. This is to avoid making
-- spawn break a sequence of commands due to a return
-- value indicating that an error has occured.
spawn' x = spawn $ x ++ "&"
lib/Utils.hs
------------------------------------------------------------------------------
-- |
-- Module : Utils
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Utility functions for XMonad.
--
------------------------------------------------------------------------------
module Utils where
-- Haskell modules
import Control.Concurrent.MVar
import Control.Monad (unless, when, liftM)
import Control.Monad.Trans (lift)
import Data.List
import Data.Monoid (Endo(Endo))
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Unistd(getSystemID, nodeName)
import qualified Data.Map as M
-- XMonad modules
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Actions.Warp (warpToWindow)
import XMonad.Actions.WindowGo
import XMonad.Hooks.DynamicHooks (oneShotHook)
import XMonad.Hooks.FloatNext
import XMonad.Layout.IndependentScreens
import qualified XMonad.StackSet as W
-- Other moduls
import Graphics.X11.Xinerama
import Graphics.X11.Xlib.Extras
-- GENERAL
-- | Perform k x if x return a 'Just' value.
(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
x ?+ k = x >>= maybe (return ()) k
infixl 1 ?+
-- | Helper function for use with monads.
if_ :: t -> t -> Bool -> t
if_ t f c = if c
then t
else f
-- | Change type to "m ()"
do_ :: (Monad m) => m a -> m ()
do_ x = x >> return ()
quote :: String -> String
quote x = "'" ++ x ++ "'"
-- WINDOW ACTIONS
-- | Swap the focused window with the last window in the stack.
swapBottom :: W.StackSet i l a s sd -> W.StackSet i l a s sd
swapBottom = W.modify' $ \c -> case c of
W.Stack _ _ [] -> c -- already bottom.
W.Stack t ls rs -> W.Stack t (xs ++ x : ls) [] where (x:xs) = reverse rs
-- | Swap the focused window with the following window, or if the window is
-- floating, lower it to the bottom.
swapOrLower :: X ()
swapOrLower = withFocused $ \w ->
runQuery isFloat w >>= if_ (windows swapBottom) (windows W.swapDown)
-- | Swap the focused window with the preceding window, or if the window is
-- floating, raise it to the top.
swapOrRaise :: X ()
swapOrRaise = withFocused $ \w ->
runQuery isFloat w >>= if_ (windows W.swapMaster) (windows W.swapUp)
-- spawnOnThisWS :: GHC.IOBase.IORef XMonad.Hooks.DynamicHooks.DynamicHooks-> Query Bool-> String-> X ()
spawnOnThisWS dhr q cmd = withWindowSet $ \ws -> do
oneShotHook dhr q $ doF $ W.shift $ W.currentTag ws
spawn cmd
-- | Warp the mouse pointer to the focused window only if the workspace has
-- no floating windows to steal the focus.
warpToWindow' = withWindowSet $ \ws -> do
let floats = M.keys $ W.floating ws
visible = W.integrate' $ W.stack $ W.workspace $ W.current ws
vf = floats `intersect` visible
when (null vf) $ warpToWindow (1/2) (1/2)
-- QUERIES ETC
-- | Is the focused window the \"master window\" of the current workspace?
isMaster :: Query Bool
isMaster = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ Just w == master ws)
where
master :: WindowSet -> Maybe Window
master ws =
case W.integrate' $ W.stack $ W.workspace $ W.current ws of
[] -> Nothing
(x:xs) -> Just x
-- | Is the focused window a floating window?
isFloat :: Query Bool
isFloat = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ M.member w $ W.floating ws)
-- | Helper to read a property
-- getProp :: Atom -> Window -> X (Maybe [CLong])
getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
-- | Check if window is DIALOG window
checkDialog :: Query Bool
checkDialog = ask >>= \w -> liftX $ do
a <- getAtom "_NET_WM_WINDOW_TYPE"
dialog <- getAtom "_NET_WM_WINDOW_TYPE_DIALOG"
mbr <- getProp a w
case mbr of
Just [r] -> return $ elem (fromIntegral r) [dialog]
_ -> return False
-- | Determine the number of physical screens.
countScreens :: (MonadIO m, Integral i) => m i
countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo
-- HOST
-- | For use in cross host configutions.
data Host = Laptop | Netbook deriving Eq
-- | Determine the host.
getHost = do
host <- getSystemID
case nodeName host of
"mntnoe-laptop" -> return Laptop
"mntnoe-netbook" -> return Netbook
_ -> return Laptop
-- MISC
-- | Return a string that launches xterm with the given 'title', 'appName' and
-- command to execute.
xterm :: String -> String -> String
xterm a e = concat ["xterm -wf -title '", e, "' -name '", a, "' -e '", e, "'"]
lib/Workspace.hs
------------------------------------------------------------------------------
-- |
-- Module : Workspace
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mail (@) madsnoe.dk
-- License : as-is
--
-- Workspace actions.
--
------------------------------------------------------------------------------
module Workspace where
-- Haskell modules
import Data.Maybe ( isNothing, isJust )
-- XMonad modules
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Util.WorkspaceCompare (getSortByTag)
import qualified XMonad.StackSet as W
-- Custom modules
import App
import Config
import Utils
-- | Shift a window to a workspace and switch to that workspace in one
-- operation.
shiftView :: WorkspaceId -> WindowSet -> WindowSet
shiftView id ws = shiftView' id ws
where
shiftView' id ws = W.greedyView id $ W.shift id ws
shiftViewUngreedy id ws = shiftView' id ws
where
shiftView' id ws = W.view id $ W.shift id ws
-- | Perform a workspace transformation on the next workspace in 'WSDirection'
-- of type 'WSType'.
doWithWS :: (String -> (WindowSet -> WindowSet)) -> Direction1D -> WSType -> X ()
doWithWS f dir wstype = do
i <- findWorkspace getSortByTag dir (WSIs pred) 1
windows $ f i
where
pred = do
hidden <- isHidden
return $ (\ws -> notSummon ws && notHidden ws && isWsType ws && hidden ws)
notSummon ws = W.tag ws /= (summonWorkspaceTag)
notHidden ws = W.tag ws /= (hiddenWorkspaceTag)
isWsType ws = wsTypeToPred wstype ws
wsTypeToPred EmptyWS = isNothing . W.stack
wsTypeToPred NonEmptyWS = isJust . W.stack
wsTypeToPred _ = const False
isHidden = do
hs <- gets (map W.tag . W.hidden . windowset)
return (\ws -> W.tag ws `elem` hs)
-- | Swap workspace contents with next screen and focus it. Useful when you work on
-- a laptop with an external screen and keyboard, and want to switch between them.
swapNextScreen' :: X ()
swapNextScreen' = do
ws <- gets windowset
screenWorkspace (nextScreen ws) ?+ windows . swap (W.currentTag ws)
where
nextScreen ws = (W.screen (W.current ws) + 1)
`mod`
fromIntegral (length (W.screens ws))
swap f t = W.view f . W.greedyView t