Initial commit

Signed-off-by: Michal Minar <miminar@redhat.com>

5 files changed, 1182 insertions, 0 deletions

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..b2653c0
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2013,2014 Peter Jones <pjones@pmade.com>
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Peter Jones nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..517759a
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,64 @@
+################################################################################
+ARCH             := $(shell uname -m)
+OS               := $(shell uname -s | tr '[A-Z]' '[a-z]')
+TARGET           := $(HOME)/.xmonad/xmonad-$(ARCH)-$(OS)
+SRC              := $(shell find . -type f -name '*.hs')
+CABAL_BIN        ?= $(shell which $(CABAL_BIN))
+SANDBOX          := cabal.sandbox.config
+XMINAD           := dist/build/xminad/xminad
+CABAL_FLAGS      := --enable-optimization=2
+CABAL_ADD_SOURCE ?=
+DO_CHECK         ?= NO
+XMONAD           ?= $(shell which xmonad)
+DISPLAY          ?= :0
+
+################################################################################
+.PHONEY: all install restart clean realclean
+
+################################################################################
+all: $(XMINAD)
+
+################################################################################
+install: $(TARGET)
+
+################################################################################
+restart: install
+	export DISPLAY=$(DISPLAY)
+	$(XMONAD) --restart
+
+################################################################################
+clean:
+	rm -rf dist $(XMINAD) $(CHECK) $(SANDBOX)
+
+################################################################################
+realclean:
+	rm -rf .cabal-sandbox
+
+################################################################################
+ifeq ($(DO_CHECK),YES)
+  CHECK = dist/build/checkrc/checkrc
+else
+  CHECK = :
+endif
+
+################################################################################
+$(XMINAD): $(SRC) $(SANDBOX)
+	ghc -V
+	$(CABAL_BIN) build
+	$(CHECK)
+
+################################################################################
+$(SANDBOX):
+	$(CABAL_BIN) sandbox init
+	$(if $(CABAL_ADD_SOURCE),$(CABAL_BIN) sandbox add-source $(CABAL_ADD_SOURCE),)
+	$(CABAL_BIN) install $(CABAL_FLAGS) xmonad-extras -fwith_mpd -f-with_hint
+	$(CABAL_BIN) install --only-dependencies $(CABAL_FLAGS)
+	$(CABAL_BIN) configure $(CABAL_FLAGS)
+	touch $@
+
+################################################################################
+$(TARGET): $(XMINAD)
+	mkdir -p $(dir $@)
+	if [ -r $@ ]; then mv $@ $@.prev; fi
+	cp -p $< $@
+	cd $(dir $@) && ln -nfs $(notdir $@) xminad
diff --git a/src/XMonad/Layout/TopicDir.hs b/src/XMonad/Layout/TopicDir.hs
new file mode 100644
index 0000000..e1af18e
--- /dev/null
+++ b/src/XMonad/Layout/TopicDir.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}
+
+module XMonad.Layout.TopicDir (
+    -- * Usage
+    -- $usage
+    topicDir,
+    changeDir,
+    TopicDir,
+    ) where
+
+import qualified Data.Map as M
+import Control.Exception
+import System.Directory (setCurrentDirectory, getCurrentDirectory)
+
+import XMonad hiding (focus)
+import XMonad.Util.Run (runProcessWithInput)
+import XMonad.Prompt (XPConfig)
+import XMonad.Prompt.Directory (directoryPrompt)
+import XMonad.Layout.LayoutModifier
+import XMonad.StackSet (tag, currentTag)
+
+econst :: Monad m => a -> IOException -> m a
+econst = const . return
+
+data Chdir = Chdir String deriving ( Typeable )
+instance Message Chdir
+
+data TopicDir a = TopicDir (M.Map WorkspaceId String, String)
+   deriving (Read, Show)
+
+instance LayoutModifier TopicDir Window where
+    modifyLayout (TopicDir (tds, d)) w r = do
+         tc <- gets (currentTag.windowset)
+         case mdir tc of
+            (Just dir) -> scd dir
+            Nothing    -> return ()
+         runLayout w r
+      where
+        mdir :: WorkspaceId -> Maybe String
+        mdir tc | tc == tag w && d == "" = M.lookup tc tds
+                | tc == tag w            = Just d
+                | otherwise              = Nothing
+
+
+    handleMess (TopicDir (dds, _)) m
+        | Just (Chdir wd) <- fromMessage m = do
+            wd' <- cleanDir wd
+            return $ Just $ TopicDir (dds, wd')
+        | otherwise = return Nothing
+
+topicDir :: LayoutClass l a => M.Map WorkspaceId String
+             -> l a -> ModifiedLayout TopicDir l a
+topicDir m = ModifiedLayout (TopicDir (m, ""))
+
+cleanDir :: String -> X String
+cleanDir x = scd x >> io getCurrentDirectory
+
+scd :: String -> X ()
+scd x = do
+    x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` econst x)
+    catchIO $ setCurrentDirectory x'
+
+changeDir :: XPConfig -> X ()
+changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)
+
diff --git a/xminad.cabal b/xminad.cabal
new file mode 100644
index 0000000..c01de61
--- /dev/null
+++ b/xminad.cabal
@@ -0,0 +1,57 @@
+Name:          xminad
+Version:       0.1
+Author:        Michal Minar <mic.liamg@gmail.com>
+Maintainer:    Michal Minar <mic.liamg@gmail.com>
+License:       BSD3
+License-File:  LICENSE
+Category:      Graphics
+Stability:     experimental
+Build-Type:    Simple
+Cabal-Version: >= 1.8
+
+Library
+    Exposed-Modules: 
+        XMonad.Layout.TopicDir
+
+    HS-Source-Dirs: src
+    GHC-Options: -Wall -Werror
+
+    Build-Depends:
+         base           >= 4.0  && < 5.0
+       --, X11            >= 1.6  && < 2.0
+       --, bytestring     >= 0.9  && < 0.11
+       -- , cairo          >= 0.13 && < 0.14
+       , containers
+       , directory      >= 1.1  && < 1.3
+       --, filepath       >= 1.3  && < 1.4
+       --, libmpd         >= 0.8  && < 1.0
+       --, parsec         >= 3.1  && < 3.2
+       --, regex-compat   >= 0.90 && < 1.0
+       --, text           >= 0.11 && < 1.3
+       , xmonad         >= 0.11 && < 0.12
+       , xmonad-contrib >= 0.11
+       --, xmonad-extras  >= 0.11 && < 0.12
+
+Executable xminad
+    Main-Is: xminad.hs
+    GHC-Options: -Wall -Werror
+    Build-Depends :
+         base           >= 4.0  && < 5.0
+       , dbus           >= 0.10 && < 0.12
+       --, bytestring     >= 0.9  && < 0.11
+       -- , cairo          >= 0.13 && < 0.14
+       , containers
+       --, directory      >= 1.1  && < 1.3
+       --, filepath       >= 1.3  && < 1.4
+       , libmpd         >= 0.8  && < 1.0
+       --, parsec         >= 3.1  && < 3.2
+       , MissingH       >= 1.0  && < 1.3
+       , regex-compat   >= 0.90 && < 1.0
+       , regex-posix    >= 0.90 && < 1.0
+       , text           >= 0.11 && < 1.3
+       , utf8-string    >= 0.3  && < 0.5
+       , X11            >= 1.6  && < 2.0
+       , xminad
+       , xmonad         >= 0.11 && < 0.12
+       , xmonad-contrib >= 0.11
+       , xmonad-extras  >= 0.11 && < 0.12
diff --git a/xminad.hs b/xminad.hs
new file mode 100644
index 0000000..8a2402d
--- /dev/null
+++ b/xminad.hs
@@ -0,0 +1,966 @@
+{-# LANGUAGE NoMonomorphismRestriction, DoAndIfThenElse #-}
+{-# OPTIONS -fno-warn-missing-signatures #-}
+
+import qualified Codec.Binary.UTF8.String as UTF8
+--import Control.Exception
+import Control.Monad
+import Data.Either.Utils
+import qualified Data.Map as M
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Ratio ((%))
+import Data.String.Utils (startswith)
+import qualified Data.Set as S
+import qualified DBus as D
+import qualified DBus.Client as D
+import qualified Network.MPD as MPD
+import qualified Network.MPD.Commands.Extensions as MPD
+import Text.Regex
+import Text.Regex.Posix
+--import System.Exit
+--import System.IO
+
+import XMonad
+import XMonad.Actions.CycleWS
+import XMonad.Actions.GridSelect as GS
+import XMonad.Actions.Volume
+--import XMonad.Actions.UpdateFocus
+import qualified XMonad.Actions.DwmPromote as DwmP
+import qualified XMonad.Actions.DynamicWorkspaces as DW
+import qualified XMonad.Actions.FlexibleResize as FlexR
+import qualified XMonad.Actions.Submap as SUB
+import qualified XMonad.Actions.TopicSpace as TS
+import qualified XMonad.Actions.UpdatePointer as UP
+import qualified XMonad.Actions.WithAll as WithAll
+import XMonad.Config.Desktop
+import XMonad.Hooks.CurrentWorkspaceOnTop
+import XMonad.Hooks.DynamicLog as DL
+import XMonad.Hooks.EwmhDesktops
+import XMonad.Hooks.FadeWindows
+import XMonad.Hooks.SetWMName
+import XMonad.Hooks.UrgencyHook
+import XMonad.Layout.Accordion
+import qualified XMonad.Layout.BoringWindows as BW
+import XMonad.Layout.Column
+import qualified XMonad.Layout.ComboP as CP
+import qualified XMonad.Layout.IM as IM
+import XMonad.Layout.Minimize
+import qualified XMonad.Layout.MouseResizableTile as MRT
+import qualified XMonad.Layout.MultiToggle as MT
+import qualified XMonad.Layout.Named as LN
+import XMonad.Layout.NoBorders
+import qualified XMonad.Layout.PerWorkspace as PW
+import XMonad.Layout.Reflect
+import XMonad.Layout.SimpleFloat
+import XMonad.Layout.Simplest (Simplest(..))
+import XMonad.Layout.StackTile
+import XMonad.Layout.SubLayouts
+import qualified XMonad.Layout.Tabbed as Tab
+import XMonad.Layout.ThreeColumns
+import XMonad.Layout.ToggleLayouts
+import XMonad.Layout.TwoPane
+import XMonad.Layout.WindowNavigation
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import qualified XMonad.Prompt as P
+import qualified XMonad.Prompt.Shell as Shell
+import qualified XMonad.Prompt.Input as PI
+import qualified XMonad.Prompt.Ssh as PSsh
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.EZConfig as EZ
+import XMonad.Util.NamedScratchpad as NS
+--import XMonad.Util.Run
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+
+-- my modules *****************************************************************
+import qualified XMonad.Layout.TopicDir as TD
+
+myModMask :: KeyMask
+myModMask = mod4Mask
+modm :: String
+modm = "M4"
+myTerminal :: String
+myTerminal = "mate-terminal"
+myExplorer :: String
+myExplorer = "caja"
+
+spawnShell :: Maybe String -> X()
+spawnShell = spawnShellIn ""
+
+spawnShellIn :: TS.Dir -> Maybe String -> X()
+spawnShellIn dir command = do
+    t <- asks (terminal . config)
+    spawn $ cmd' t
+  where
+    run (Just c) = " -e '" ++ c ++ "'"
+    run Nothing    = ""
+
+    cmd' t | dir == "" = t ++ run command
+           | otherwise = "cd " ++ dir ++ " && " ++ t ++ run command
+
+spawnExplorer :: MonadIO m => m ()
+spawnExplorer = spawn myExplorer
+
+doNotFadeOutWindows :: Query Bool
+doNotFadeOutWindows =
+    className =? "xine" <||>
+    className =? "MPlayer" <||>
+    className =? "Smplayer" <||>
+    className =? "Vlc" <||>
+    className =? "Firefox" <||>
+    className =? "Opera" <||>
+    className =? "Shiretoko" <||>
+    className =? "VirtualBox" <||>
+    className =? "Namoroka" <||>
+    className =? "Navigator" <||>
+    className =? "Chromium" <||>
+    className =? "Google-chrome" <||>
+    className =? "Civ5XP" <||>
+    className =? "BaldursGate" <||>
+    title     =? "VLC (XVideo output)"
+
+myNamedScratchpads :: [NamedScratchpad]
+myNamedScratchpads =
+        [ NS "htop" (myTerminal ++ " -t htop -e htop") (title =? "htop")
+            cTopFloat
+        , NS "stardict" "stardict" (className =? "Stardict") cFloating
+        , NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes")
+            cFloating
+        , NS "charmap" "charmap" (className =? "Gucharmap") cFloating
+        , NS "alarm" "alarm-clock-applet"
+             (className =? "Alarm-clock-applet") cFloating
+        , NS "calculator" (myTerminal ++ " -e python --title PCalculator")
+                           (title =? "PCalculator") cFloating
+        , NS "volctl" "mate-volume-control" (className =? "Mate-volume-control") cFloating
+        , NS "guake" (myTerminal ++ " --window-with-profile=Guake-normal --tab-with-profile=Guake-root")
+             (className =? "Mate-terminal" <&&> (startsWith title "Guake")) cBottomFloat 
+        ]
+    where
+        role = stringProperty "WM_WINDOW_ROLE"
+        cFloating = customFloating $ W.RationalRect (1/3) (1/9) (1/3) (1/3)
+        cTopFloat = customFloating $ W.RationalRect (1/5) (1/32) (3/5) (1/2)
+        cBottomFloat = customFloating $ W.RationalRect (1/5) (5/8) (3/5) (3/8)
+        startsWith q x = fmap (startswith x) q
+
+myXPConfig :: P.XPConfig
+myXPConfig = P.defaultXPConfig
+    { P.fgColor = "#dfdfdf"
+    , P.bgColor = "#3c3c3c"
+    , P.fgHLight = "#ffffff"
+    , P.bgHLight = "#3c3c3c"
+    , P.font    = "-*-terminus-*-*-*-*-14-*-*-*-*-*-*-*"
+    , P.height  = 24
+    }
+
+myTabTheme :: Tab.Theme
+myTabTheme = Tab.defaultTheme
+    { Tab.activeTextColor = "#ffffff"
+    , Tab.activeBorderColor = "#FBAB2E"
+    , Tab.activeColor = "#3c3c3c"
+    , Tab.inactiveTextColor = "#c0c0c0"
+    , Tab.inactiveBorderColor = "#c0c0c0"
+    , Tab.inactiveColor = "#3c3c3c"
+    , Tab.urgentTextColor = "#ff0000"
+    , Tab.urgentBorderColor = "#ff0000"
+    , Tab.urgentColor = "#000000"
+    , Tab.fontName = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*"
+    , Tab.decoHeight = 24
+    }
+
+myTopicDirs :: M.Map WorkspaceId String
+myTopicDirs = M.fromList $
+    [ ("dashboard"   , "~")
+    , ("xmonad"      , "~/.xmonad")
+    , ("video"       , "~/Documents/movies")
+    , ("docs"        , "~/Documents/doc")
+    , ("pdf"         , "~/Documents")
+    , ("graphics"    , "~")
+    , ("gimp"        , "~")
+    , ("eclipse"     , "~/workspace")
+    , ("yawn"        , "~/workspace/rh/pywbem-yawn")
+    , ("openlmi"     , "~/workspace/rh/openlmi-providers")
+    , ("cim"         , "/usr/share/mof/cim-current")
+    , ("hwdata"      , "~/workspace/rh/hwdata")
+    , ("hdparm"      , "~/fedora-scm/hdparm")
+    , ("providers"   , "~/workspace/rh/openlmi-providers")
+    , ("scripts"     , "~/workspace/rh/openlmi-scripts")
+    , ("tools"       , "~/workspace/rh/openlmi-tools")
+    , ("rhel"        , "~/rhel-scm")
+    , ("fedora"      , "~/fedora-scm")
+    , ("docker"      , "~/workspace/rh/docker")
+    , ("distribution", "~/workspace/rh/distribution")
+    , ("ae"          , "~/workspace/rh/atomic-enterprise")
+    , ("aet"         , "~/workspace/rh/atomic-enterprise-training")
+    , ("aea"         , "~/workspace/rh/atomic-enterprise-ansible")
+    , ("aes"         , "~/workspace/rh/ae-scripts")
+    ] ++ map (\w -> (w, "~"))
+    [ "music", "p2p", "gimp", "graphics"
+    , "web", "remote", "earth", "bank", "admin", "ebook"
+    , "ciV", "scrum", "BG"]
+
+myTopicConfig :: TS.TopicConfig
+myTopicConfig = TS.defaultTopicConfig
+    { TS.topicDirs = myTopicDirs
+    , TS.topicActions = M.fromList $
+        [ ("music", spawn "gmpc")
+        -- ("music", spawn $ myTerminal ++ " -depth 32 -bg rgba:0000/0000/0000/7777 -fg white -e ncmpcpp")
+        , ("mail", spawn "thunderbird")
+        , ("web", spawn "google-chrome")
+        , ("firefox", spawn "firefox")
+        , ("opera", spawn "opera")
+        , ("pdf", spawn "atril")
+        , ("chat", spawn "xchat" >> spawn "pidgin")
+        , ("admin", spawnShell Nothing >> spawnShell Nothing)
+        , ("virt", spawn "virt-manager")
+        , ("vbox", spawn "VirtualBox")
+        , ("gimp", spawn "gimp")
+        , ("eclipse", spawn "eclipse")
+        , ("ebook", spawn "calibre")
+        , ("video", spawn "vlc")
+        , ("xmonad", spawnShell (Just "vim -S xmonad.vim") >>
+              spawnShell Nothing)
+        , ("remote", spawnShell Nothing >> spawnShell Nothing)
+        , ("devel", spawnShell Nothing >> spawnShell Nothing)
+        , ("openlmi",   spawnShell Nothing >> spawnShell Nothing)
+        , ("providers", spawnShell Nothing >> spawnShell Nothing)
+        , ("cim", spawnShell Nothing >>
+              spawnShellIn "/usr/lib/python2.7/site-packages/pywbem" Nothing)
+        , ("bank", spawn "google-chrome https://www.mojebanka.cz/InternetBanking/")
+        , ("p2p", spawn "deluge-gtk")
+        , ("hwdata",
+              spawnShell Nothing >>
+              spawnShellIn "~/fedora-scm/hwdata" Nothing >>
+              spawnShellIn "~/rhel-scm/hwdata" Nothing)
+        , ("hdparm", spawnShell Nothing >>
+              spawnShellIn "~/fedora-scm/hdparm" Nothing >>
+              spawnShellIn "~/rhel-scm/hdparm" Nothing)
+        , ("docker", spawnShell Nothing >> spawnShell Nothing >>
+                spawnShellIn "~/workspace/go/docker" (Just "bash --rcfile .bashrc"))
+        , ("distribution", spawnShell Nothing >> spawnShell Nothing >>
+                spawnShellIn "~/workspace/go/distribution" (Just "bash --rcfile .bashrc"))
+        , ("scripts", spawnShell Nothing >> spawnShell Nothing)
+        , ("ciV", spawn "launch-ciV.sh -m -b")
+        , ("scrum", spawn "firefox https://bluejeans.com/3046463974/")
+        , ("BG", spawn "steam steam://rungameid/228280" >>
+              spawn "firefox http://slovnik.seznam.cz/de-cz/")
+        ] ++ map (\w -> (w, spawnShell Nothing >> spawnShell Nothing))
+        [ "ae", "aet", "aes", "aea" ]
+    , TS.defaultTopicAction = const $ return ()
+    , TS.defaultTopic = "dashboard"
+    }
+
+myWorkspaces :: [WorkspaceId]
+myWorkspaces = ["dashboard", "devel"]
+
+myGSConfig :: HasColorizer a => GSConfig a
+myGSConfig = GS.defaultGSConfig
+    { gs_cellheight = 40
+    , gs_cellwidth = 100
+    , gs_navigate = navigation'
+    }
+  where
+    navigation' :: TwoD a (Maybe a)
+    navigation' = GS.makeXEventhandler
+                $ GS.shadowWithKeymap navKeyMap navHandler
+
+    navKeyMap = M.fromList (allowModifs modifs
+          [ ((0,xK_Escape)     , cancel)
+          , ((0,xK_Return)     , select)
+          , ((0,xK_slash)      , substringSearch navigation')
+          , ((0,xK_question)   , substringSearch navigation')
+          , ((0,xK_Left)       , move (-1,0) >> navigation')
+          , ((0,xK_h)          , move (-1,0) >> navigation')
+          , ((0,xK_H)          , move (-1,0) >> navigation')
+          , ((0,xK_Right)      , move (1,0) >> navigation')
+          , ((0,xK_l)          , move (1,0) >> navigation')
+          , ((0,xK_L)          , move (1,0) >> navigation')
+          , ((0,xK_Down)       , move (0,1) >> navigation')
+          , ((0,xK_j)          , move (0,1) >> navigation')
+          , ((0,xK_J)          , move (0,1) >> navigation')
+          , ((0,xK_Up)         , move (0,-1) >> navigation')
+          , ((0,xK_k)          , move (0,-1) >> navigation')
+          , ((0,xK_K)          , move (0,-1) >> navigation')
+          , ((0,xK_n)          , moveNext >> navigation')
+          , ((0,xK_N)          , moveNext >> navigation')
+          , ((0,xK_p)          , movePrev >> navigation')
+          , ((0,xK_P)          , movePrev >> navigation')
+          ]
+        ++ allowModifs (drop 1 modifs)
+          [ ((0,xK_Tab)         , moveNext >> navigation')
+          , ((shiftMask,xK_Tab) , moveNext >> navigation')
+          ]
+        )
+    modifs :: [KeyMask]
+    modifs = [ shiftMask, lockMask, mod1Mask, mod2Mask
+             , mod3Mask, mod4Mask, mod5Mask ]
+
+    allowModifs :: [ KeyMask ] -> [((KeyMask, a), b)] -> [((KeyMask, a), b)]
+    allowModifs mods keymap = [ ((m .|. o, k), a)
+            | m <- map (foldl (.|.) 0) $ subsequences mods
+            , ((o, k), a) <- keymap ]
+
+    -- The navigation handler ignores unknown key symbols
+    navHandler = const navigation'
+
+nonEmptyWsPred :: X (WindowSpace -> Bool)
+nonEmptyWsPred = do
+    let ne = isJust . W.stack
+    hs <- gets (map W.tag . W.hidden . windowset)
+    let hi w = W.tag w `elem` hs
+    return $ \w -> hi w && ne w && W.tag w /= "NSP"
+
+swapScreens :: X ()
+swapScreens = do
+    screen <- gets (listToMaybe . W.visible . windowset)
+    whenJust screen $ windows . W.greedyView . W.tag . W.workspace
+
+{- cykle only NonEmpty, Hidden workspaces and not NSP workspaces -}
+nonEmptyWs :: WSType
+nonEmptyWs = WSIs nonEmptyWsPred
+
+myKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X())
+myKeys conf = EZ.mkKeymap conf $ emacsKeys conf
+
+emacsKeys :: XConfig l -> [(String, X())]
+emacsKeys = \conf -> map prefix (emacsKeys' conf) ++ keys'
+  where
+    prefix :: (String, a) -> (String, a)
+    prefix (k, a) = (modm ++ "-" ++ k, a)
+
+    emacsKeys' :: XConfig l -> [(String, X())]
+    emacsKeys' conf = [
+               -- Applications
+              (";", spawnShell Nothing)
+            , ("S-;", spawnExplorer)
+            , ("S-.", namedScratchpadAction myNamedScratchpads  "guake")
+            , ("p", Shell.shellPrompt myXPConfig)
+            , ("S-p", mateRun)
+
+              -- Layouts
+            , ("<Space>", sendMessage NextLayout)
+            , ("C-<Space>", SUB.submap $ EZ.mkKeymap conf $ concat
+                [ [(k, a), (modm ++ "-C-" ++ k, a)]
+                | (k, a) <- [ ("3", sendMessage (Toggle "ThreeCol"))
+                            , ("x", sendMessage (MT.Toggle REFLECTX))
+                            , ("y", sendMessage (MT.Toggle REFLECTY))
+                            ]
+                ])
+            , ("<F5>", refresh)
+            , ("C-j", sendMessage $ Go D)
+            , ("C-k", sendMessage $ Go U)
+            , ("C-h", sendMessage $ Go L)
+            , ("C-l", sendMessage $ Go R)
+            , ("j", BW.focusDown)
+            , ("k", BW.focusUp)
+            , ("m", windows W.focusMaster)
+            , ("S-j", windows W.swapDown)
+            , ("S-k", windows W.swapUp)
+            , ("C-.", onGroup W.focusUp')
+            , ("C-,", onGroup W.focusDown')
+            , ("h", sendMessage Shrink)
+            , ("l", sendMessage Expand)
+            , ("<Return>", windows W.focusMaster)
+            , ("S-<Return>", DwmP.dwmpromote)
+            , ("t", withFocused $ windows . W.sink)
+            , (",", sendMessage (IncMasterN 1))
+            , (".", sendMessage (IncMasterN (-1)))
+
+            -- keybindings for sublayouts
+            , ("g", SUB.submap $ defaultSublMap conf)
+            , ("<Left>", sendMessage $ pullGroup L)
+            , ("<Right>", sendMessage $ pullGroup R)
+            , ("<Up>", sendMessage $ pullGroup U)
+            , ("<Down>", sendMessage $ pullGroup D)
+            , ("C-m", withFocused (sendMessage . MergeAll))
+            , ("C-u", withFocused (sendMessage . UnMerge))
+
+            -- boring windows
+            , ("b", BW.markBoring)
+            , ("S-b", BW.clearBoring)
+
+            -- minimized widnows
+            , ("z", withFocused minimizeWindow)
+            , ("S-z", sendMessage RestoreNextMinimizedWin)
+
+              -- Toggle full screen
+            , ("<F12>", sendMessage ToggleStruts >> refresh)
+
+              -- Windows
+            , ("S-c", kill)
+            , ("C-S-c", WithAll.killAll)
+            , ("x", spawn "xkill")
+
+            -- Compositing
+            , ("S-x", SUB.submap $ EZ.mkKeymap conf $ concat
+                [ [(k, a), (modm ++ "-S-" ++ k, a)]
+                | (k, a) <- [ ("r", spawn "systemctl --user restart compositing")
+                            , ("s", spawn "systemctl --user stop compositing")]
+                ])
+
+              -- Workspaces
+            , ("<Tab>", myToggleWS)
+            , ("S-<Tab>", toggleWSSwitch)
+            , ("C-<Right>", moveTo Next nonEmptyWs)
+            , ("]",         moveTo Next $ WSIs nonEmptyWsPred)
+            , ("C-<Left>",  moveTo Prev $ WSIs nonEmptyWsPred)
+            , ("[",         moveTo Prev $ WSIs nonEmptyWsPred)
+            , ("-", SUB.submap $ EZ.mkKeymap conf
+                [ (m ++ show k, _withNthWorkspace f i)
+                | (k, i) <- (zip ([1..9] ++ [0]) [10..] :: [(Int, Int)])
+                , (f, m) <- concat
+                    [ [ -- switch to ith workspace
+                        (W.greedyView, m)
+                        -- shift focused to ith workspace
+                      , (\ws -> W.greedyView ws . W.shift ws, m ++ "S-")
+                      ]
+                    | m <- ["", modm ++ "-"]
+                    ]
+                ])
+
+            , ("n", promptedNewWorkspace False)
+            , ("S-n", promptedNewWorkspace True)
+            , ("S-<Backspace>", WithAll.killAll >> DW.removeWorkspace)
+            , ("S-r", DW.renameWorkspace myXPConfig)
+            , ("c", TD.changeDir myXPConfig)
+
+            , ("r", swapScreens)
+
+            , ("a", TS.currentTopicAction myTopicConfig)
+
+            -- Grid Select workspace
+            , ("i", goToSelected myGSConfig)
+            , ("s", gsw)
+            , ("S-s", gswShift)
+
+              -- xmonad
+            , ("q", SUB.submap $ EZ.mkKeymap conf $ concat
+                [ [(k, a), (modm ++ "-" ++ k, a)]
+                | (k, a) <- [ ("c", spawn "xmonad --recompile; xmonad --restart")
+                            , ("r", spawn "xmonad --restart")
+                            , ("u", spawn "undock")
+                            , ("S-u", spawn "undock -s")
+                            , ("e", spawn "monitor-hotplug")
+                            , ("s", spawn "mate-session-save --shutdown-dialog")
+                            , ("q", spawn "mate-session-save --logout")
+                            , ("l", spawn "mate-screensaver-command --lock")
+                            ]
+                ])
+            , ("C-q", spawn "mate-screensaver-command --lock")
+
+            -- myNamedScratchpads
+            , ("C-S-t", namedScratchpadAction myNamedScratchpads "htop")
+            , ("C-S-a", namedScratchpadAction myNamedScratchpads "stardict")
+            , ("C-S-n", namedScratchpadAction myNamedScratchpads "notes")
+            , ("C-S-u", namedScratchpadAction myNamedScratchpads "charmap")
+            , ("C-S-l", namedScratchpadAction myNamedScratchpads "alarm")
+            , ("C-S-p", namedScratchpadAction myNamedScratchpads "volctl")
+
+            -- misc
+            , ("S-h", PSsh.sshPrompt myXPConfig)
+            --, ("<Print>", spawn "xfce4-screenshooter")
+            , ("y", spawn "xfce4-popup-clipman")
+            , ("<Print>", spawn "mate-screenshot")
+            , ("C-<Print>", spawn "mate-screenshot -w")
+            , ("S-<Print>", spawn "mate-screenshot -a")
+
+            -- MPD
+            -- mov current playing song in mpd to thrash
+            , ("<Delete>", spawn "mpcrm")
+            , ("<XF86Forward>",
+                    io $ return . fromRight =<< MPD.withMPD MPD.next)
+            , ("<XF86Back>",
+                    io $ return . fromRight =<< MPD.withMPD MPD.previous)
+            ]
+         ++ [ (m ++ show i, _withNthWorkspace f ((i + 9) `mod` 10))
+            | i <- [1..9] ++ [0]
+            , (f, m) <- [ (W.greedyView, "") -- switch to ith workspace
+                          -- shift focused to ith workspace
+                        , (\ws -> W.greedyView ws . W.shift ws, "S-")
+                        ]
+            ]
+         ++ [ (m ++ k, screenWorkspace sc >>= flip whenJust (windows . f))
+            | (k, sc) <- zip ["w", "e"] [0..]
+            , (f, m)  <- [(W.view, ""), (W.shift, "S-")]
+            ]
+
+    -- no prefix
+    keys' :: [(String, X())]
+    keys' = [
+          ("<XF86Calculator>",
+             namedScratchpadAction myNamedScratchpads "calculator")
+        , ("<XF86Mail>", TS.switchTopic myTopicConfig "mail")
+        , ("<XF86Terminal>", spawnShell Nothing)
+        , ("<XF86Explorer>", spawn "Terminal")
+        , ("<XF86HomePage>", TS.switchTopic myTopicConfig "web")
+
+        -- mpc
+        , ("<XF86AudioPlay>",
+                io $ return . fromRight =<< MPD.withMPD MPD.toggle)
+        , ("<XF86AudioStop>",
+                io $ return . fromRight =<< MPD.withMPD MPD.stop)
+        , ("<XF86AudioNext>",
+                io $ return . fromRight =<< MPD.withMPD MPD.next)
+        , ("<XF86AudioPrev>",
+                io $ return . fromRight =<< MPD.withMPD MPD.previous)
+
+        -- volume
+        , ("<XF86AudioMute>",        void toggleMute)
+        , ("<XF86AudioRaiseVolume>", void (raiseVolume 4))
+        , ("<XF86AudioLowerVolume>", void (lowerVolume 4))
+
+        -- brightness
+        , ("<XF86MonBrightnessUp>",     spawn "xbacklight +10")
+        , ("<XF86MonBrightnessDown>",   spawn "xbacklight -10")
+        , ("S-<XF86MonBrightnessUp>",   spawn "xbacklight +20")
+        , ("S-<XF86MonBrightnessDown>", spawn "xbacklight -20")
+        , ("C-<XF86MonBrightnessUp>",   spawn "xbacklight -set 100")
+        , ("C-<XF86MonBrightnessDown>", spawn "xbacklight -set 0")
+        ]
+
+    _withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
+    _withNthWorkspace job wnum = do
+        sortfunc <- getSortByIndex
+        ws <- gets ( map W.tag . sortfunc . namedScratchpadFilterOutWorkspace
+                   . W.workspaces . windowset )
+        case drop wnum ws of
+             (w:_) -> windows $ job w
+             [] -> return ()
+
+
+myToggleWS :: X()
+myToggleWS = do
+    hs' <- cleanHiddens ["NSP"]
+    unless (null hs') (windows . W.greedyView . W.tag $ head hs')
+  where
+    cleanHiddens :: [WorkspaceId] -> X [WindowSpace]
+    cleanHiddens skips = gets $ flip skipTags skips . W.hidden . windowset
+
+toggleWSSwitch :: X()
+toggleWSSwitch = do
+    hs' <- cleanHiddens []
+    unless (null hs') (windows . (\ws -> W.greedyView ws . W.shift ws) . W.tag $ head hs')
+  where
+    cleanHiddens :: [WorkspaceId] -> X [WindowSpace]
+    cleanHiddens skips =  gets $ flip skipTags skips . W.hidden . windowset
+
+promptedNewWorkspace :: Bool -> X()
+promptedNewWorkspace shiftFocused = PI.inputPrompt myXPConfig "New Workspace"
+                                  PI.?+ action shiftFocused
+  where
+    action :: Bool -> String -> X()
+    action True = newWorkspaceDir shiftto
+    action _    = newWorkspaceDir goto
+
+-- creates the workspace if needed
+goto :: TS.Topic -> X()
+goto t = newWorkspace t >> TS.switchTopic myTopicConfig t
+shiftto :: TS.Topic -> X()
+shiftto t = newWorkspace t >> windows (W.greedyView t . W.shift t)
+
+newWorkspace :: WorkspaceId -> X()
+newWorkspace w = do
+    exists <- widExists w
+    unless exists $ DW.addHiddenWorkspace w
+
+newWorkspaceDir :: (TS.Topic -> X()) -> WorkspaceId -> X()
+newWorkspaceDir gotofunc w = do
+    exists <- widExists w
+    if not exists then do
+        DW.addHiddenWorkspace w
+        gotofunc w
+        unless (w `S.member` doNotAskForDir) $ TD.changeDir myXPConfig
+    else
+        gotofunc w
+  where
+    doNotAskForDir :: S.Set WorkspaceId
+    doNotAskForDir = S.fromList $
+         ["mail", "chat", "virt", "vbox", "web"] ++ M.keys myTopicDirs
+
+widExists :: WorkspaceId -> X Bool
+widExists wid = do
+    xs <- get
+    return $ widExists' wid (windowset xs)
+  where
+    widExists' :: WorkspaceId -> W.StackSet WorkspaceId l a s sd -> Bool
+    widExists' w ws = w `elem` map W.tag (W.workspaces ws)
+
+switchTopic' :: (WorkspaceId -> WindowSet -> WindowSet)
+                -> TS.Topic -> X ()
+switchTopic' viewMethod topic = do
+   windows $ viewMethod topic
+   wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
+   when (null wins) $ TS.topicAction myTopicConfig topic
+
+gsw :: X()
+gsw = gsw' W.greedyView
+  where
+    gsw' :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+    gsw' viewFunc = withWindowSet $ \ws -> do
+        let wss = map W.tag $ fHidden ws ++ map W.workspace (W.current ws : W.visible ws)
+        gridselect myGSConfig (zip wss wss) >>= flip whenJust (switchTopic' viewFunc)
+    fHidden = filter ((/=) "NSP" . W.tag) . W.hidden
+
+gswShift :: X()
+gswShift = gridselectWorkspace myGSConfig (\ws -> W.greedyView ws . W.shift ws)
+
+mateRun :: X ()
+mateRun = withDisplay $ \dpy -> do
+    rw <- asks theRoot
+    mate_panel <- getAtom "_MATE_PANEL_ACTION"
+    panel_run   <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG"
+
+    io $ allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent e rw mate_panel 32 panel_run 0
+        sendEvent dpy rw False structureNotifyMask e
+        sync dpy False
+
+myBaseConfig = desktopConfig
+    { XMonad.modMask = myModMask
+    }
+
+-- Mouse bindings: default actions bound to mouse events
+myMouseBindings :: XConfig Layout
+                -> M.Map (ButtonMask, Button) (Window -> X())
+myMouseBindings (XConfig {XMonad.modMask = mm}) = M.fromList
+    -- mod-button1, Set the window to floating mode and move by dragging
+    [ ((mm, button1), \w -> focus w >> mouseMoveWindow w
+                                    >> windows W.shiftMaster)
+    -- mod-button2, Raise the window to the top of the stack
+    , ((mm, button2), windows . (W.shiftMaster .) . W.focusWindow)
+    -- mod-button3, Set the window to floating mode and resize by dragging
+    , ((mm, button3), \w -> focus w >> FlexR.mouseResizeWindow w)
+    -- you may also bind events to the mouse scroll wheel (button4 and button5)
+    , ((mm, button4), const $ windows W.swapDown)
+    , ((mm, button5), const $ windows W.swapUp)
+    ]
+
+myLayoutHook = avoidStruts
+             $ TD.topicDir myTopicDirs
+             $ PW.onWorkspace "chat" chatL
+             $ PW.onWorkspace "gimp" gimpL
+             $ PW.onWorkspace "BG" bgL
+             $ PW.onWorkspace "remote" remoteL
+             $ PW.onWorkspaces ["homam5", "civ4", "pst", "ciV"] wineGameL
+             $ _easyLay
+  where
+    -- basic layouts
+    _tiled = Tall nmaster delta ratio
+    _threecol = ThreeColMid nmaster delta (1/3)
+    _stack = StackTile nmaster delta ratio
+    nmaster = 1
+    ratio = 1/2
+    delta = 3/100
+    _mrt = MRT.mouseResizableTile
+             { MRT.draggerType = MRT.FixedDragger
+                { MRT.gapWidth = 2, MRT.draggerWidth = 2 }
+             }
+    _mrt2 = MRT.mouseResizableTile
+             { MRT.masterFrac = 0.8
+             , MRT.fracIncrement = delta
+             , MRT.draggerType = MRT.BordersDragger
+             }
+
+    -- common layouts
+    _easyLay = windowNavigation _baseLay 
+    _baseLay = smartBorders $ (mySubTabbed $ BW.boringWindows $ toggleLayouts _threecol
+                     (   MT.mkToggle (MT.single REFLECTX) _tiled
+                     ||| MT.mkToggle (MT.single REFLECTY) (Mirror _tiled)))
+             ||| (BW.boringWindows $ Tab.tabbed Tab.shrinkText myTabTheme)
+
+    -- workspace layouts
+    chatL = IM.withIM (1%5) (IM.ClassName "Skype"
+                 `IM.And`   (        IM.Title "minarmc - Skype™ (Beta)"
+                            `IM.Or`  IM.Title "Skype™ 2.2 (Beta) for Linux"
+                            `IM.Or`  IM.Title "minarmc - Skype™"))
+          $ IM.withIM (1%5) (        IM.ClassName "Empathy"
+                            `IM.And` (IM.Title "Contact List" `IM.Or` IM.Role "contact_list"))
+          {--
+          $ IM.withIM (1%5) (        IM.ClassName "Pidgin"
+                            `IM.And` IM.Role "buddy_list")
+          --}
+          {--
+          $ IM.withIM (1%5) (        IM.ClassName "Google-chrome"
+                            `IM.And` IM.Title "Hangouts")
+          --}
+          $ _easyLay
+
+    gimpL = LN.named "GIMP"
+          -- $ configurableNavigation noNavigateBorders $ BW.boringWindows
+          $ windowNavigation
+          $ smartBorders
+          $ IM.withIM (11/64) (IM.Role "gimp-toolbox")
+          $ CP.combineTwoP
+                (reflectHoriz $ TwoPane delta 0.2)
+                (Column 0)
+                (mySubTabbed $ BW.boringWindows Accordion)
+                (        CP.ClassName "Gimp"
+                `CP.And` CP.Not (CP.Role "gimp-image-window"))
+
+    bgL = windowNavigation $ BW.boringWindows $ smartBorders $ reflectHoriz $ Tall nmaster delta (7/9)
+
+    remoteL = windowNavigation $ BW.boringWindows $ smartBorders $ Tab.tabbed Tab.shrinkText myTabTheme
+
+    wineGameL = smartBorders $ simpleFloat ||| Full
+
+    mySubTabbed x = Tab.addTabs Tab.shrinkText myTabTheme $ subLayout [] Simplest x
+
+{- note: earlier hooks override later ones -}
+myManageHook :: ManageHook
+myManageHook = composeOne (concat
+        [ --[manageHook myBaseConfig]
+          [checkDock -?> doIgnore]
+        , [className =? c -?> doIgnore | c <- myCIgnores]
+        , [isFullscreen -?> doMaster <+> doFullFloat]
+        , [transience]
+        , [isDialog -?> doMaster <+> doCenterFloat]
+
+        , [fmap ("Preferences" `isInfixOf`) title -?> doMaster <+> doCenterFloat]
+        , [(className =? "Gimp" <&&> c) -?> h | (c, h) <- gimpManage]
+        , [(    className =? "Qjackctl"
+           <&&> fmap ("JACK Audio Connection Kit" `isPrefixOf`) title)
+            -?> doMaster <+> doFloat]
+        , [(className =? "Dia" <&&> role =? "toolbox_window")
+            -?> doMaster <+> doFloat]
+
+        , [ className =? c <&&> title =? t -?> doMaster <+> doFloat
+          | (c, t) <- myCTFloats ]
+        , [className =? c -?> doMaster <+> doCenterFloat | c <- myCCenterFloats]
+        , [className =? "Virt-manager" <&&> title =? "New VM"
+          -?> doMaster <+> doCenterFloat]
+        , [className =? c -?> doMaster <+> doFloat | c <- myCFloats ]
+        , [title =? t -?> doMaster <+> doFloat | t <- myTFloats ]
+        , [ className =? "BaldursGate" -?> doMyShift "BG" <+> doMaster]
+        , [query c -?> hook c | c <- myNamedScratchpads]])
+        --, [className =? "dzen" -?> transparency 0.4]])
+    <+>
+    composeOne (concat
+        [ [className =? "Dia"          -?> doMyShift "dia"]
+        , [className =? c              -?> doMyShift "chat" | c <- myChatClients ]
+        , [(className =? "Google-chrome" <&&> title =? "Hangouts") -?> doMyShift "chat"]
+        , [className =? c              -?> doMyShift "web"  | c <- myWebBrowsers ]
+        , [title =? "ncmpcpp"          -?> doMyShift "music" ]
+        , [className =? c              -?> doMyShift "music" | c <- myMusicPlayers ]
+        , [className =? c              -?> doMyShift "video" | c <- myVideoPlayers ]
+        , [className =? "Evince"       -?> doMyShift "pdf" ]
+        , [className =? "Atril"        -?> doMyShift "pdf" ]
+        , [className =? "Thunderbird"  -?> doMyShift "mail"]
+        , [className =? "Gimp"         -?> doMyShift "gimp"]
+        , [className =? "Virt-manager" -?> doMyShift "virt"]
+        , [className =? "VirtualBox"   -?> doMyShift "vbox"]
+        , [className =? "Deluge"       -?> doMyShift "p2p"]
+        , [className =? "Calibre"      -?> doMyShift "ebook"]
+        , [className =? "Squeak"       -?> doMyShift "squeak"]
+        , [className =? "Civ5XP"       -?> doMyShift "ciV"]
+        , [className =? "Googleearth-bin" -?> doMyShift "earth"]
+        -- see http://xmonad.org/xmonad-docs/xmonad-contrib/src/XMonad-Hooks-XPropManage.html#xPropManageHook
+        ])
+  where
+    doMaster = doF W.shiftMaster
+    doMyShift :: WorkspaceId -> ManageHook
+    doMyShift wsp = do
+        liftX (newWorkspace wsp)
+        doF $ W.greedyView wsp . W.shift wsp
+    myTFloats = [ "VLC (XVideo output)"
+              , "DownThemAll! - Make Your Selection"
+              , "Add Downloads"
+              , "Add URL(s)"
+              , "Run Application"
+              ]
+    myCIgnores = [ "Xfce4-notifyd"
+                 ]
+    myCFloats = [ -- "Gnome-panel"
+                  "Close session"
+                , "MPlayer"
+                , "Wine"
+                , "Galculator"
+                ]
+    myCTFloats = [ ("Skype", "Information")
+                 , ("Firefox", "Certificate Manager")
+                 , ("processing-app-Base", "Preferences")
+                 , ("Thunar", "File Operation Progress")
+                 ]
+    myCCenterFloats = [ -- "Gnome-tweak-tool"
+                        "Xfce4-notes"
+                      , "Gcolor2"
+                      , "Gcr-prompter"
+                      , "Xfce4-appfinder"
+                      , "Xmessage"
+                      , "Pavucontrol"
+                      , "Xfrun4"
+                      , "Xfce4-settings-manager"
+                      , "Xfce4-panel"
+                      , "Alarm-clock-applet"
+                      ]
+    myChatClients  = ["Pidgin", "Xchat", "Skype", "Empathy", "Hexchat"]
+    myWebBrowsers  = [ -- "Firefox"
+          "Chromium-browser"
+        , "Google-chrome"
+        ]
+    myMusicPlayers = ["ncmpcpp", "Sonata", "Rhythmbox", "Gmpc"]
+    myVideoPlayers = ["MPlayer", "Vlc", "Smplayer"]
+    gimpManage = [ ( role =? "gimp-toolbox" <||> role =? "gimp-image-window"
+                   , ask >>= doF . W.sink)
+                 , (role =? "gimp-image-merge-layers", doCenterFloat)
+                 , (title =? "Scale Image", doCenterFloat)
+                 , (title =? "Export File", doCenterFloat)
+                 , (fmap ("Save as" `isPrefixOf`) title, doCenterFloat)
+                 ]
+
+    role = stringProperty "WM_WINDOW_ROLE"
+
+myFadeHook :: FadeHook
+myFadeHook = composeAll [ opaque
+                        , isUnfocused         --> transparency 0.2
+                        , doNotFadeOutWindows --> opaque
+                        ]
+
+--myLogHook :: Handle -> X ()
+myLogHook dbus = do
+    sorted <- getSortByIndex
+    ws <- gets ( map W.tag . sorted . namedScratchpadFilterOutWorkspace
+               . W.workspaces . windowset
+               )
+    DL.dynamicLogWithPP (myPP $ M.fromList $ zip ws ([1..] :: [Integer])) {
+        ppOutput = dbusOutput dbus
+    }
+    currentWorkspaceOnTop
+    ewmhDesktopsLogHook
+    fadeWindowsLogHook myFadeHook
+    UP.updatePointer (UP.Relative 0.9 0.9)
+
+myPP :: Show a => M.Map WorkspaceId a -> PP
+myPP wmap = defaultPP
+    { ppTitle    = pangoSpan [("foreground", "white"), ("font", "Cantarell 10")] . pangoSanitize
+    , ppCurrent  = pangoColor "white" . wrap "[" "]"
+                    . pangoSanitize . indexWorkspace
+    , ppVisible  = pangoColor "yellow" . wrap "(" ")"
+                    . pangoSanitize . indexWorkspace
+    , ppHidden   = _hidden . noScratchPad
+    , ppUrgent   = pangoColor "#FF0000"
+                 . pangoSanitize . indexWorkspace
+    , ppLayout   = pangoColor "lightblue" . pangoSanitize . shortenLayout
+    , ppSep      = pangoColor "brown" $ pangoSanitize " : "
+    , ppWsSep    = " "
+    }
+  where
+    topicLength :: Integer
+    topicLength = 3
+    _hidden :: String -> String
+    _hidden [] = ""
+    _hidden x = pangoColor "#9a9a9a" . pangoSanitize
+              . _shorten . indexWorkspace $ x
+
+    _shorten :: String -> String
+    _shorten ws = let m = ws =~ ("[0-9]+:.{0," ++ show topicLength ++ "}")
+                  in if m == "" then ws else m
+
+    indexWorkspace :: WorkspaceId -> WorkspaceId
+    indexWorkspace w | w `M.member` wmap = show (wmap M.! w) ++ ":" ++ w
+                     | otherwise         = w
+
+    noScratchPad ws | ws =~ "^NSP(:[0-9]+)?$" = ""
+                    | otherwise               = ws
+
+    shortenLayout = shortenLayout' [
+          ("^Tabbed\\s+(.*)", "T:\\1")
+        , ("\\bThreeCol\\b", "OHH")
+        , ("\\bThreeColMid\\b", "HOH")
+        , ("\\bReflectX\\s+(.*)", "RX:\\1")
+        , ("\\bReflectY\\s+(.*)", "RY:\\1")
+        , ("\\bMirror\\s+(.*)", "M:\\1")
+        , ("\\bResizableTall\\b", "OH")
+        ]
+    shortenLayout' [] s = s
+    shortenLayout' ((reg, repl):xs) s = shortenLayout' xs
+                                    $ subRegex (mkRegex reg) s repl
+
+dbusOutput :: D.Client -> String -> IO ()
+dbusOutput dbus str = do
+    let signal = (D.signal 
+                (D.objectPath_ "/org/xmonad/Log")
+                (D.interfaceName_ "org.xmonad.Log")
+                (D.memberName_ "Update")) {
+            D.signalBody = [D.toVariant ("<b>" ++ (pangoSpan [("font", "Cantarell Bold 10")] $ UTF8.decodeString str) ++ "</b>")]
+        }
+    D.emit dbus signal
+
+pangoSpan :: [(String, String)] -> String -> String
+pangoSpan attrs = wrap left right
+  where
+    left = "<span " ++ attrstr ++ ">"
+    right = "</span>"
+    attrstr = intercalate " " $ fmap (\(x, y) -> x ++ "=\"" ++ y ++ "\"") attrs
+
+pangoColor :: String -> String -> String
+pangoColor fg = pangoSpan [("foreground", fg)]
+
+--pangoColor2 :: String -> String -> String -> String
+--pangoColor2 fg bg = pangoSpan [("foreground", fg), ("background", bg)]
+
+pangoSanitize :: String -> String
+pangoSanitize = foldr sanitize ""
+  where
+    sanitize '>'  xs = "&gt;" ++ xs
+    sanitize '<'  xs = "&lt;" ++ xs
+    sanitize '\"' xs = "&quot;" ++ xs
+    sanitize '&'  xs = "&amp;" ++ xs
+    sanitize x    xs = x:xs
+
+-- | Enables 'focusFollowsMouse' for tiled windows only.  For this to
+-- work you need to turn off 'focusFollowsMouse' in your configuration
+-- and then add this function to your 'handleEventHook'.
+focusFollowsTiledOnly :: Event -> X All
+focusFollowsTiledOnly e@(CrossingEvent {ev_window = w, ev_event_type = t})
+  | isNormalEnter = whenX bothTiled (focus w) >> mempty
+  where isNormalEnter   = t == enterNotify && ev_mode e == notifyNormal
+        bothTiled       = notFloating w <&&> currentIsTiled
+        currentIsTiled  = currentWindow >>= maybe (return True) notFloating
+        currentWindow   = gets $ W.peek . windowset
+        notFloating w'  = gets $ not . M.member w' . W.floating . windowset
+focusFollowsTiledOnly _ = mempty
+
+myEventHook :: Event -> X All
+myEventHook = mconcat
+    [ ewmhDesktopsEventHook
+    , docksEventHook
+    , fadeWindowsEventHook
+    , focusFollowsTiledOnly
+    , fullscreenEventHook
+    ]
+
+myConfig dbus = myBaseConfig
+    { modMask = myModMask
+    , borderWidth = 1
+    , normalBorderColor = "#FFD12B"
+    , focusedBorderColor = "#FF511F"
+    , terminal = myTerminal
+    , workspaces = myWorkspaces
+    , layoutHook = desktopLayoutModifiers myLayoutHook
+    , keys = myKeys
+    , logHook = myLogHook dbus
+    , handleEventHook = myEventHook
+    , manageHook = myManageHook
+    , startupHook = myStartupHook
+    , mouseBindings = myMouseBindings
+    }
+  where
+    mc = myConfig dbus
+    myStartupHook = do
+        return () >> EZ.checkKeymap mc (emacsKeys mc)
+        startupHook myBaseConfig
+        -- adjustEventInput
+        setWMName "LG3D"
+
+getWellKnownName :: D.Client -> IO ()
+getWellKnownName dbus = do
+    D.requestName dbus (D.busName_ "org.xmonad.Log")
+            [D.nameAllowReplacement, D.nameReplaceExisting, D.nameDoNotQueue]
+        >> return ()
+
+main :: IO ()
+main = do
+    dbus <- D.connectSession
+    getWellKnownName dbus
+    xmonad $ withUrgencyHook NoUrgencyHook $ myConfig dbus