{-# 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: