aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Config
diff options
context:
space:
mode:
authorDaniel Wagner <daniel@wagner-home.com>2013-05-02 03:21:32 +0200
committerDaniel Wagner <daniel@wagner-home.com>2013-05-02 03:21:32 +0200
commit0b30abc5cfad54bb99905502e45e133b511afcea (patch)
tree4164399c91a600f491b64b52481c0dc3697a06f6 /XMonad/Config
parent0f1f1a682524b026a4537f4c8f0292cb904aacf8 (diff)
downloadXMonadContrib-0b30abc5cfad54bb99905502e45e133b511afcea.tar.gz
XMonadContrib-0b30abc5cfad54bb99905502e45e133b511afcea.tar.xz
XMonadContrib-0b30abc5cfad54bb99905502e45e133b511afcea.zip
XMonad.Config.Dmwit
Ignore-this: 7402161579fd2e191b60a057d955e5ea darcs-hash:20130502012132-76d51-db5a8296f28a2d9e16e5961bf8a235c8a0d078ed.gz
Diffstat (limited to 'XMonad/Config')
-rw-r--r--XMonad/Config/Dmwit.hs324
1 files changed, 324 insertions, 0 deletions
diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs
new file mode 100644
index 0000000..f899b59
--- /dev/null
+++ b/XMonad/Config/Dmwit.hs
@@ -0,0 +1,324 @@
+-- boilerplate {{{
+{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
+module XMonad.Config.Dmwit where
+
+-- system imports
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+import Data.Char
+import Data.List
+import Data.Map (Map, fromList)
+import Data.Ratio
+import Data.Word
+import GHC.Real
+import System.Environment
+import System.Exit
+import System.IO
+import System.Process
+
+-- xmonad core
+import XMonad
+import XMonad.StackSet hiding (workspaces)
+
+-- xmonad contrib
+import XMonad.Actions.SpawnOn
+import XMonad.Actions.Warp
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Hooks.SetWMName
+import XMonad.Layout.Grid
+import XMonad.Layout.IndependentScreens
+import XMonad.Layout.Magnifier
+import XMonad.Layout.NoBorders
+import XMonad.Util.Dzen hiding (x, y)
+import XMonad.Util.SpawnOnce
+-- }}}
+-- volume {{{
+outputOf :: String -> IO String
+outputOf s = do
+ uninstallSignalHandlers
+ (hIn, hOut, hErr, p) <- runInteractiveCommand s
+ mapM_ hClose [hIn, hErr]
+ hGetContents hOut <* waitForProcess p <* installSignalHandlers
+
+geomMean :: Floating a => [a] -> a
+geomMean xs = product xs ** (recip . fromIntegral . length $ xs)
+
+arithMean :: Floating a => [a] -> a
+arithMean xs = sum xs / fromIntegral (length xs)
+
+namedNumbers n s = do
+ l <- lines s
+ guard (sentinel `isPrefixOf` l)
+ return (drop (length sentinel) l)
+ where sentinel = n ++ " #"
+
+-- Data.List.Split.splitOn ":", but without involving an extra dependency
+splitColon xs = case break (==':') xs of
+ (a, ':':b) -> a : splitColon b
+ (a, _) -> [a]
+
+parse s = arithMean $ do
+ l <- lines s
+ guard ("\tVolume: " `isPrefixOf` l)
+ part <- splitColon l
+ (n,'%':_) <- reads part
+ return n
+
+modVolume :: String -> Integer -> IO Double
+modVolume kind n = do
+ is <- namedNumbers parseKind <$> outputOf listCommand
+ forM_ is (outputOf . setCommand)
+ parse <$> outputOf listCommand
+ where
+ sign | n > 0 = "+" | otherwise = "-"
+ ctlKind = map (\c -> if c == ' ' then '-' else c) kind
+ parseKind = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind
+ setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%"
+ listCommand = "pactl list " ++ ctlKind ++ "s"
+-- }}}
+-- convenient actions {{{
+centerMouse = warpToWindow (1/2) (1/2)
+statusBarMouse = warpToScreen 0 (5/1600) (5/1200)
+withScreen s f = screenWorkspace s >>= flip whenJust (windows . f)
+
+makeLauncher yargs run exec close = concat
+ ["exe=`yeganesh ", yargs, "` && ", run, " ", exec, "$exe", close]
+launcher = makeLauncher "" "eval" "\"exec " "\""
+termLauncher = makeLauncher "-p withterm" "exec urxvt -e" "" ""
+viewShift i = view i . shift i
+floatAll = composeAll . map (\s -> className =? s --> doFloat)
+sinkFocus = peek >>= maybe id sink
+showMod k n = liftIO (modVolume k n) >>= volumeDzen . show . round
+volumeDzen = dzenConfig $ onCurr (center 170 66) >=> font "-*-helvetica-*-r-*-*-64-*-*-*-*-*-*-*,-*-terminus-*-*-*-*-64-*-*-*-*-*-*-*"
+-- }}}
+altMask = mod1Mask
+bright = "#80c0ff"
+dark = "#13294e"
+-- manage hooks for mplayer {{{
+fullscreen43on169 = expand $ RationalRect 0 (-1/6) 1 (4/3) where
+ expand (RationalRect x y w h) = RationalRect (x - bwx) (y - bwy) (w + 2 * bwx) (h + 2 * bwy)
+ bwx = 2 / 1920 -- borderwidth
+ bwy = 2 / 1080
+
+fullscreenMPlayer = className =? "MPlayer" --> do
+ dpy <- liftX $ asks display
+ win <- ask
+ hints <- liftIO $ getWMNormalHints dpy win
+ case fmap (approx . fst) (sh_aspect hints) of
+ Just ( 4 :% 3) -> viewFullOn 0 "5" win
+ Just (16 :% 9) -> viewFullOn 1 "5" win
+ _ -> doFloat
+ where
+ fi = fromIntegral :: Dimension -> Double
+ approx (n, d) = approxRational (fi n / fi d) (1/100)
+
+operationOn f s n w = do
+ let ws = marshall s n
+ currws <- liftX $ screenWorkspace s
+ doF $ view ws . maybe id view currws . shiftWin ws w . f w
+
+viewFullOn = operationOn sink
+centerWineOn = operationOn (`XMonad.StackSet.float` RationalRect (79/960) (-1/540) (401/480) (271/270))
+-- }}}
+-- debugging {{{
+class Show a => PPrint a where
+ pprint :: Int -> a -> String
+ pprint _ = show
+
+data PPrintable = forall a. PPrint a => P a
+instance Show PPrintable where show (P x) = show x
+instance PPrint PPrintable where pprint n (P x) = pprint n x
+
+record :: String -> Int -> [(String, PPrintable)] -> String
+record s n xs = preamble ++ intercalate newline fields ++ postlude where
+ indentation = '\n' : replicate n '\t'
+ preamble = s ++ " {" ++ indentation
+ postlude = indentation ++ "}"
+ newline = ',' : indentation
+ fields = map (\(name, value) -> name ++ " = " ++ pprint (n+1) value) xs
+
+instance PPrint a => PPrint (Maybe a) where
+ pprint n (Just x) = "Just (" ++ pprint n x ++ ")"
+ pprint _ x = show x
+
+instance PPrint a => PPrint [a] where
+ pprint _ [] = "[]"
+ pprint n xs = preamble ++ intercalate newline allLines ++ postlude where
+ indentation = '\n' : replicate n '\t'
+ preamble = "[" ++ indentation
+ allLines = map (pprint (n+1)) xs
+ newline = ',' : indentation
+ postlude = indentation ++ "]"
+
+instance PPrint Rectangle where
+ pprint n x = record "Rectangle" n [
+ ("rect_x", P (rect_x x)),
+ ("rect_y", P (rect_y x)),
+ ("rect_width", P (rect_width x)),
+ ("rect_height", P (rect_height x))
+ ]
+
+instance PPrint a => PPrint (Stack a) where
+ pprint n x = record "Stack" n [
+ ("focus", P (XMonad.StackSet.focus x)),
+ ("up", P (up x)),
+ ("down", P (down x))
+ ]
+
+instance (PPrint i, PPrint l, PPrint a) => PPrint (Workspace i l a) where
+ pprint n x = record "Workspace" n [
+ ("tag", P (tag x)),
+ ("layout", P (layout x)),
+ ("stack", P (stack x))
+ ]
+
+instance PPrint ScreenDetail where
+ pprint n x = record "SD" n [("screenRect", P (screenRect x))]
+
+instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (XMonad.StackSet.Screen i l a sid sd) where
+ pprint n x = record "Screen" n [
+ ("workspace", P (workspace x)),
+ ("screen", P (screen x)),
+ ("screenDetail", P (screenDetail x))
+ ]
+
+instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (StackSet i l a sid sd) where
+ pprint n x = record "StackSet" n [
+ ("current", P (current x)),
+ ("visible", P (visible x)),
+ ("hidden", P (hidden x)),
+ ("floating", P (floating x))
+ ]
+
+instance PPrint (Layout a)
+instance PPrint Int
+instance PPrint XMonad.Screen
+instance PPrint Integer
+instance PPrint Position
+instance PPrint Dimension
+instance PPrint Char
+instance PPrint Word64
+instance PPrint ScreenId
+instance (Show a, Show b) => PPrint (Map a b)
+-- }}}
+-- main {{{
+dmwitConfig nScreens = defaultConfig {
+ borderWidth = 2,
+ workspaces = withScreens nScreens (map show [1..5]),
+ terminal = "urxvt",
+ normalBorderColor = dark,
+ focusedBorderColor = bright,
+ modMask = mod4Mask,
+ keys = keyBindings,
+ layoutHook = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full,
+ manageHook = (title =? "CGoban: Main Window" --> doF sinkFocus)
+ <+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")
+ <+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")
+ <+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one
+ <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
+ <+> fullscreenMPlayer
+ <+> floatAll ["Gimp", "Wine"]
+ <+> manageDocks
+ <+> manageSpawn,
+ logHook = allPPs nScreens,
+ startupHook = refresh >> setWMName "LG3D" -- gotta keep this until all the machines I use have the version of openjdk that respects _JAVA_AWT_WM_NONREPARENTING
+ >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]
+ }
+
+main = countScreens >>= xmonad . dmwitConfig
+-- }}}
+-- keybindings {{{
+keyBindings conf = let m = modMask conf in fromList . anyMask $ [
+ ((m , xK_BackSpace ), spawnHere "urxvt"),
+ ((m , xK_p ), spawnHere launcher),
+ ((m .|. shiftMask , xK_p ), spawnHere termLauncher),
+ ((m .|. shiftMask , xK_c ), kill),
+ ((m , xK_q ), restart "xmonad" True),
+ ((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)),
+ ((m , xK_grave ), sendMessage NextLayout),
+ ((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf),
+ ((m , xK_o ), sendMessage Toggle),
+ ((m , xK_x ), withFocused (windows . sink)),
+ ((m , xK_Home ), windows focusUp),
+ ((m .|. shiftMask , xK_Home ), windows swapUp),
+ ((m , xK_End ), windows focusDown),
+ ((m .|. shiftMask , xK_End ), windows swapDown),
+ ((m , xK_a ), windows focusMaster),
+ ((m .|. shiftMask , xK_a ), windows swapMaster),
+ ((m , xK_Control_L ), withScreen 0 view),
+ ((m .|. shiftMask , xK_Control_L ), withScreen 0 viewShift),
+ ((m , xK_Alt_L ), withScreen 1 view),
+ ((m .|. shiftMask , xK_Alt_L ), withScreen 1 viewShift),
+ ((m , xK_u ), centerMouse),
+ ((m .|. shiftMask , xK_u ), statusBarMouse),
+ ((m , xK_s ), spawnHere "chromium --password-store=gnome"),
+ ((m , xK_n ), spawnHere "gvim todo"),
+ ((m , xK_t ), spawnHere "mpc toggle"),
+ ((m , xK_h ), spawnHere "urxvt -e alsamixer"),
+ ((m , xK_d ), spawnHere "wyvern"),
+ ((m , xK_l ), spawnHere "urxvt -e sup"),
+ ((m , xK_r ), spawnHere "urxvt -e ncmpcpp"),
+ ((m , xK_c ), spawnHere "urxvt -e ghci"),
+ ((m , xK_g ), spawnHere "slock" >> spawnHere "xscreensaver-command -lock"),
+ ((m , xK_f ), spawnHere "gvim ~/.xmonad/xmonad.hs"),
+ (( noModMask , xK_F8 ), showMod "sink input" (-4)),
+ (( noModMask , xK_F9 ), showMod "sink input" 4 ),
+ (( shiftMask , xK_F8 ), showMod "sink" (-4)),
+ (( shiftMask , xK_F9 ), showMod "sink" 4 ),
+ (( noModMask , xK_Super_L ), return ()) -- make VirtualBox ignore stray hits of the Windows key
+ ] ++ [
+ ((m .|. e , key ), windows (onCurrentScreen f ws))
+ | (key, ws) <- zip [xK_1..xK_9] (workspaces' conf)
+ , (e, f) <- [(0, view), (shiftMask, viewShift)]
+ ]
+
+atSchool school home = do
+ host <- liftIO (getEnv "HOST")
+ return $ case host of
+ "sorghum" -> home
+ "buckwheat" -> home
+ _ -> school
+
+anyMask xs = do
+ ((mask, key), action) <- xs
+ extraMask <- [0, controlMask, altMask, controlMask .|. altMask]
+ return ((mask .|. extraMask, key), action)
+-- }}}
+-- logHook {{{
+pipeName n s = "/home/dmwit/.xmonad/pipe-" ++ n ++ "-" ++ show s
+
+xmobarCommand (S s) = unwords ["xmobar",
+ "-x", show s,
+ "-t", template s,
+ "-C", pipeReader
+ ]
+ where
+ template 0 = "}%focus%{%workspaces%"
+ template _ = "%date%}%focus%{%workspaces%"
+ pipeReader = "'[\
+ \Run PipeReader \"" ++ pipeName "focus" s ++ "\" \"focus\",\
+ \Run PipeReader \"" ++ pipeName "workspaces" s ++ "\" \"workspaces\"\
+ \]'"
+
+allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp <- [ppFocus, ppWorkspaces]]
+color c = xmobarColor c ""
+
+ppFocus s@(S s_) = whenCurrentOn s defaultPP {
+ ppOrder = \(_:_:windowTitle:_) -> [windowTitle],
+ ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")
+ }
+
+ppWorkspaces s@(S s_) = marshallPP s defaultPP {
+ ppCurrent = color "white",
+ ppVisible = color "white",
+ ppHiddenNoWindows = color dark,
+ ppUrgent = color "red",
+ ppSep = "",
+ ppOrder = \(wss:_layout:_title:_) -> [wss],
+ ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n")
+ }
+-- }}}