path: root/xmonad.hs

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 :: HasColorizer a => GSConfig a
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-<Return>", spawn term)
  , ("M-<Return>", 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-<Space>", sendMessage NextLayout)
  , ("M-S-<Space>", setLayout $ XMonad.layoutHook c)

  , ("M-<Tab>", windows W.focusDown)
  , ("M-S-<Tab>", 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-<Backspace>", 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-<Left>", moveTo Prev $ WSIs notNspHiddenWS)
  , ("M-<Right>", 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
  , ("<XF86AudioLowerVolume>", spawn "amixer -c0 -- set Master playback 2dB-")
  , ("<XF86AudioRaiseVolume>", spawn "amixer -c0 -- set Master playback 2dB+")
  , ("<XF86AudioMute>", spawn "amixer -q -c0 set Master toggle")

    -- Screenshot
  , ("<Print>", 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 (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

--}}}