Xmonad/Config archive/sykopomp's xmonad.dv-vi.hs
< Xmonad | Config archive
Jump to navigation
Jump to search
import XMonad
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.EwmhDesktops
import qualified XMonad.StackSet as W
import Data.Bits ((.|.))
import System.Exit
import System.IO
import qualified Data.Map as M
import XMonad.Layout.TwoPane
import XMonad.Layout.ResizableTile
import XMonad.Layout.Tabbed
import XMonad.Layout.Combo
import XMonad.Layout.WindowNavigation
import XMonad.Layout.Circle
-- Actions
import XMonad.Actions.CycleWS
import XMonad.Actions.SwapWorkspaces
import XMonad.Actions.Submap
main = xmonad $ defaultConfig
{ borderWidth = 2
, focusedBorderColor = "#C11B17"
, normalBorderColor = "#2e3436"
, manageHook = myManageHook <+> manageDocks
, workspaces = map show [1 .. 9 :: Int]
, terminal = "urxvtc"
, modMask = mod4Mask
, logHook = myLogHook
, layoutHook = windowNavigation $ (avoidStruts (myTab ||| tall ||| Mirror tall ||| Circle))
, keys = \c -> myKeys c `M.union` keys defaultConfig c
}
where
tall = ResizableTall 1 (3/100) (1/2) []
myTab = tabbed shrinkText myTabConfig
-- The tab layout config {{{
myTabConfig = defaultTheme
{ activeColor = "#C11B17"
, inactiveColor = "#7E2217"
, urgentColor = "#C500C5"
, activeBorderColor = "white"
, inactiveBorderColor = "grey"
, activeTextColor = "white"
, inactiveTextColor = "grey"
, decoHeight = 12
, fontName = "-*-terminus-*-*-*-*-12-*-*-*-*-*-iso10646-1"
}
myLogHook :: X ()
myLogHook = do ewmhDesktopsLogHook
return ()
-- To find the property name associated with a program, use
-- > xprop | grep WM_CLASS
-- and click on the client you're interested in.
myManageHook = composeAll
[ className =? "MPlayer" --> doFloat
, className =? "Gimp" --> doFloat
, className =? "Thunar" --> doFloat
, className =? "VLC media player" --> doFloat
, className =? "Thunderbird-bin" --> doF(W.shift "3")
, className =? "Pidgin" --> doF(W.shift "1")
, className =? "Minefield" --> doF(W.shift "2")
, resource =? "amarokapp" --> doF(W.shift "5")
, className =? "Gimmix" --> doF(W.shift "5")
, resource =? "desktop_window" --> doIgnore
, className =? "Xfce4-panel" --> doFloat
, className =? "Xfce-mcs-manager" --> doFloat
, className =? "Xfce-mixer" --> doFloat
, className =? "Gui.py" --> doFloat
, manageDocks]
--------------------------------
-- full dvorak-oriented remap --
--------------------------------
myKeys conf@(XConfig {modMask = modm}) = M.fromList $
-- Window Navigation
-- select...
[ ((modm, xK_Right), sendMessage $ Go R)
, ((modm, xK_Left ), sendMessage $ Go L)
, ((modm, xK_Up ), sendMessage $ Go U)
, ((modm, xK_Down ), sendMessage $ Go D)
-- swap...
, ((modm .|. shiftMask, xK_Right), sendMessage $ Swap R)
, ((modm .|. shiftMask, xK_Left ), sendMessage $ Swap L)
, ((modm .|. shiftMask, xK_Up ), sendMessage $ Swap U)
, ((modm .|. shiftMask, xK_Down ), sendMessage $ Swap D)
-- move...
, ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
, ((modm .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L)
, ((modm .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U)
, ((modm .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D)
-- shrink and expand
, ((modm , xK_s), sendMessage MirrorShrink)
, ((modm, xK_z), sendMessage MirrorExpand)
--multimedia keys
, ((modm , xK_o), spawn "aumix -v -5")
, ((modm , xK_e), spawn "aumix -v +5")
, ((modm , xK_p), spawn "mpc toggle")
, ((modm , xK_apostrophe), spawn "mpc stop")
, ((modm , xK_comma), spawn "mpc prev")
, ((modm , xK_period), spawn "mpc next")
-- increase transparency
,((modm , xK_a), spawn "transset-df -a --dec .1")
,((modm , xK_u), spawn "transset-df -a --inc .1")
--rebindings
-- launch a terminal
, ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
-- launch dmenu
, ((modm, xK_l ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
-- close focused window
, ((modm, xK_k ), kill)
-- Rotate through the available layout algorithms
, ((modm, xK_space ), sendMessage NextLayout)
-- Reset the layouts on the current workspace to default
, ((modm .|. shiftMask, xK_space ), setLayout $ XMonad.layoutHook conf)
-- Resize viewed windows to the correct size
, ((modm, xK_b ), refresh)
-- Move focus to the next window
, ((modm, xK_Tab ), windows W.focusDown)
-- Move focus to the next window
, ((modm, xK_t ), windows W.focusDown)
, ((modm, xK_Tab ), windows W.focusDown)
-- Move focus to the previous window
, ((modm, xK_h ), windows W.focusUp )
-- Move focus to the masterh window
, ((modm, xK_m ), windows W.focusMaster )
-- Swap the focused window and the master window
, ((modm, xK_Return), windows W.swapMaster)
-- Swap the focused window with the next window
, ((modm .|. shiftMask, xK_h ), windows W.swapDown )
-- Swap the focused window with the previous window
, ((modm .|. shiftMask, xK_t ), windows W.swapUp )
-- Shrink the master area
, ((modm, xK_d ), sendMessage Shrink)
-- Expand the master area
, ((modm, xK_n ), sendMessage Expand)
-- Push window back into tiling
, ((modm, xK_y ), withFocused $ windows . W.sink)
-- Increment the number of windows in the master area
, ((modm , xK_w ), sendMessage (IncMasterN 1))
-- Deincrement the number of windows in the master area
, ((modm , xK_v), sendMessage (IncMasterN (-1)))
-- toggle the status bar gap
, ((modm , xK_x ),
modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i
in if n == x then (0,0,0,0) else x))
-- Quit xmonad
, ((modm .|. shiftMask, xK_q ), io (exitWith ExitSuccess))
-- Restart xmonad
, ((modm , xK_q ),
broadcastMessage ReleaseResources >> restart "xmonad" True) ]
++
-- mod-[1..9], Switch to workspace N
-- mod-shift-[1..9], Move client to workspace N
--
[((m .|. modm, k), windows $ f i)
| (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
, (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
++
--
-- mod-{ , , . , p}, Switch to physical/Xinerama screens 1, 2, or 3
-- mod-shift-{foo}, Move client to screen 1, 2, or 3
--
[((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f))
| (key, sc) <- zip [xK_c, xK_r] [0..]
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]