From 0b30abc5cfad54bb99905502e45e133b511afcea Mon Sep 17 00:00:00 2001 From: Daniel Wagner Date: Thu, 2 May 2013 03:21:32 +0200 Subject: XMonad.Config.Dmwit Ignore-this: 7402161579fd2e191b60a057d955e5ea darcs-hash:20130502012132-76d51-db5a8296f28a2d9e16e5961bf8a235c8a0d078ed.gz --- XMonad/Config/Dmwit.hs | 324 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 XMonad/Config/Dmwit.hs (limited to 'XMonad/Config/Dmwit.hs') 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") + } +-- }}} -- cgit v1.2.3