Using xmobar with icon patterns

Signed-off-by: Michal Minar <mic.liamg@gmail.com>

2 files changed, 65 insertions, 74 deletions

diff --git a/src/XMonad/Local/Layout.hs b/src/XMonad/Local/Layout.hs
index 99aa2b6..887a734 100644
--- a/src/XMonad/Local/Layout.hs
+++ b/src/XMonad/Local/Layout.hs
@@ -1,10 +1,10 @@
 {-# OPTIONS -fno-warn-missing-signatures #-}
-{-# OPTIONS -XFlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module XMonad.Local.Layout (layoutHook) where
 
 import Data.Ratio ((%))
-import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageDocks (avoidStruts)
 import XMonad.Layout
 import XMonad.Layout.Accordion
 import qualified XMonad.Layout.BoringWindows as BW
@@ -31,13 +31,13 @@ import XMonad.Layout.TopicDir as TD
 import XMonad.Local.TopicSpace as Local
 
 layoutHook = avoidStruts
-             $ TD.topicDir Local.topicDirs
-             $ PW.onWorkspace "chat" chatL
-             $ PW.onWorkspace "gimp" gimpL
-             $ PW.onWorkspace "BG" bgL
-             $ PW.onWorkspace "remote" remoteL
-             $ PW.onWorkspaces ["homam5", "civ4", "pst", "ciV"] wineGameL
-             $ easyLay
+           $ TD.topicDir Local.topicDirs
+           $ PW.onWorkspace "chat" chatL
+           $ PW.onWorkspace "gimp" gimpL
+           $ PW.onWorkspace "BG" bgL
+           $ PW.onWorkspace "remote" remoteL
+           $ PW.onWorkspaces ["homam5", "civ4", "pst", "ciV"] wineGameL
+             easyLay
 
 nmaster = 1
 ratio = 1/2
@@ -48,11 +48,14 @@ threecol =  ThreeColMid nmaster delta (1/3)
 
 -- 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 $ trackFloating $ Tab.tabbed Tab.shrinkText myTabTheme)
+baseLay = smartBorders (tiled' ||| tabbed')
+    where
+        tiled' = mySubTabbed $ BW.boringWindows
+               $ toggleLayouts threecol
+               $       MT.mkToggle (MT.single REFLECTX) tiled
+                   ||| MT.mkToggle (MT.single REFLECTY) (Mirror tiled)
+        tabbed' = BW.boringWindows $ trackFloating $ Tab.tabbed Tab.shrinkText myTabTheme
+
 
 -- workspace layouts
 chatL = IM.withIM (1%5) (IM.ClassName "Skype"
@@ -61,7 +64,7 @@ chatL = IM.withIM (1%5) (IM.ClassName "Skype"
                         `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"))
-      $ easyLay
+        easyLay
 
 gimpL = LN.named "GIMP"
       $ windowNavigation
diff --git a/src/XMonad/Local/LogHook.hs b/src/XMonad/Local/LogHook.hs
index 1386933..6cd340f 100644
--- a/src/XMonad/Local/LogHook.hs
+++ b/src/XMonad/Local/LogHook.hs
@@ -1,10 +1,7 @@
 module XMonad.Local.LogHook (logHook) where
 
-import qualified Codec.Binary.UTF8.String as UTF8
-import qualified Data.Map as M
-import Data.List
-import qualified DBus as D
-import qualified DBus.Client as D
+import qualified Data.Map.Strict as M
+import System.IO -- (Handle, hPutStrLn)
 import Text.Regex
 import Text.Regex.Posix
 
@@ -12,56 +9,67 @@ import Text.Regex.Posix
 import XMonad hiding (logHook)
 import qualified XMonad.Actions.UpdatePointer as UP
 import XMonad.Hooks.CurrentWorkspaceOnTop
-import XMonad.Hooks.DynamicLog as DL
+import XMonad.Hooks.DynamicLog
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.FadeWindows
 import qualified XMonad.StackSet as W
-import XMonad.Util.NamedScratchpad as NS
+import qualified XMonad.Util.NamedScratchpad as NS
 import XMonad.Util.WorkspaceCompare (getSortByIndex)
 
-logHook :: D.Client -> X()
-logHook dbus = do
+logHook :: Handle -> X()
+logHook xmobarHandle = do
     sorted <- getSortByIndex
-    ws <- gets ( map W.tag . sorted . namedScratchpadFilterOutWorkspace
+    ws <- gets $ map W.tag . sorted . NS.namedScratchpadFilterOutWorkspace
                . W.workspaces . windowset
-               )
-    DL.dynamicLogWithPP (myPP $ M.fromList $ zip ws ([1..] :: [Integer])) {
-        ppOutput = dbusOutput dbus
+    dynamicLogWithPP (myPP $ M.fromList $ zip ws ([1..] :: [Int])) {
+        ppOutput = hPutStrLn xmobarHandle
     }
     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 " : "
+myPP :: M.Map WorkspaceId Int -> PP
+myPP wmap = xmobarPP
+    { ppTitle    = xmobarColor "white" "" . xmobarSanitize . shorten 60
+    , ppCurrent  = xmobarColor "white" "" . wrap "[" "]"
+                    . indexWorkspace False
+    , ppVisible  = xmobarColor "yellow" "" . wrap "(" ")"
+                    . indexWorkspace False
+    , ppHidden   = hidden . noScratchPad
+    , ppUrgent   = xmobarColor "red" "black" . indexWorkspace False
+    , ppLayout   = xmobarColor "lightblue" "" . xmobarSanitize . shortenLayout
+    , ppSep      = xmobarColor "brown" "" $ xmobarSanitize " : "
     , ppWsSep    = " "
     }
   where
-    topicLength :: Integer
+    topicLength :: Int
     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
+    hidden :: String -> String
+    hidden [] = ""
+    hidden x = xmobarColor "#9a9a9a" "" $ indexWorkspace True x
 
-    indexWorkspace :: WorkspaceId -> WorkspaceId
-    indexWorkspace w | w `M.member` wmap = show (wmap M.! w) ++ ":" ++ w
-                     | otherwise         = w
+    indexWorkspace :: Bool -> WorkspaceId -> WorkspaceId
+    indexWorkspace shorten' w
+        | w `M.member` wmap = clickable index (show index ++ ":" ++ toName shorten' w)
+        | otherwise         = clickable index w
+        where
+            index :: Int
+            index = wmap M.! w
+
+    toName :: Bool -> WorkspaceId -> String
+    toName True  = take topicLength
+    toName False = id
+
+    clickable :: Int -> String -> String
+    clickable index | index == 10 = aWrap 0
+                    | index < 10  = aWrap index
+                    | otherwise   = xmobarSanitize
+
+    aWrap :: Int -> String -> String
+    aWrap index w = "<action=`xdotool key super+" ++ show index ++
+                    "` button=1>" ++ xmobarSanitize w ++ "</action>"
 
     noScratchPad ws | ws =~ "^NSP(:[0-9]+)?$" = ""
                     | otherwise               = ws
@@ -77,7 +85,7 @@ myPP wmap = defaultPP
         ]
     shortenLayout' [] s = s
     shortenLayout' ((reg, repl):xs) s = shortenLayout' xs
-                                    $ subRegex (mkRegex reg) s repl
+                                      $ subRegex (mkRegex reg) s repl
 
 myFadeHook :: FadeHook
 myFadeHook = composeAll [ opaque
@@ -103,28 +111,8 @@ doNotFadeOutWindows =
     className =? "BaldursGate" <||>
     title     =? "VLC (XVideo output)"
 
-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)]
-
-pangoSanitize :: String -> String
-pangoSanitize = foldr sanitize ""
+xmobarSanitize :: String -> String
+xmobarSanitize = foldr sanitize ""
   where
     sanitize '>'  xs = "&gt;" ++ xs
     sanitize '<'  xs = "&lt;" ++ xs