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 Data.Monoid 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, mapMaybe, listToMaybe) 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 $ def { 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 def 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", "misc"] 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", "./") , ("xmonad", ".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") , ("video" , return ()) , ("music" , spawnHere "guayadeque") , ("zedat" , spawnHere $ term ++ " -e is") , ("spline" , spawnHere $ term ++ " -e ssh fob") , ("emacs" , spawnHere "emacs") , ("gimp" , spawnHere "gimp") , ("misc" , return ()) ] } where spawnShell = currentTopicDir topicsConfig >>= spawnShellIn spawnShellIn dir = spawnHere $ "in-dir " ++ dir ++ " " ++ term topicsGrid = withWindowSet $ \w -> do let wss = filter (\w -> W.tag w /= "NSP") $ W.workspaces w topicMap = map (\t -> (W.tag t, t)) wss newTopics = filter (\used -> ((W.tag used) `notElem` topics)) wss sortedTopics = mapMaybe (\name -> lookup name topicMap) topics gridselect topicsGridConfig $ map (\t -> (W.tag t, t)) $ sortedTopics ++ newTopics promptedGoto = do topic <- topicsGrid whenJust topic (switchTopic topicsConfig . W.tag) promptedShift = do topic <- topicsGrid whenJust topic $ (\y -> windows (W.greedyView y . W.shift y)) . W.tag --}}} --{{{ 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 $ def { 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 = def { inactiveBorderColor = "#545454" , activeBorderColor = "#6E0000" , activeColor = "#6E0000" , inactiveColor = "#424242" , inactiveTextColor = "#ffffff" , activeTextColor = "#ffffff" , fontName = font , decoHeight = 19 } alexXPConfig :: XPConfig alexXPConfig = def { P.font = font , P.height = 20 , P.historyFilter = P.deleteAllDuplicates } historyGridConfig :: GSConfig String historyGridConfig = def { gs_cellheight = 50 , gs_cellwidth = 300 , gs_navigate = navNSearch , gs_font = font } topicsColorizer :: W.Workspace tag layout stack -> Bool -> X (String, String) topicsColorizer topic selected | empty && selected = return ("#f4f6f6", "#002b36") | selected = return ("#839596", "#002b36") | empty = return ("#001014", "#839496") | otherwise = return ("#002b36", "#ffffff") where empty = null $ W.integrate' $ W.stack topic topicsGridConfig :: GSConfig (W.Workspace tag layout stack) topicsGridConfig = def { gs_navigate = navNSearch , gs_font = font , gs_colorizer = topicsColorizer } confirmConfig :: GSConfig Bool confirmConfig = def { 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 otherOutput <- dynamicLogString ppWithoutTopics io $ ppOutput pp (topicOutput ++ otherOutput) where pp = myPP statusFile ppWithDepth ws = pp { ppHidden = addDepth ws ppHidden , ppVisible = addDepth ws ppVisible , ppUrgent = addDepth ws ppUrgent } ppWithoutTopics = pp { ppVisible = \_ -> "" , ppCurrent = \_ -> "" , ppUrgent = \_ -> "" , ppHidden = \_ -> "" } isEmpty = isNothing . W.stack emptyTopics winset = map W.tag $ filter isEmpty $ W.workspaces winset isVisible winset topic = topic /= "NSP" && (notElem topic $ emptyTopics winset) topicWithDepth topic = ((topic ++ ":") ++) . show getDepth ws topic = fromJust $ elemIndex topic $ ws ++ [topic] addDepth ws proj topic = proj pp $ topicWithDepth topic $ getDepth ws topic sortTopics ws = take (maxTopicHistory topicsConfig) . sortBy (comparing $ (getDepth ws) . W.tag) . namedScratchpadFilterOutWorkspace lastTopics = do winset <- gets windowset urgents <- readUrgents setLastFocusedTopic (W.tag . W.workspace . W.current $ winset) (isVisible winset) lastWs <- getLastFocusedTopics return $ pprWindowSet (sortTopics lastWs) urgents (ppWithDepth lastWs) winset myEventHook = ewmhDesktopsEventHook <+> serverModeEventHook <+> focusOnMouseMove <+> docksEventHook <+> updateWindowTitle where updateWindowTitle PropertyEvent { ev_window = _, ev_atom = a, ev_propstate = ps } = do pa <- mapM getAtom ["WM_NAME", "_NET_WM_NAME"] when (a `elem` pa && ps == propertyNewValue) $ do ask >>= logHook . config return (All True) updateWindowTitle _ = return (All True) myStartupHook = do ewmhDesktopsStartup adjustEventInput setWMName "LG3D" myManageHook = namedScratchpadManageHook scratchpads <+> manageSpawn <+> 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 "fbsetbg -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) ,("M-a" , currentTopicAction topicsConfig) -- 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" -- Like X.A.TopicSpace.switchNthLastFocused but defaults to do nothing -- if depth is too big and not to switch to the default topic. switchNthLastFocused :: TopicConfig -> Int -> X () switchNthLastFocused tg depth = do ws <- fmap (listToMaybe . drop depth) getLastFocusedTopics whenJust ws $ switchTopic tg 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 "mail" layoutsTabbed $ onWorkspace "im" (imgrid ||| imtab ||| immosaic) $ onWorkspace "emacs" 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 (Or (ClassName "Tkabber") (Role "roster")) (And (ClassName "Vacuum") (Role "MainWindow"))) a imgrid = imbase Grid imtab = imbase myTabbed immosaic = imbase $ MosaicAlt M.empty myTabbed = named "Tabbed" $ tabbedBottom shrinkText alexTheme --}}}