path: root/xmonad.hs

import System.IO
import System.Directory
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

-- taffybar
import System.Taffybar.Hooks.PagerHints (pagerHints)

-- --replace handling
import XMonad.Util.Replace (replace)
import Control.Monad (when)
import System.Environment (getArgs)

-- custom modules
import HistoryGrid
import EZConfig
import Pass

font :: String
font = "xft:Hack:size=10"

term :: String
term = "urxvt"

browser :: String
browser = "browser"

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

modM = mod4Mask -- mod1Mask = Alt, mod2Mask = , mod3Mask= , mod4Mask = Win, mod5Mask = AltGr

myDzenUrgencyConfig = DzenUrgencyHook
        { args = ["-bg", "red", "-fg", "black", "-fn", font,
                  "-w", "600", "-ta", "c", "-x", "520", "-y", "10",
                  "-h", "30" ]
        , duration = seconds 5
        }

main = do
  args <- getArgs
  when ("--replace" `elem` args) replace

  dzenStatusDir <- getAppUserDataDirectory "xmonad"
  dzenStatusFile <- openFile (dzenStatusDir ++ "/dzenStatus") WriteMode
  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.
    $ pagerHints
    $ withUrgencyHook myDzenUrgencyConfig
    $ myConfig dzenStatusFile

myConfig statusFile = defaultConfig
        { modMask = modM
        , terminal = term
        , borderWidth = 1
        , normalBorderColor  = "#545454"
        , focusedBorderColor = "#A00000"
        , logHook = myLogHook statusFile
        , manageHook = myManageHook
        , keys = \c -> mkKeymap c $ myKeys c
        , mouseBindings = \c -> M.union (M.fromList $ myMouse 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 = 19
        }

historyGridConfig = defaultGSConfig
        { gs_cellheight = 50
        , gs_cellwidth = 300
        , gs_navigate = navNSearch
        , gs_font = font
        }

--
-- 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 =
  [ ([ (xprop, any (app `op`))], pmP (W.shift target)) | (xprop, op, app, target) <- myShifts] ++
  [ ([ (xprop, any (app ==))], pmX (float)) | (xprop, app) <- myFloats]
  where
    myFloats =
      [ (wM_CLASS, "vlc")
      , (wM_CLASS, "Xmessage")
      , (wM_CLASS, "XVkbd")
      , (wM_CLASS, "Xdialog")
      , (wM_CLASS, "Pinentry")
      , (wM_CLASS, "Pinentry-gtk-2")
      , (wM_CLASS, "Tiemu")
      , (wM_CLASS, "ultrastardx")
      , (wM_CLASS, "Ediff")
      , (wM_CLASS, "xtensoftphone")
      , (wM_CLASS, "Pqiv")
      , (wM_CLASS, "XNots")
      , (wM_CLASS, "TeamViewer.exe")
      , (wM_CLASS, "AmsnWebcam")
      , (wM_NAME, "glxgears")
      , (wM_NAME, "Passphrase Required")
      , (wM_NAME, "Mark all as read")
      , (wM_NAME, "Xplanet 1.2.0")
      , (wM_NAME, "Eclipse")
      ]

    myShifts =
      [ (wM_CLASS, (==), "Opera", "1:web")
      , (wM_CLASS, (==), "Chrome", "1:web")
      , (wM_CLASS, (==), "Chromium-browser", "1:web")
      , (wM_CLASS, (==), "Firefox-bin", "1:web")

      , (wM_CLASS, (==), "Claws-mail", "2:mail")
      , (wM_CLASS, (==), "Mitter", "2:mail")
      , (wM_CLASS, (==), "wanderlust", "2:mail")
      , (wM_NAME, (==), "newsbeuter", "2:mail")

      , (wM_CLASS, (==), "Hexchat", "3:irc")

        -- tkabber roater
      , (wM_CLASS, (==), "Tkabber", "4:im")
        -- tkabber single messages
      , (wM_CLASS, (==), "headlines", "4:im")
      , (wM_CLASS, isPrefixOf, "chat_##xmpp##1_zedatconferencejabberfuberlinde", "4:im")
      , (wM_CLASS, isPrefixOf, "chat_##xmpp##1_mailanimuxdeSyslogBot", "4:im")

      , (wM_CLASS, (==), "emacs", "5:code")

      , (wM_CLASS, (==), "MPlayer", "video")
      , (wM_CLASS, (==), "Amarokapp", "music")
      ]

--
-- Keys
--
myKeys c =
  -- this line is critical to reload config - DON'T REMOVE
  [ ("M-q", broadcastMessage ReleaseResources >> restart "xmonad" True)

  , ("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 P.defaultXPConfig)
  , ("M-S-m", withWorkspace P.defaultXPConfig (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 P.defaultXPConfig)
  , ("M-e", launchApp P.defaultXPConfig "emacsclient" >> (windows (W.greedyView "5:code")))

  , ("M-o M-k", passPrompt P.defaultXPConfig)
  , ("M-o M-S-k", passGeneratePrompt P.defaultXPConfig)
  , ("M-o M-m", manPrompt P.defaultXPConfig)
  , ("M-o M-b", safePrompt browser P.defaultXPConfig)
  , ("M-o M-s", sshPrompt P.defaultXPConfig)
  , ("M-o M-x", xmonadPrompt P.defaultXPConfig)

  , ("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)]
  ]

myMouse 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