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.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)

-- 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 = "-*-terminus-medium-r-normal-*-12-*-*-*-*-*-*-*"

term :: String
term = "urxvt"

browser :: String
browser = "viewurl-opera.sh"

myWorkspaces :: [String]
myWorkspaces = ["1:web", "2:mail" ,"3:irc", "4:im", "5:code"] ++ map show [6 .. 9 :: Int] ++ ["0", "video", "music"]

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", "480", "-ta", "c", "-x", "480"]
        , duration = seconds 5
        }

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
    $ myConfig dzenStatusFile hostname

myConfig statusFile hostname = defaultConfig
        { modMask = modM hostname
        , terminal = term
        , borderWidth = 1
        , normalBorderColor  = "#545454"
        , focusedBorderColor = "#A00000"
        , logHook = myLogHook statusFile
        , 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 = myWorkspaces
        , handleEventHook = myEventHook
        , startupHook = myStartupHook
        }

--
-- 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)
  ]

hiddenWS :: X (WindowSpace -> Bool)
hiddenWS = do hs <- gets (map W.tag . W.hidden . windowset)
              return (\w -> W.tag w `elem` hs)

notNspWS :: X (WindowSpace -> Bool)
notNspWS = return $ ("NSP" /=) . W.tag

notNspHiddenWS :: X (WindowSpace -> Bool)
notNspHiddenWS = do nn <- notNspWS
                    hi <- hiddenWS
                    return (\w -> hi w && nn w)


--
-- 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 = 15
        }

alexXPConfig :: XPConfig
alexXPConfig = P.defaultXPConfig
        { P.font = font
        }

historyGridConfig = defaultGSConfig
        { gs_cellheight = 50
        , gs_cellwidth = 300
        , gs_navigate = navNSearch
        , gs_font = "xft:Droid Sans Mono Slashed-8"
        }

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
  dynamicLogWithPP $ myPP statusFile

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 = [ ("1:web",  [(wM_CLASS, anyOf ["Opera", "Chrome", "Google-chrome", "Chromium-browser",
                                             "Firefox-bin"])])
             , ("2:mail", [(wM_CLASS, anyOf ["Claws-mail", "Evolution", "Mitter", "wanderlust"])])
             , ("2:mail", [(wM_NAME,  anyOf ["newsbeuter"])])
             , ("3:irc",  [(wM_CLASS, anyOf ["Hexchat"])])
             , ("4:im",   [(wM_CLASS, anyOf ["TKabber", "headlines", "Vacuum"])])

               -- tkabber single messages
             , ("4:im",   [(wM_CLASS, anyOf' isPrefixOf ["chat_##xmpp##1_zedatconferencejabberfuberlinde",
                                                         "chat_##xmpp##1_mailanimuxdeSyslogBot"])])

             , ("5: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-^", viewEmptyWorkspace)
  , ("M-S-^", tagToEmptyWorkspace)

  , ("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-g", goToSelected defaultGSConfig)
  , ("M-S-g", bringSelected defaultGSConfig)

  , ("M-<Escape>", focusUrgent)

  , ("M-+", sendMessage Mag.MagnifyMore)
  , ("M-S-+", sendMessage Mag.MagnifyLess)
  , ("M-#", sendMessage Mag.Toggle)

    -- 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 / copy to workspace
  [
    (m ++ k, windows $ f i)
        | (i, k) <- zip myWorkspaces $ [[k] | k <- "1234567890"] ++ ["<ssharp>", "<acute>"],
          (m, f) <- [("M-", W.view), ("M-S-", W.shift), ("M-C-", copy)]
  ]
  ++

  [
    (m ++ k, screenWorkspace s >>= flip whenJust (windows . f))
        | (k, s) <- [("a", 0), ("s", 1)],
          (m, f) <- [("M-", W.view), ("M-S-", W.shift), ("M-C-", copy)]
  ]
  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 tabbed)
  $ onWorkspace "gimp" gimp
  $ layouts
  where
    layouts = tiled ||| Mirror tiled ||| ThreeColMid 1 (3/100) (1/2) ||| tabbed
    layoutsTabbed = tabbed ||| 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 tabbed)
    tabbed = named "Tabbed"
             $ tabbedBottom shrinkText alexTheme
    imbase a = withIM (1%7) (Or (ClassName "Tkabber") (Role "roster")) a
    imgrid = imbase Grid
    imtab = imbase tabbed
    immosaic = imbase $ MosaicAlt M.empty