Added taffybar - not working

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

6 files changed, 87 insertions, 23 deletions

diff --git a/Makefile b/Makefile
index 5e667a6..2d00064 100644
--- a/Makefile
+++ b/Makefile
@@ -2,6 +2,7 @@
 ARCH             := $(shell uname -m)
 OS               := $(shell uname -s | tr '[A-Z]' '[a-z]')
 TARGET           := $(HOME)/.xmonad/xmonad-$(ARCH)-$(OS)
+TAFFY            := $(HOME)/.config/taffybar/taffybar.hs
 SRC              := $(shell find . -type f -name '*.hs')
 CABAL_BIN        ?= $(shell which cabal)
 SANDBOX          := cabal.sandbox.config
@@ -19,7 +20,7 @@ DISPLAY          ?= :0
 all: build
 
 ################################################################################
-install: $(TARGET)
+install: $(TARGET) $(TAFFY)
 
 ################################################################################
 build: $(XMINAD)
@@ -73,3 +74,7 @@ $(TARGET): $(XMINAD)
 	if [ -r $@ ]; then mv $@ $@.prev; fi
 	cp -p $? $@
 	cd $(dir $@) && ln -nfs $(notdir $@) xminad
+
+$(TAFFY): $(XMINAD)
+	mkdir -p $(dir $@)
+	ln -sf $(CURDIR)/taffybar.hs $@
diff --git a/config/taffybar.rc b/config/taffybar.rc
new file mode 100644
index 0000000..53e572a
--- /dev/null
+++ b/config/taffybar.rc
@@ -0,0 +1,22 @@
+gtk_color_scheme = "black:#000000\nwhite:#FFFFFF\ngreen:#00FF00\nred:#FF0000"
+
+style "default" {
+  bg[NORMAL]   = @black
+  fg[NORMAL]   = @white
+  text[NORMAL] = @white
+  fg[PRELIGHT] = @green
+  bg[PRELIGHT] = @black
+}
+
+style "active-window" = "default" {
+  fg[NORMAL] = @green
+}
+
+style "notification-button" = "default" {
+  text[NORMAL] = @red
+  fg[NORMAL]   = @red
+}
+
+widget "Taffybar*" style "default"
+widget "Taffybar*WindowSwitcher*label" style "active-window"
+widget "*NotificationCloseButton" style "notification-button"
diff --git a/src/XMonad/Local/LogHook.hs b/src/XMonad/Local/LogHook.hs
index 1386933..3503b77 100644
--- a/src/XMonad/Local/LogHook.hs
+++ b/src/XMonad/Local/LogHook.hs
@@ -1,26 +1,27 @@
 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 Text.Regex
-import Text.Regex.Posix
+--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 Text.Regex
+--import Text.Regex.Posix
 
 -- local modules **************************************************************
 import XMonad hiding (logHook)
 import qualified XMonad.Actions.UpdatePointer as UP
 import XMonad.Hooks.CurrentWorkspaceOnTop
-import XMonad.Hooks.DynamicLog as DL
-import XMonad.Hooks.EwmhDesktops
+--import XMonad.Hooks.DynamicLog as DL
+--import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.FadeWindows
-import qualified XMonad.StackSet as W
-import XMonad.Util.NamedScratchpad as NS
-import XMonad.Util.WorkspaceCompare (getSortByIndex)
+--import qualified XMonad.StackSet as W
+--import XMonad.Util.NamedScratchpad as NS
+--import XMonad.Util.WorkspaceCompare (getSortByIndex)
 
-logHook :: D.Client -> X()
-logHook dbus = do
+logHook :: X()
+logHook = do
+    {-
     sorted <- getSortByIndex
     ws <- gets ( map W.tag . sorted . namedScratchpadFilterOutWorkspace
                . W.workspaces . windowset
@@ -28,11 +29,13 @@ logHook dbus = do
     DL.dynamicLogWithPP (myPP $ M.fromList $ zip ws ([1..] :: [Integer])) {
         ppOutput = dbusOutput dbus
     }
+    -}
     currentWorkspaceOnTop
-    ewmhDesktopsLogHook
+    --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
@@ -78,6 +81,7 @@ myPP wmap = defaultPP
     shortenLayout' [] s = s
     shortenLayout' ((reg, repl):xs) s = shortenLayout' xs
                                     $ subRegex (mkRegex reg) s repl
+-}
 
 myFadeHook :: FadeHook
 myFadeHook = composeAll [ opaque
@@ -103,6 +107,7 @@ doNotFadeOutWindows =
     className =? "BaldursGate" <||>
     title     =? "VLC (XVideo output)"
 
+{-
 dbusOutput :: D.Client -> String -> IO ()
 dbusOutput dbus str = do
     let signal = (D.signal 
@@ -131,3 +136,4 @@ pangoSanitize = foldr sanitize ""
     sanitize '\"' xs = "&quot;" ++ xs
     sanitize '&'  xs = "&amp;" ++ xs
     sanitize x    xs = x:xs
+-}
diff --git a/taffybar.hs b/taffybar.hs
new file mode 100644
index 0000000..1db8015
--- /dev/null
+++ b/taffybar.hs
@@ -0,0 +1,9 @@
+import System.Taffybar
+import System.Taffybar.TaffyPager
+
+main :: IO()
+main = do
+    let pager = taffyPagerNew defaultPagerConfig
+    defaultTaffybar defaultTaffybarConfig { startWidgets = [ pager ]
+                                          , barPosition = Bottom
+                                          }
diff --git a/xminad.cabal b/xminad.cabal
index 54f4735..2516833 100644
--- a/xminad.cabal
+++ b/xminad.cabal
@@ -39,6 +39,8 @@ category:               Graphics
 
 build-type:             Simple
 
+data-files:             config/taffybar.rc
+
 -- Extra files to be distributed with the package, such as examples or a 
 -- README.
 -- extra-source-files:  
@@ -113,6 +115,7 @@ executable xminad
     , MissingH       >=1.2  && <1.4
     , regex-compat   >=0.90 && <1.0
     , regex-posix    >=0.90 && <1.0
+    , taffybar       >=0.4 && <0.6
     , text           >=0.11 && <1.3
     , utf8-string    >=0.3  && <1.1
     , X11            >=1.6  && <2.0
@@ -138,3 +141,16 @@ executable checkrc
 
   -- Base language which the package is written in.
   default-language:     Haskell2010
+
+executable taffybar
+  main-is:              taffybar.hs
+
+  ghc-options:          -Wall
+
+  build-depends:
+      base
+    , containers
+    , taffybar          >=0.4 && <0.6
+
+  -- Base language which the package is written in.
+  default-language:     Haskell2010
diff --git a/xminad.hs b/xminad.hs
index f117093..2ba5031 100644
--- a/xminad.hs
+++ b/xminad.hs
@@ -1,12 +1,14 @@
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# OPTIONS -fno-warn-missing-signatures #-}
 
-import qualified DBus as D
-import qualified DBus.Client as D
+--import qualified DBus as D
+--import qualified DBus.Client as D
+import System.Taffybar.Hooks.PagerHints
 
 import XMonad
 import XMonad.Actions.UpdateFocus
 import XMonad.Config.Desktop
+import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.SetWMName
 import XMonad.Hooks.UrgencyHook
 
@@ -21,7 +23,7 @@ import qualified XMonad.Local.Mouse as Local
 import qualified XMonad.Local.TopicSpace as Local
 import qualified XMonad.Local.XConfig as Local
 
-myConfig dbus = Local.xConfig
+myConfig = Local.xConfig
     { modMask = Local.modMask
     , borderWidth = 1
     , normalBorderColor = "#FFD12B"
@@ -30,7 +32,7 @@ myConfig dbus = Local.xConfig
     , workspaces = Local.workspaces
     , layoutHook = desktopLayoutModifiers Local.layoutHook
     , keys = Local.keyBindings
-    , logHook = Local.logHook dbus
+    , logHook = Local.logHook
     , handleEventHook = Local.eventHook
     , manageHook = Local.manageHook
     , startupHook = myStartupHook
@@ -38,18 +40,22 @@ myConfig dbus = Local.xConfig
     }
   where
     myStartupHook = do
+        spawn "pkill taffybar"
+        spawn "taffybar"
         startupHook Local.xConfig
         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
+    --dbus <- D.connectSession
+    -- getWellKnownName dbus
+    xmonad $ withUrgencyHook NoUrgencyHook $ ewmh $ pagerHints myConfig