import System.IO import System.Directory import System.Exit (exitWith, ExitCode(ExitSuccess)) import Codec.Binary.UTF8.String as UTF8 (decodeString) import Data.Ratio ((%)) import Data.List import qualified Data.Map as M import XMonad import XMonad.Core import XMonad.Config import XMonad.ManageHook import qualified XMonad.StackSet as W import qualified XMonad.Prompt as P import XMonad.Layout.DecorationMadness import XMonad.Layout.Grid import XMonad.Layout.IM import XMonad.Layout.MosaicAlt import XMonad.Layout.Named import XMonad.Layout.NoBorders import XMonad.Layout.PerWorkspace import XMonad.Layout.Reflect import XMonad.Layout.Tabbed import XMonad.Layout.ThreeColumns import XMonad.Layout.TrackFloating import qualified XMonad.Layout.Magnifier as Mag import XMonad.Actions.CopyWindow import XMonad.Actions.CycleWS import XMonad.Actions.DynamicWorkspaces import XMonad.Actions.FindEmptyWorkspace import XMonad.Actions.FloatSnap import XMonad.Actions.GridSelect import XMonad.Actions.SinkAll import XMonad.Actions.SpawnOn import XMonad.Actions.TopicSpace hiding (pprWindowSet) import XMonad.Actions.UpdateFocus import qualified XMonad.Actions.FlexibleManipulate as Flex import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Hooks.ServerMode import XMonad.Hooks.SetWMName import XMonad.Hooks.UrgencyHook import XMonad.Hooks.XPropManage import XMonad.Prompt.AppLauncher import XMonad.Prompt.Man import XMonad.Prompt.Shell import XMonad.Prompt.Ssh import XMonad.Prompt.XMonad import XMonad.Util.NamedScratchpad -- --replace handling import XMonad.Util.Replace (replace) import Control.Monad (when) import System.Environment (getArgs) import Data.Maybe (fromMaybe, fromJust, isNothing, isJust) import Data.Ord (comparing) -- for hostname handling (no windows key on "Australien") import Network.HostName -- custom modules import HistoryGrid import EZConfig import Pass import qualified Confirm font :: String font = "xft:Hack:size=10" term :: String term = "urxvt" browser :: String browser = "browser" modM :: String -> KeyMask -- mod1Mask = Alt, mod2Mask = , mod3Mask= , mod4Mask = Win, mod5Mask = AltGrk modM "Australien" = mod1Mask modM _ = mod4Mask myDzenUrgencyConfig = DzenUrgencyHook { args = ["-bg", "red", "-fg", "black", "-fn", font, "-w", "600", "-ta", "c", "-x", "520", "-y", "10", "-h", "30" ] , duration = seconds 5 } --{{{ main main = do args <- getArgs when ("--replace" `elem` args) replace dzenStatusDir <- getAppUserDataDirectory "xmonad" dzenStatusFile <- openFile (dzenStatusDir ++ "/dzenStatus") WriteMode hostname <- getHostName xmonad -- Do _not_ use "ewhm" here, this would add the ewhm hooks to the -- end of your custom hooks (esp. the startup hook) and this would -- overwrite the setWMName "LG3D" and some Java apps will not work. $ withUrgencyHook myDzenUrgencyConfig $ defaultConfig { modMask = modM hostname , terminal = term , borderWidth = 1 , normalBorderColor = "#545454" , focusedBorderColor = "#A00000" , logHook = myLogHook dzenStatusFile , manageHook = myManageHook , keys = \c -> mkKeymap c $ myKeys c hostname , mouseBindings = \c -> M.union (M.fromList $ myMouse (modM hostname) c) $ mouseBindings defaultConfig c , layoutHook = myLayout , workspaces = topics , handleEventHook = myEventHook , startupHook = myStartupHook } --}}} --{{{ TopicSpaces topics :: [Topic] topics = [ "web", "mail", "irc", "im", "video", "music" , "spline", "usdx", "partdb", "riot", "zedat" , "emacs", "xmonad", "gimp"] topicsConfig = TopicConfig { topicDirs = M.fromList $ [ ("web", "./") , ("mail", "./") , ("irc", "./") , ("im", "./") , ("video", "media/video") , ("music", "media/audio/") , ("spline", "dev/spline/") , ("usdx", "dev/usdx/") , ("partdb", "dev/Part-DB/") , ("riot", "dev/RIOT/") , ("zedat", "./") , ("emacs", "./") , ("xmoand", ".xmonad/") , ("gimp", "./") ] , defaultTopicAction = const $ spawnShell >*> 2 , defaultTopic = "web" , maxTopicHistory = 10 , topicActions = M.fromList $ [ ("web" , spawnHere browser) , ("mail" , spawn "emacsclient -e '(wl-start)'") , ("irc" , spawnHere "hexchat") , ("im" , spawnHere "tkabber") , ("music" , spawnHere "guayadeque") , ("zedat" , spawnHere $ term ++ " -e is") , ("emacs" , spawnHere "emacs") , ("gimp" , spawnHere "gimp") ] } where spawnShell = currentTopicDir topicsConfig >>= spawnShellIn spawnShellIn dir = spawnHere $ "cd " ++ dir ++ " && " ++ term topicsGrid = withWindowSet $ \w -> do let wss = W.workspaces w usednames = filter (\w -> w /= "NSP") $ map W.tag $ wss newnames = filter (\used -> (show used `notElem` (map show topics))) usednames gridselect topicsGridConfig (map (\t -> (t, t)) (topics ++ newnames)) promptedGoto = topicsGrid >>= flip whenJust (switchTopic topicsConfig) promptedShift = topicsGrid >>= \x -> whenJust x $ \y -> windows (W.greedyView y . W.shift y) --}}} --{{{ Prompts data MyShell = MyShell instance XPrompt MyShell where showXPrompt MyShell = "Run: " myShellPrompt :: XPConfig -> X () myShellPrompt c = do cmds <- io getCommands mkXPrompt MyShell c (getShellCompl cmds) spawn --}}} --{{{ Scratchpads scratchpads = [ NS "hotot" "hotot" (className =? "Hotot") (customFloating $ W.RationalRect 0.01 0.01 0.4 0.98) , NS "log" "urxvt -name logtail -e logtail" (appName =? "logtail") (customFloating $ W.RationalRect 0.03 0.03 0.94 0.6) ] notNspHiddenWS :: X (WindowSpace -> Bool) notNspHiddenWS = do notNsp <- notNspWS hidden <- hiddenWS nonEmpty <- nonEmptyWS return (\w -> hidden w && nonEmpty w && notNsp w) where hiddenWS = do hs <- gets (map W.tag . W.hidden . windowset) return (\w -> W.tag w `elem` hs) nonEmptyWS = return $ isJust . W.stack notNspWS = return $ ("NSP" /=) . W.tag --}}} --{{{ Themes myPP statusFile = namedScratchpadFilterOutWorkspacePP $ defaultPP { ppCurrent = wrap "^fg(#FF0000) " " " , ppVisible = wrap "^fg(#0000FF) " " " , ppHiddenNoWindows = \_ -> "" , ppUrgent = wrap "^bg(#FFFF00)^fg(#FF0000) " " " , ppHidden = pad , ppWsSep = "^fg(#888)^bg(#000):" , ppSep = "^fg(#888)^bg(#000):" , ppLayout = wrap "^fg(#fff)" "^fg(#888)" . pad . (\x -> transformLayout x) , ppTitle = ("^fg(#FF0000) " ++) . dzenEscape , ppOrder = \(ws:l:t:[]) -> ["^fg(#888)^bg(#000)" ++ ws,l,t] , ppOutput = dzenWriteStatus statusFile } where dzenWriteStatus file status = do hPutStrLn file status hFlush file -- helper for better Layoutnames transformLayout x = foldl1 (++) $ layoutTransform $ magnifierTransform $ [] : words x magnifierTransform (prefix:magnifier:status:xs) | magnifier == "Magnifier" && status == "(off)" = (prefix ++ "+"):xs | magnifier == "Magnifier" = (prefix ++ "*"):status:xs | otherwise = ((prefix ++ unwords [magnifier, status]):xs) layoutTransform (prefix:l) | unwords l == "ThreeCol" = [prefix, "|||"] | unwords l == "Tabbed" = [prefix, "[ ]"] | unwords l == "Mirror Tall" = [prefix, "=|="] | unwords l == "Tall" = [prefix, "[]="] | otherwise = prefix:l alexTheme :: Theme alexTheme = defaultTheme { inactiveBorderColor = "#545454" , activeBorderColor = "#6E0000" , activeColor = "#6E0000" , inactiveColor = "#424242" , inactiveTextColor = "#ffffff" , activeTextColor = "#ffffff" , fontName = font , decoHeight = 19 } alexXPConfig :: XPConfig alexXPConfig = P.defaultXPConfig { P.font = font } historyGridConfig = defaultGSConfig { gs_cellheight = 50 , gs_cellwidth = 300 , gs_navigate = navNSearch , gs_font = font } topicsGridConfig = defaultGSConfig { gs_navigate = navNSearch , gs_font = font , gs_colorizer = colorizer } where colorizer topic selected | selected = return ("#839596", "#002b36") | otherwise = return ("#002b36", "#839496") confirmConfig :: HasColorizer a => GSConfig a confirmConfig = defaultGSConfig { gs_cellheight = 150 , gs_cellwidth = 300 , gs_cellpadding = 50 , gs_font = "xft:Droid Sans Mono Slashed Bold-35" , gs_originFractX = (1/2) , gs_originFractY = (1/3) } confirm :: String -> X() -> X() confirm = Confirm.confirm confirmConfig --}}} --{{{ Hooks myLogHook statusFile = do ewmhDesktopsLogHook topicOutput <- lastTopics topicsConfig pp otherOutput <- dynamicLogString pp { ppVisible = \_ -> "" , ppCurrent = \_ -> "" , ppUrgent = \_ -> "" , ppHidden = \_ -> "" } io $ ppOutput pp (topicOutput ++ otherOutput) where pp = myPP statusFile lastTopics tg pp = do winset <- gets windowset urgents <- readUrgents let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset maxDepth = maxTopicHistory tg setLastFocusedTopic (W.tag . W.workspace . W.current $ winset) (\t -> (t `notElem` empty_workspaces && t /= "NSP")) lastWs <- getLastFocusedTopics let depth topic = fromJust $ elemIndex topic $ lastWs ++ [topic] add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible, ppUrgent = add_depth ppUrgent } sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag) . namedScratchpadFilterOutWorkspace return $ pprWindowSet sortWindows urgents pp' winset myEventHook = do ewmhDesktopsEventHook serverModeEventHook focusOnMouseMove docksEventHook myStartupHook = do ewmhDesktopsStartup adjustEventInput setWMName "LG3D" myManageHook = namedScratchpadManageHook scratchpads <+> xPropManageHook xPropMatches <+> manageDocks <+> (isDialog --> doCenterFloat) <+> (appName =? "hexcalc" --> (doRectFloat $ W.RationalRect 0.75 0.505 0.2 0.395)) <+> (appName =? "xcalc" --> (doRectFloat $ W.RationalRect 0.75 0.1 0.2 0.395)) <+> (appName =? "wpa_gui" --> (doRectFloat $ W.RationalRect 0.01 0.01 0.4 0.25)) <+> (className =? "Vncviewer" --> doCenterFloat) -- (yt) flash fullscreen mode <+> (className =? "Operapluginwrapper-native" --> doFullFloat) <+> (className =? "Exe" --> doFullFloat) -- xcalendar <+> (appName =? "dayEditor" --> (doRectFloat $ W.RationalRect 0.5 0.02 0.33 0.3)) <+> (appName =? "xcalendar" --> (doRectFloat $ W.RationalRect 0.83 0.02 0.15 0.3)) -- emacs compose mail <+> (appName =? "wanderlust-draft" --> (doRectFloat $ W.RationalRect 0.1 0.1 0.8 0.8)) <+> (className =? "Gxmessage" --> doCenterFloat) xPropMatches :: [XPropMatch] xPropMatches = [ (match, pmP $ W.shift target) | (target, match) <- shifts] ++ [ (match, pmX $ float) | match <- floats] where floats = [ [(wM_CLASS, anyOf ["vlc", "Xmessage", "XVkbd", "Xdialog", "Pinentry", "Pinentry-gtk-2", "Tiemu", "ultrastardx", "Ediff", "xtensoftphone", "Pqiv", "XNots", "TeamViewer.exe", "AmsnWebcam"])] , [(wM_NAME, anyOf ["glxgears", "Passphrase Required", "Mark all as read", "Xplanet 1.2.0", "Eclipse"])] ] shifts = [ ("web", [(wM_CLASS, anyOf ["Opera", "Chrome", "Google-chrome", "Chromium-browser", "Firefox-bin"])]) , ("mail", [(wM_CLASS, anyOf ["Claws-mail", "Evolution", "Mitter", "wanderlust"])]) , ("mail", [(wM_NAME, anyOf ["newsbeuter"])]) , ("irc", [(wM_CLASS, anyOf ["Hexchat"])]) , ("im", [(wM_CLASS, anyOf ["TKabber", "headlines", "Vacuum"])]) -- tkabber single messages , ("im", [(wM_CLASS, anyOf' isPrefixOf ["chat_##xmpp##1_zedatconferencejabberfuberlinde", "chat_##xmpp##1_mailanimuxdeSyslogBot"])]) , ("code", [(wM_CLASS, anyOf ["emacs"])]) , ("video", [(wM_CLASS, anyOf ["MPlayer"])]) , ("music", [(wM_CLASS, anyOf ["Amarokapp"])]) ] anyOf' op valids tests = any (\test -> any (\valid -> op valid test) valids) tests anyOf = anyOf' (==) --}}} --{{{ Keys myKeys c hostname = -- this line is critical to reload config - DON'T REMOVE [ ("M-q", broadcastMessage ReleaseResources >> restart "xmonad" True) , (shutdownKey, confirm "Logout?" $ io (exitWith ExitSuccess)) , ("M-S-", spawn term) , ("M-", openLastHistoryGrid historyGridConfig 30) -- kill current, kill all , ("M-S-c", kill1) , ("M-C-c", kill) -- sticky , ("M-S-v", windows copyToAll) , ("M-C-v", killAllOtherCopies) , ("M-", sendMessage NextLayout) , ("M-S-", setLayout $ XMonad.layoutHook c) , ("M-", windows W.focusDown) , ("M-S-", windows W.focusUp) , ("M-j", windows W.focusDown) , ("M-k", windows W.focusUp) , ("M-S-j", windows W.swapDown) , ("M-S-k", windows W.swapUp) , ("M-m", selectWorkspace alexXPConfig) , ("M-S-m", withWorkspace alexXPConfig (windows . W.shift)) , ("M-S-", removeWorkspace) , ("M-h", sendMessage Shrink) , ("M-l", sendMessage Expand) -- sink / sinkAll , ("M-t", withFocused $ windows . W.sink) , ("M-S-t", sinkAll) , ("M-z", namedScratchpadAction scratchpads "hotot") , ("M5-l", namedScratchpadAction scratchpads "log") , ("M-,", sendMessage (IncMasterN 1)) , ("M-.", sendMessage (IncMasterN (-1))) , ("M-b", sendMessage ToggleStruts) , ("M-i", spawn "xprop | gxmessage -file -") , ("M-", moveTo Prev $ WSIs notNspHiddenWS) , ("M-", moveTo Next $ WSIs notNspHiddenWS) , ("M-d", spawn "fbsetroot -solid black") , ("M-f", spawn "fbsetroot -l") , ("M-^", focusUrgent) , ("M-p", myShellPrompt alexXPConfig) , ("M-e", launchApp alexXPConfig "emacsclient" >> (windows (W.greedyView "5:code"))) , ("M-o M-k", passPrompt alexXPConfig) , ("M-o M-S-k", passGeneratePrompt alexXPConfig) , ("M-o M-m", manPrompt alexXPConfig) , ("M-o M-b", safePrompt browser alexXPConfig) , ("M-o M-s", sshPrompt alexXPConfig) , ("M-o M-x", xmonadPrompt alexXPConfig) , ("M-+", sendMessage Mag.MagnifyMore) , ("M-S-+", sendMessage Mag.MagnifyLess) , ("M-#", sendMessage Mag.Toggle) -- topics ,("M-s" , promptedGoto) ,("M-S-s", promptedShift) -- multimedia keys , ("", spawn "amixer -c0 -- set Master playback 2dB-") , ("", spawn "amixer -c0 -- set Master playback 2dB+") , ("", spawn "amixer -q -c0 set Master toggle") -- Screenshot , ("", spawn "scrot '%Y-%m-%d_%s_$wx$h.png' -e 'mv $f ~/images/screenshot/; pqiv ~/images/screenshot/$n'") ] ++ [ -- switch to / move to topic ("M-" ++ m ++ [k], a i) | (a, m) <- [(switchNthLastFocused topicsConfig,""), (shiftNthLastFocused, "S-")] , (i, k) <- zip [1..] "123456789" ] where shutdownKey = case hostname of "Australien" -> "M-S-q" _ -> "M-M5-q" myMouse modm c = [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w)) , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMouseResize 0.8 (Just 50) (Just 50) w)) , ((modm, button3), (\w -> focus w >> Flex.mouseWindow Flex.resize w)) ] --}}} --{{{ Layout myLayout = avoidStruts $ smartBorders $ Mag.magnifierOff $ trackFloating $ onWorkspace "2:mail" layoutsTabbed $ onWorkspace "4:im" (imgrid ||| imtab ||| immosaic) $ onWorkspace "5:code" layoutsTabbed $ onWorkspace "video" (noBorders myTabbed) $ onWorkspace "gimp" gimp $ layouts where layouts = tiled ||| Mirror tiled ||| ThreeColMid 1 (3/100) (1/2) ||| myTabbed layoutsTabbed = myTabbed ||| tiled ||| Mirror tiled ||| ThreeColMid 1 (3/100) (1/2) tiled = Tall 1 (3/100) (1/2) gimp = named "gimp" $ withIM (0.11) (Role "gimp-toolbox") $ reflectHoriz $ withIM (0.15) (Role "gimp-dock") (trackFloating myTabbed) imbase a = withIM (1%7) (Or (ClassName "Tkabber") (Role "roster")) a imgrid = imbase Grid imtab = imbase myTabbed immosaic = imbase $ MosaicAlt M.empty myTabbed = named "Tabbed" $ tabbedBottom shrinkText alexTheme --}}}