Xmonad/Config archive/Mntnoe's xmonad.hs
< Xmonad | Config archive
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
Installation
To use these modules, you must reenable support for user modules in your xmonad source. Put the modules you want in ~/.xmonad, and follow the instructions in xmonad.hs. Note that a solution is under development, placing user modules in ~/.xmonad/lib, thus solving the issue with case insensitive systems, see issue 230.
Alternatively you may download the files from my blog at mntnoe.com.
xmonad.hs
{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses #-}
-------------------------------------------------------------------------- {{{
-- |
-- Module : xmonad
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Modular xmonad config.
--
-- Highlights:
-- * labeled pager addon for DynamicLog
-- * fast navigation between workspaces
-- * application specific border colors
-- * modified Scratchpad using GNU Screen
-- * host specific settings (layouts and widgets)
--
-- You need to patch your xmonad source for the modules to work. Simply look
-- for a line in Core.hs containing runProces \"ghc\" [\"--make\",
-- \"xmonad.hs\" ...] and remove the \"-i\" entry from the list. This switch
-- was unfortunately added to fix a bug on case insensitive file systems.
--
-- I will try to make some darcs patches for xmonad-contrib if I get time.
-- Until then, I hope you can get inspired by some of my ideas. Enjoy :-)
--
-------------------------------------------------------------------------- }}}
-- IMPORTS {{{
-- Haskell modules
import Data.Char (toLower)
import Data.List
import Data.Maybe (isJust)
import qualified Data.Map as M
import System.Cmd (system)
import System.Environment (getEnv)
import System.Exit (exitWith, ExitCode(..) )
import System.IO (Handle)
import System.Posix.Files (fileExist)
-- XMonad modules
import XMonad.Actions.CycleWS
import XMonad.Actions.Submap
import XMonad.Actions.SwapWorkspaces
import XMonad.Actions.WindowGo
import XMonad hiding ( (|||) )
import XMonad.Hooks.DynamicHooks
import XMonad.Hooks.DynamicLog hiding (dzen)
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.IM (withIM, Property(..) )
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.MultiToggle
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.Reflect
import XMonad.Layout.ResizableTile
import XMonad.Layout.SimplestFloat
import XMonad.Prompt
import qualified XMonad.StackSet as W
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (hPutStrLn)
import XMonad.Util.WorkspaceCompare (getSortByTag)
-- My modules
import BorderColors
import Layout
import Util
import DMenu
import Dzen
import ScratchpadPrime
import ServerMode
import Pager
-- }}}
-- MAIN {{{
main :: IO ()
main = do
dynamicHooks <- initDynamicHooks
host <- getHost
logPipe <- spawnDzenWithPipe host xpc
homedir <- getEnv "HOME"
spawnDzenWithConky xpc $ homedir ++ "/.conkyrc-dzen"
xmonad $ withUrgencyHook NoUrgencyHook $ myXConfig logPipe dynamicHooks host
-- }}}
-- QUERIES {{{
q_bc31 = appName =? "RDO001GL.EXE"
q_conky = className =? "Conky"
q_eclipse = className =? "Eclipse"
q_eclipse_spl = title =? "." <&&> className =? ""
q_emacs = className =? "Emacs" <||> fmap (isPrefixOf "emacs:") title
q_firefox = className =? "Iceweasel" <||> className =? "Firefox"
q_firefox_fl = q_firefox <&&> fmap (/="Navigator") appName
q_gvim = className =? "Gvim"
q_log = appName =? "xterm-log"
q_mocp = appName =? "xterm-mocp"
q_mplayer = className =? "MPlayer"
q_mutt = appName =? "xterm-mutt"
q_ooo = className =? "OpenOffice.org 3.0"
q_ref = className =? "Xpdf" <||> className =? "XDvi" <||> className =? "Acroread"
q_scratchpad = appName =? "xterm-scratchpad"
q_screen = appName =? "xterm-screen"
q_ssh_askpass = className =? "Ssh-askpass-fullscreen"
q_tmpWins = q_log <||> q_mocp
q_thunar = className =? "Thunar"
q_vim = (fmap (isPrefixOf "vim:") title <&&> q_xterms) <||> appName =? "xterm-vim" -- title is not set immediately
q_vlc = title =? "VLC media player"
q_xchat = className =? "Xchat"
q_xmessage = className =? "Xmessage"
q_xterm = appName =? "xterm"
q_xterm_float = appName =? "xterm-float"
q_xterm_su = q_xterms <&&> ( fmap (\t -> (isPrefixOf "root:" t) || (isInfixOf "emerge:" t)) title )
q_xterms = className =? "XTerm"
-- | Map windows to symbols for the pager. Symbols for floating windows are in
-- lower case.
windowLabelMap :: [(String, Query Bool)]
windowLabelMap =
map whenFloat tiledWindows ++ tiledWindows
++
map whenFloat generalQueries ++ generalQueries
where
whenFloat (l, q) = (map toLower l, isFloat <&&> q)
tiledWindows =
[ ("D", q_eclipse <||> q_eclipse_spl)
, ("V", q_vim <||> q_gvim)
, ("E", q_emacs)
, ("F", q_thunar)
, ("I", q_xchat)
, ("L", q_log)
, ("M", q_mocp <||> q_mplayer)
, ("@", q_mutt)
, ("O", q_ooo)
, ("R", q_ref)
, ("S", q_xterm_su)
, ("W", q_firefox)
]
generalQueries =
[ ("T", q_xterms)
, ("X", return True) -- catchall
]
-- }}}
-- SETTINGS {{{
-- | Layout to show initially, and when issuing the according keybinding. My
-- desktop is widescreen, but not my laptop.
defaultLayout Desktop = "Tall"
defaultLayout Laptop = "Wide"
gimpLayout Desktop = "GIMP_md"
gimpLayout Laptop = "GIMP_ml"
-- Colors
myNormalBorderColor = "#dddddd"
myFocusedBorderColor = "#3939ff"
masterBorderColor = "#ff1010"
floatBorderColor = "#10c010"
dzenBG = myNormalBorderColor
dzenFG = "#000000"
dzenActiveBG = "#a0a0a0"
dzenActiveFG = "#000000"
dzenUrgentFG = "#00ff00"
dzenUrgentBG = "#ffff00"
-- | Settings for both dzen and dmenu.
xpc :: XPConfig
xpc = XPC
{ font = "-misc-fixed-*-*-*-*-13-*-*-*-*-*-*-*"
, bgColor = dzenBG
, fgColor = dzenFG
, bgHLight = dzenActiveBG
, fgHLight = dzenActiveFG
, borderColor = dzenBG
, promptBorderWidth = 0
, position = Bottom
, height = 15
, historySize = 0
, defaultText = []
, autoComplete = Nothing
}
-- myXConfig :: Handle -> IORef DynamicHooks -> Host -> XConfig l
myXConfig logPipe dynamicHooks host = XConfig
{ terminal = "xterm"
, focusFollowsMouse = True
, borderWidth = 3
, modMask = mod5Mask
, numlockMask = mod2Mask
, workspaces = map show [1..9]
, normalBorderColor = myNormalBorderColor
, focusedBorderColor = myFocusedBorderColor
, keys = myKeys dynamicHooks host
, mouseBindings = myMouseBindings
, layoutHook = myLayoutHook host
, manageHook = myManageHook <+> dynamicMasterHook dynamicHooks
, logHook = myLogHook logPipe
, 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 :: h -> Host -> c -> M.Map (KeyMask, KeySym) (X ())
myKeys dynamicHooks host conf =
let m1 = mod5Mask
m2 = mod5Mask .|. shiftMask
m3 = mod5Mask .|. mod1Mask
in M.fromList $
-- APPLICATIONS
[ ((m1, xK_x), submap $ M.fromList
[ ((m1, xK_v), runOrRaiseNext "xvim" (q_vim))
, ((0 , xK_v), spawn "xvim")
, ((m1, xK_c), runOrRaiseNext "emacs" (q_emacs))
, ((0 , xK_c), spawn "emacs")
, ((m1, xK_b), spawn "firefox")
, ((m1, xK_l), reqEmptyWS (q_log) $ spawn $ xterm "xterm-log" "mtail -f /var/log/messages ~/.xsession-errors")
, ((m1, xK_e), reqEmptyWS (q_mutt) $ spawn $ xterm "xterm-mutt" "mutt")
, ((m1, xK_m), reqEmptyWS (q_mocp) $ spawn $ xterm "xterm-mocp" "mocp")
, ((0 , xK_w), submap $ M.fromList -- control some system services like networking
[ ((0 , xK_w), spawn $ xterm "xterm-float" "sleepdo 1 svc -w")
, ((0 , xK_e), spawn $ xterm "xterm-float" "sleepdo 1 svc -e")
, ((0 , xK_d), spawn $ xterm "xterm-float" "sleepdo 1 svc -d")
, ((0 , xK_a), spawn $ xterm "xterm-float" "sleepdo 1 svc -a")
, ((0 , xK_l), spawn $ xterm "xterm-float" "sleepdo 1 svc -l")
] )
] )
-- enhance clipboard functionality in xterm
, ((m1, xK_z), spawn "xclip -selection primary -o | xclip -selection clipboard -i")
, ((m1, xK_c), spawn "xterm")
, ((m1, xK_Return), scratchpad' q_scratchpad $ xterm "xterm-scratchpad" "screen -dRRS scratchpad")
, ((m1, xK_b), runOrRaiseNext "firefox" (q_firefox))
, ((m1, xK_slash), spawn $ dmenuRun xpc)
, ((m1, xK_v), submap $ M.fromList
-- LAYOUT SWITCHING
[ ((m1, xK_v), sendMessage $ JumpToLayout $ defaultLayout host)
, ((m2, xK_v), (broadcastMessage $ JumpToLayout $ defaultLayout host) >> refresh)
, ((m1, xK_a), sendMessage $ JumpToLayout "Accordion")
, ((m1, xK_r), sendMessage $ JumpToLayout "R_Tall")
, ((m1, xK_s), sendMessage $ JumpToLayout "Wide")
, ((m1, xK_t), sendMessage $ JumpToLayout "Tall")
, ((m1, xK_f), sendMessage $ JumpToLayout "Float")
, ((m1, xK_d), sendMessage $ JumpToLayout $ gimpLayout host)
-- MISC
, ((m1, xK_u), sendMessage $ ToggleStruts)
, ((m1, xK_b), withFocused $ windows . W.sink)
])
, ((m1, xK_m), sendMessage $ Toggle FULL)
-- WINDOW HANDLING
, ((m1, xK_n), windows W.focusDown)
, ((m1, xK_e), windows W.focusUp)
, ((m1, xK_h), swapOrRaise)
, ((m2, xK_h), swapOrLower)
, ((m2, xK_k), killAndReturn q_tmpWins)
-- LAYOUT MESSAGES
, ((m1, xK_Left), sendMessage Shrink)
, ((m1, xK_Right), sendMessage Expand)
, ((m1, xK_Up), sendMessage MirrorShrink)
, ((m1, xK_Down), sendMessage MirrorExpand)
-- SESSION
, ((m2, xK_BackSpace), io (system "touch ~/.exit_flag" >> exitHook >> exitWith ExitSuccess))
, ((m1, xK_BackSpace), io exitHook >> restart "xmonad" True)
-- WORKSPACES
-- I have swapped Y and J in my modified Colemak keyboard layout.
, ((m1, xK_y), doWithWS W.greedyView Prev EmptyWS)
, ((m2, xK_y), doWithWS shiftView Prev EmptyWS)
, ((m3, xK_y), doWithWS swapWithCurrent Prev EmptyWS)
, ((m1, xK_l), doWithWS W.greedyView Prev NonEmptyWS)
, ((m2, xK_l), doWithWS shiftView Prev NonEmptyWS)
, ((m3, xK_l), doWithWS swapWithCurrent Prev NonEmptyWS)
, ((m1, xK_u), doWithWS W.greedyView Next NonEmptyWS)
, ((m2, xK_u), doWithWS shiftView Next NonEmptyWS)
, ((m3, xK_u), doWithWS swapWithCurrent Next NonEmptyWS)
, ((m1, xK_j), doWithWS W.greedyView Next EmptyWS)
, ((m2, xK_j), doWithWS shiftView Next EmptyWS)
, ((m3, xK_j), doWithWS swapWithCurrent Next EmptyWS)
, ((m1, xK_i), doWithWS shiftView Next EmptyWS)
, ((m1, xK_0), toggleWS)
-- I use <5-;> <5-o> <5-'> and <5-{> for international characters.
]
++ zip (zip (repeat m1) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
++ zip (zip (repeat m2) [xK_1..xK_9]) (map (withNthWorkspace shiftView) [0..])
++ zip (zip (repeat m3) [xK_1..xK_9]) (map (withNthWorkspace swapWithCurrent) [0..])
-- MOUSE
myMouseBindings :: XConfig t -> M.Map (KeyMask, Button) (Window -> X ())
myMouseBindings conf = M.fromList $
[ ((mod5Mask, button1), focusAnd $ mouseMoveWindow)
, ((mod5Mask, button3), focusAnd $ mouseResizeWindow)
, ((0, 8), focusAnd $ mouseMoveWindow)
]
where
-- | Focus and raise the window before performing a mouse operation.
focusAnd job w = focus w >> windows W.swapMaster >> job w
-- }}}
-- LAYOUTHOOK {{{
-- | Cross host layoutHook. Hosts have different default layouts, different
-- ratios, and keybindings may switch to different layouts.
myLayoutHook host =
eventHook ServerMode $
avoidStruts $
(smartBorders $
(mkToggle (single FULL) $
tall (r host) |||
rtall (r host) |||
wide (r host) |||
MyAccordion
) |||
gimp_ml |||
gimp_md
) |||
(mkToggle (single FULL) $
named "Float" simplestFloat
)
where
wide r =
named "Wide" $
Mirror $
ResizableTall nmaster delta r []
rtall r =
named "R_Tall" $
ResizableTall nmaster delta r []
tall r =
named "Tall" $
reflectHoriz $
ResizableTall nmaster delta r []
nmaster = 1
delta = 3/40
r Desktop = 4/7
r Laptop = 2/3
gimp_md =
named "GIMP_md" $
withIM 0.10 (Role "gimp-toolbox") $
reflectHoriz $
withIM 0.15 (Role "gimp-dock") $
Full
gimp_ml =
named "GIMP_ml" $
withIM 0.25 (Role "gimp-toolbox") $
Full
data MyTransformers = FULL
deriving (Read, Show, Eq, Typeable)
instance Transformer MyTransformers Window where
transform FULL _ k = k $ named "Full" Full
-- }}}
-- MANAGEHOOK {{{
myManageHook :: ManageHook
myManageHook = composeAll
[ q_xmessage --> doCenterFloat
, q_conky --> doIgnore
, q_ssh_askpass --> doFullFloat
, q_firefox_fl --> doCenterFloat
, q_eclipse_spl --> doCenterFloat
, q_vlc --> doCenterFloat
, q_scratchpad --> doCenterFloat
, q_xterm_float --> doCenterFloat
, q_bc31 --> doCenterFloat
-- Most often, I don't want terminals to steal the current window's
-- position. However, only do this to terminals, as focus is not restored
-- to the original window when doing this.
, (q_xterm <||> q_screen) --> doF W.swapDown
, manageDocks
]
-- }}}
-- STARTUP/EXIT HOOK {{{
myStartupHook :: Host -> X ()
myStartupHook host = do
broadcastMessage $ JumpToLayout $ defaultLayout host
refresh
exitHook :: IO ()
exitHook = do
-- Make sure the panels gets reloaded with xmonad.
system "killall conky-cli"
system "killall hbar"
return ()
-- }}}
-- LOGHOOK {{{
myLogHook :: Handle -> X ()
myLogHook logPipe = 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
dynamicLogString myDynamicLog >>= io . hPutStrLn logPipe
myDynamicLog :: PP
myDynamicLog = defaultPP
{ ppCurrent = dzenColor dzenActiveFG dzenActiveBG . pad
-- ppHidden overwrites colors of ppUrgent
, ppHidden = pad
, ppHiddenNoWindows = dzenColor dzenActiveBG dzenBG . pad
, ppUrgent = dzenColor dzenUrgentFG dzenUrgentBG
, ppWsSep = ""
, ppSep = " "
, ppLayout = dzenColor dzenActiveFG dzenActiveBG . pad
, ppTitle = dzenColor dzenFG dzenBG . pad
, ppSort = getSortByTag
, ppOrder = order
, ppExtras = [ labeledPager myDynamicLog windowLabelMap ]
}
where
order (_:l:t:ws:_) = ws:l:t:[]
order xs = ["Error in order list: " ++ show xs]
-- }}}
-- vim: set ft=haskell fdm=marker fdl=0 fdc=4:
BorderColors.hs
{-# LANGUAGE FlexibleContexts #-}
------------------------------------------------------------------------------
-- |
-- Module : BorderColors
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- 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
DMenu.hs
------------------------------------------------------------------------------
-- |
-- Module : DMenu
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- DMenu helper functions.
--
------------------------------------------------------------------------------
module DMenu where
-- Haskell modules
import Data.List (intercalate)
-- XMonad modules
import XMonad.Prompt
-- | Run command in path.
dmenuRun xpc = intercalate " " $ "dmenu_run" : dmenuArgs xpc "Run:"
-- | DMenu options based on an XPC.
dmenuArgs xpc prompt =
[ "-b"
, "-fn" , font xpc
, "-nb" , bgColor xpc
, "-nf" , fgColor xpc
, "-sb" , bgHLight xpc
, "-sf" , fgHLight xpc
, "-p" , prompt
]
Dzen.hs
------------------------------------------------------------------------------
-- |
-- Module : Dzen
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Functions for spawning dzen instances.
--
------------------------------------------------------------------------------
module Dzen (
spawnDzenWithPipe,
spawnDzenWithConky,
dzen
) 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.Display
import XMonad (spawn)
import XMonad.Prompt
import XMonad.Util.Run(spawnPipe)
-- My modules
import Util (Host (Desktop, Laptop))
-- | Spawn two dzen instances at the top of the screen, reading input
-- from xmonad and hbar respectively.
spawnDzenWithPipe :: Host -> XPConfig -> IO Handle
spawnDzenWithPipe host xpc = do
(sw, sh) <- getScreenDim
let w = 300
system $ hbar host ++ dzen xpc
Nothing -- put dzen at the top of the screen
(sw - w) -- horizontal position
w -- horizontal width
'r' -- text align
actions ++ " &"
spawnPipe $ dzen xpc
Nothing -- put dzen at the top of the screen
0 -- horizontal position
(sw - w) -- horizontal width
'l' -- text align
actions
where
-- Show battery info only on the laptop.
hbar Desktop = "hbar -cmt | "
hbar Laptop = "hbar -cmbt | "
-- Mouse clicking cycles between populated workspaces. xmcli is my
-- ServerMode client.
actions = "button3=exec:xmcli 2;button1=exec:xmcli 3"
-- | Spawn a dzen instance at the bottom of the screen using conky for input.
spawnDzenWithConky :: XPConfig -> FilePath -> IO ()
spawnDzenWithConky xpc conkyrc = do
(sw, sh) <- getScreenDim
let dest = dzen xpc
(Just sh) -- put dzen at the bottom of the screen
0 -- horizontal position
sw -- horizontal width
'c' -- text align
"" -- no actions
fileExist conkyrc >>= (flip when $ do_ $ system $ dzenWithConky conkyrc dest)
where
do_ x = x >> return ()
dzenWithConky conkyrc dest = intercalate " " ["conky-cli -c", conkyrc, "|", dest, "&"]
-- | Return a string that launches dzen with the given configuration.
dzen :: Num a => XPConfig -- ^ prompt style configuration
-> Maybe a -- ^ Nothing: put dzen at the top of the screen
-- Just h: put dzen at the bottom of the screen with height h
-> a -- ^ horizontal position
-> a -- ^ horizontal width
-> Char -- ^ text align
-> String -- ^ actions
-> String
dzen xpc mh x w ta e =
let y = case mh of
Nothing -> 0
Just h -> h - (fromInteger $ toInteger $ height xpc) in
intercalate " "
[ "dzen2"
, "-x" , show x
, "-w" , show w
, "-y" , show y
, "-h" , show $ height xpc
, "-fn" , quote $ font xpc
, "-bg" , quote $ bgColor xpc
, "-fg" , quote $ fgColor xpc
, "-ta" , [ta]
, "-e" , quote e
]
where
quote x = "'" ++ x ++ "'"
-- | Return the dimensions of the (primary?) screen.
getScreenDim :: IO (CInt, CInt)
getScreenDim = do
d <- openDisplay ""
let s = defaultScreen d
w = displayWidth d s
h = displayHeight d s
closeDisplay d
return (w, h)
Layout.hs
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
------------------------------------------------------------------------------
-- |
-- Module : Layout
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Custom layout algorithms.
--
------------------------------------------------------------------------------
module Layout (
MyAccordion(..)
) where
-- XMonad modules
import XMonad
import qualified XMonad.StackSet as W
-- Hacked Accordion layout. Useful for LaTeX editing, where you switch between
-- an editor window and a preview window. Only the ratios are modified. This
-- hack does not space windows evenly when the workspace contains more than two
-- windows, but fixing it would require a rewrite. Accordion originally by
-- <glasser (@) mit.edu>.
data MyAccordion a = MyAccordion deriving ( Read, Show )
instance LayoutClass MyAccordion 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"
Obsolete.hs
------------------------------------------------------------------------------
-- |
-- Module : Obsolete
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Functions not used anymore, but might be useful later.
--
------------------------------------------------------------------------------
module Obsolete (
) where
-- Haskell modules
import Data.Char (toLower, toUpper)
import qualified Data.Map as M
-- XMonad modules
import XMonad
import XMonad.Prompt
import qualified XMonad.StackSet as W
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (runProcessWithInput)
-- My modules
import DMenu (dmenuArgs)
-- DMENU FUNCTIONS
-- | Spawn dmenu with the given prompt and completion list. Return what the
-- user typed (which might not be an item in the list).
dmenu :: XPConfig -> String -> [String] -> X String
dmenu xpc prompt opts = io $ runProcessWithInput "dmenu" (dmenuArgs xpc prompt) (unlines opts)
-- | Like 'dzen', but look up the return value in a map.
dmenuMap :: XPConfig -> String -> M.Map String a -> X (Maybe a)
dmenuMap xpc prompt selectionMap = do
selection <- (dmenu xpc prompt) (M.keys selectionMap)
return $ M.lookup selection selectionMap
-- | Prompt for a window and focus it.
gotoMenu :: XPConfig -> X ()
gotoMenu xpc = actionMenu xpc "Window:" W.focusWindow
-- | Prompt for a window and perform an 'WindowSet' operation on it.
actionMenu :: XPConfig -> String -> (Window -> WindowSet -> WindowSet) -> X()
actionMenu xpc prompt action = windowMap >>= (dmenuMap xpc prompt) >>= flip whenJust (windows . action)
-- | Map from a formatted name to the corresponding 'Window' for use in a prompt.
windowMap :: X (M.Map String Window)
windowMap = do
ws <- gets 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 (,) w `fmap` formatWindowName ws w
-- | Return a formatted string representation of a 'Window'.
formatWindowName :: WindowSpace -> Window -> X String
formatWindowName ws w = do
name <- fmap (take 15 . map toLower . show) $ getName w
return $ name ++ " [" ++ [head $ W.tag ws] ++ "]"
-- FOCUS SLAVES
-- Cycle focus between \"slave windows\" in an XMonad workspace. I found it
-- more confusing than helpful, though.
-- | Focus the previous window which is not the master window. Wrap around the
-- end.
focusUpSlave :: WindowSet -> WindowSet
focusUpSlave = W.modify' focusUpSlave'
where
focusUpSlave' :: W.Stack a -> W.Stack a
focusUpSlave' (W.Stack t (l:[]) rs) = W.Stack x xs [] where (x:xs) = reverse (l:t:rs)
focusUpSlave' (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs)
focusUpSlave' (W.Stack t [] rs) = W.Stack x xs [] where (x:xs) = reverse (t:rs)
-- | Focus the next window which is not the master window. Wrap around the
-- end.
focusDownSlave :: WindowSet -> WindowSet
focusDownSlave = W.modify' focusDownSlave'
where
focusDownSlave' s@(W.Stack _ [] []) = s
focusDownSlave' (W.Stack t ls (r:rs)) = W.Stack r (t:ls) rs
focusDownSlave' (W.Stack t ls []) = W.Stack x [m] xs where (m:x:xs) = reverse (t:ls)
-- | Swap position with the previous window which is not the master window.
-- Wrap around the end.
swapUpSlave :: WindowSet -> WindowSet
swapUpSlave = W.modify' swapUpSlave'
where
swapUpSlave' (W.Stack t (l:[]) rs) = W.Stack t (reverse (l:rs)) []
swapUpSlave' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)
swapUpSlave' (W.Stack t [] rs) = W.Stack t (reverse rs) []
-- | Swap position with the next window which is not the master window. Wrap
-- around the end.
swapDownSlave :: WindowSet -> WindowSet
swapDownSlave = W.modify' swapDownSlave'
where
swapDownSlave' s@(W.Stack _ [] []) = s
swapDownSlave' (W.Stack t ls (r:rs)) = W.Stack t (r:ls) rs
swapDownSlave' (W.Stack t ls@(_:_) []) = W.Stack t [x] xs where (x:xs) = (reverse ls)
Pager.hs
------------------------------------------------------------------------------
-- |
-- Module : Pager
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- A pager for DynamicLog showing a symbol for each window on each workspace.
--
------------------------------------------------------------------------------
module Pager (
-- * Usage
-- $usage
labeledPager
) where
-- XMonad modules
import XMonad
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
-- My modules
import Util
-- $usage
--
-- The simplest way to use this module is to add something like this in your
-- @~\/.xmonad\/xmonad.hs@. Note that you need to patch your xmonad source to
-- allow support for user modules (see my @xmonad.hs@).
--
-- > import XMonad.Hooks.DynamicLog
-- > import Pager
-- >
-- > main = xmonad $ defaultConfig {
-- > ...
-- > logHook = myDynamicLog
-- > ...
-- > }
-- >
-- > myDynamicLog :: PP
-- > myDynamicLog = defaultPP
-- > { ppOrder = order
-- > , ppExtras = [ labeledPager myDynamicLog windowLabelMap ]
-- > }
-- > where
-- > order (_:l:t:ws:_) = ws:l:t:[]
-- > order xs = ["Error in order list: " ++ show xs]
--
-- You also need a way to assign symbols to your windows. Here is a simple
-- example using single letter symbols, but you also use dzen icons.
--
-- > -- | Map windows to symbols for the pager. Symbols for floating windows are in
-- > -- lower case.
-- > windowLabelMap :: [(String, Query Bool)]
-- > windowLabelMap =
-- > map whenFloat tiledWindows ++ tiledWindows
-- > ++
-- > map whenFloat generalQueries ++ generalQueries
-- > where
-- >
-- > whenFloat (l, q) = (map toLower l, isFloat <&&> q)
-- >
-- > tiledWindows =
-- > [ ("V", className =? "Gvim")
-- > , ("E", className =? "Emacs")
-- > , ("W", className =? "Firefox")
-- > ]
-- >
-- > generalQueries =
-- > [ ("T", appName =? "xterm")
-- > , ("X", return True) -- catchall
-- > ]
-- | The 'DynamicLog' logger to add to 'ppExtras' using the given pretty
-- printer and window label map.
labeledPager :: PP -> [(String, Query Bool)] -> X (Maybe String)
labeledPager pp lm = do
s <- gets windowset
urgents <- readUrgents
sort' <- ppSort pp
wl <- queryWindows s lm
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 pp (W.tag ws ++ printWindows wl (W.integrate' $ W.stack ws))
where printer | 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
-- | 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 :: M.Map Window String -- ^ window to symbol map
-> [Window] -- ^ windows on the workspace
-> String
printWindows wl ws = pad $ concatMap (\w -> fromMaybe "" $ M.lookup w wl) ws
where
pad "" = ""
pad 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, "?")
qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)
ScratchpadPrime.hs
------------------------------------------------------------------------------
-- |
-- Module : ScratchpadPrime
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- A modified scatchpad which uses GNU Screen to detach the window rather than
-- putting it on a hidden workspace. This makes cycling between workspaces
-- easy, as there is no need for a dummy workspace to store the terminal when
-- hidden.
--
------------------------------------------------------------------------------
module ScratchpadPrime (
scratchpad'
) where
-- Haskell modules
import Control.Monad
-- XMonad modules
import XMonad
import qualified XMonad.StackSet as W
-- | A modified scatchpad which uses GNU Screen to detach the
-- window rather than putting it on a hidden workspace.
scratchpad' :: Query Bool -> String -> X ()
scratchpad' q cmd = withWindowSet $ \s -> do
filterCurrent <- filterM (runQuery $ q)
$ (maybe [] W.integrate
. W.stack
. W.workspace
. W.current) s
case filterCurrent of
(x:_) -> kill' x
[] -> do
filterAll <- filterM (runQuery $ q) $ W.allWindows s
case filterAll of
(x:_) -> windows (W.shiftWin (W.currentTag s) x)
-- no need to 'sleep 0.2' here, as window isn't resized
[] -> spawn cmd
-- | As 'kill', but kill a given window (rather than killing the focused window).
kill' :: Window ->X ()
kill' w = withDisplay $ \d -> do
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
protocols <- io $ getWMProtocols d w
io $ if wmdelt `elem` protocols
then allocaXEvent $ \ev -> do
setEventType ev clientMessage
setClientMessageEvent ev w wmprot 32 wmdelt 0
sendEvent d w False noEventMask ev
else killClient d w >> return ()
ServerMode.hs
------------------------------------------------------------------------------
-- |
-- Module : ServerMode
-- Copyright : (c) Mads N Noe 2009
-- (c) Andrea Rossato and David Roundy 2007
-- Maintainer : mntnoe (@) gmail.com
-- License : BSD-style (see xmonad\/LICENSE)
--
-- Modification of XMonad.Hooks.ServerMode with custom actions.
--
------------------------------------------------------------------------------
module ServerMode (
ServerMode (..)
, eventHook
) where
-- Haskell modules
import Control.Monad (when)
import Data.List
import Data.Maybe
import System.IO
import qualified Data.Map as M
-- XMonad modules
import XMonad
import XMonad.Actions.Commands hiding (runCommand')
import XMonad.Hooks.EventHook
import XMonad.Actions.CycleWS
import qualified XMonad.StackSet as W
-- My modules
import Util
-- | Custom commands.
commands :: X [(String, X ())]
commands = do
return $
[ ("prev-empty-ws" , doWithWS W.greedyView Prev EmptyWS)
, ("prev-nonempty-ws" , doWithWS W.greedyView Prev NonEmptyWS)
, ("next-nonempty-ws" , doWithWS W.greedyView Next NonEmptyWS)
, ("next-empty-ws" , doWithWS W.greedyView Next EmptyWS)
]
data ServerMode = ServerMode deriving ( Show, Read )
instance EventHook ServerMode where
handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
d <- asks display
a <- io $ internAtom d "XMONAD_COMMAND" False
when (mt == a && dt /= []) $ do
cl <- commands
let listOfCommands = zipWith (++) (map show ([1..] :: [Int])) . map ((++) " - " . fst)
case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
Just (c,_) -> runCommand' c
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
handleEvent _ _ = return ()
-- | Given the name of a command from 'defaultCommands', return the
-- corresponding action (or the null action if the command is not
-- found).
runCommand' :: String -> X ()
runCommand' c = do
m <- fmap commandMap commands
fromMaybe (return ()) (M.lookup c m)
Util.hs
------------------------------------------------------------------------------
-- |
-- Module : Util
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Utility functions for XMonad.
--
------------------------------------------------------------------------------
module Util where
-- Haskell modules
import Control.Monad (unless, when)
import Control.Monad.Trans (lift)
import Data.List
import qualified Data.Map as M
import Data.Monoid (Endo(Endo))
import System.Posix.Unistd(getSystemID, nodeName)
import System.IO.Error (isDoesNotExistError)
-- XMonad modules
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Actions.WindowGo
import qualified XMonad.StackSet as W
import XMonad.Util.WorkspaceCompare (getSortByTag)
-- | Perform k x if x return a 'Just' value.
(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
x ?+ k = x >>= maybe (return ()) k
infixr 1 ?+
-- | Helper function for use with monads.
if_ :: t -> t -> Bool -> t
if_ t f c = if c
then t
else f
-- | 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, "'"]
-- | Shift a window to a workspace and switch to that workspace in one
-- operation.
shiftView :: WorkspaceId -> WindowSet -> WindowSet
shiftView ws w = W.greedyView ws $ W.shift ws w
-- | Perform a workspace transformation on the next workspace in 'WSDirection'
-- of type 'WSType'.
doWithWS :: (String -> (WindowSet -> WindowSet)) -> WSDirection -> WSType -> X ()
doWithWS f dir wstype = do
i <- findWorkspace getSortByTag dir wstype 1
windows $ f i
-- | Is the current workspace empty?
isCurrentWsEmpty :: X Bool
isCurrentWsEmpty = withWindowSet $ \s -> do
let l = W.integrate' $ W.stack $ W.workspace $ W.current s
return $ null l
-- | Modify the 'WindowSet' with a non-pure function. Counterpart to 'doF'.
doX :: (Window -> X (WindowSet -> WindowSet)) -> ManageHook
doX f = ask >>= Query . lift . fmap Endo . f
-- | Ensure that a window always starts on an empty workspace. If a window
-- satisfying the query exists, focus it. Otherwise run the specified
-- command, swithing to an empty workspace if the current one is not empty.
reqEmptyWS :: Query Bool -> X () -> X ()
reqEmptyWS q f = do
raiseNextMaybe (reqEmptyWS' >> f) q
where
reqEmptyWS' = do
empty <- isCurrentWsEmpty
i <- findWorkspace getSortByTag Next EmptyWS 1
unless empty $ windows $ W.greedyView i
-- | Kill the focused window. If the window satisfies the query, return to the
-- previously displayed workspace.
killAndReturn q = withFocused $ \w -> do
qr <- runQuery q w
kill
when qr toggleWS
-- | Perform a 'WindowSet' transformation on the workspace with the given
-- index.
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = nthWorkspaceTag wnum ?+ windows . job
where
nthWorkspaceTag :: Int -> X (Maybe String)
nthWorkspaceTag wnum = do
sort <- getSortByTag
ws <- gets (map W.tag . sort . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> return $ Just w
[] -> return Nothing
-- | 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)
-- | 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)
-- | Determine the host.
getHost = do
host <- getSystemID
case nodeName host of
"mntnoe-desktop" -> return Desktop
"mntnoe-laptop" -> return Laptop
_ -> return Desktop
-- | For use in cross host configutions.
data Host = Desktop | Laptop deriving Eq