tianbar 0.1.3.1 → 0.2.0.0

raw patch · 2 files changed

+78/−54 lines, 2 filesdep +blaze-htmldep +blaze-markupPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-html, blaze-markup

API changes (from Hackage documentation)

Files

• src/System/Tianbar/XMonadLog.hs +74/−52
• tianbar.cabal +4/−2

@@ -1,69 +1,91 @@-module System.Tianbar.XMonadLog ( tianbarPP-                                , dbusLog-                                , dbusLogWithPP+module System.Tianbar.XMonadLog ( dbusLog+                                , dbusLogWithMarkup+                                , dbusLogWithRenderer+                                , tianbarMarkup+                                , WindowSpaceInfo(..)+                                , Renderer+                                , MarkupRenderer                                 ) where -import Codec.Binary.UTF8.String (decodeString)--import Data.Char-import Data.List import Data.Maybe  import DBus import DBus.Client -import XMonad-import XMonad.Hooks.DynamicLog--wrapClass :: String -> String -> String-wrapClass cls = wrap ("<span class='" ++ cls ++ "'>") "</span>"--wrapWorkspaceClass :: String -> String -> String-wrapWorkspaceClass cls wid = wrapClass classes wid-    where classes = intercalate " " [cls, ws, ws ++ wid]-          ws = "workspace"--escapeHtml :: String -> String-escapeHtml = concatMap escapeChar-    where escapeChar '\"' = "&#34;"-          escapeChar '\'' = "&#39;"-          escapeChar '&'  = "&#38;"-          escapeChar '<'  = "&#60;"-          escapeChar '>'  = "&#62;"-          escapeChar c | ord c >= 160 = "&#" ++ show (ord c) ++ ";"-                       | otherwise    = [c]--tianbarPP :: PP-tianbarPP = defaultPP { ppTitle = escapeHtml-                      , ppCurrent = wrapWorkspaceClass "current"-                      , ppVisible = wrapWorkspaceClass "visible"-                      , ppUrgent = wrapWorkspaceClass "urgent"-                      , ppHidden = wrapWorkspaceClass "hidden"-                      , ppHiddenNoWindows = wrapWorkspaceClass "hidden empty"-                      , ppSep = ""-                      , ppOrder = zipWith wrapClass [ "workspaces"-                                                    , "layout"-                                                    , "title"-                                                    ]-                      }+import Text.Blaze+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import Text.Blaze.Renderer.String (renderMarkup) -dbusLogWithPP :: Client -> PP -> X ()-dbusLogWithPP client pp = dynamicLogWithPP pp { ppOutput = outputThroughDBus client }+import XMonad hiding (title, workspaces)+import XMonad.Hooks.UrgencyHook+import qualified XMonad.StackSet as S+import XMonad.Util.NamedWindows+import XMonad.Util.WorkspaceCompare  -- | A DBus-based logger with a default pretty-print configuration dbusLog :: Client -> X ()-dbusLog client = dbusLogWithPP client tianbarPP+dbusLog client = dbusLogWithMarkup client tianbarMarkup  sig :: Signal sig = signal (fromJust $ parseObjectPath "/org/xmonad/Log")              (fromJust $ parseInterfaceName "org.xmonad.Log")              (fromJust $ parseMemberName "Update") -outputThroughDBus :: Client -> String -> IO ()-outputThroughDBus client str = do-    -- The string that we get from XMonad here isn't quite a normal-    -- string - each character is actually a byte in a utf8 encoding.-    -- We need to decode the string back into a real String before we-    -- send it over dbus.-    let str' = decodeString str-    emit client sig { signalBody = [ toVariant str' ] }+data WindowSpaceInfo = WindowSpaceInfo { wsTag     :: String+                                       , wsCurrent :: Bool+                                       , wsHidden  :: Bool+                                       , wsUrgent  :: Bool+                                       , wsEmpty   :: Bool+                                       }++type Renderer a = String            -- ^ layout description+               -> String            -- ^ window title+               -> [WindowSpaceInfo] -- ^ workspaces+               -> [Window]          -- ^ urgent windows+               -> WindowSet         -- ^ all windows+               -> a++type MarkupRenderer = Renderer Markup++dbusLogWithRenderer :: Client -> Renderer String -> X ()+dbusLogWithRenderer client renderer = do+    winset <- gets windowset+    urgents <- readUrgents+    let ld = description . S.layout . S.workspace . S.current $ winset+    wt <- maybe (return "") (fmap show . getName) . S.peek $ winset++    sort_ <- mkWsSort getWsCompare+    let ws = sort_ $ map S.workspace (S.current winset : S.visible winset)+                     ++ S.hidden winset+    let visibles = map (S.tag . S.workspace) (S.visible winset)+    let wsinfo w = WindowSpaceInfo tag_ current_ hidden_ urgent_ empty_+                   where tag_ = S.tag w+                         current_ = tag_ == S.currentTag winset+                         hidden_  = tag_ `notElem` visibles+                         urgent_  = any (\x -> maybe False (== tag_) (S.findTag x winset)) urgents+                         empty_   = isNothing (S.stack w)++    let html = renderer ld wt (map wsinfo ws) urgents winset+    liftIO $ emit client sig { signalBody = [ toVariant html ] }++dbusLogWithMarkup :: Client -> MarkupRenderer -> X ()+dbusLogWithMarkup client renderer = dbusLogWithRenderer client renderer'+    where renderer' ld wt wksp urgent winset =+              renderMarkup $ renderer ld wt wksp urgent winset++tianbarMarkup :: MarkupRenderer+tianbarMarkup layout title workspaces _ _ = do+    H.span ! A.class_ (toValue "workspaces") $+        mapM_ wsHtml $ workspaces+    H.span ! A.class_ (toValue "layout") $ toMarkup layout+    H.span ! A.class_ (toValue "title") $ toMarkup title+    where+        wsHtml w = H.span ! A.class_ (toValue $ unwords classes) $+            toMarkup $ wsTag w+            where classes =+                    ["workspace"] +++                    ["current" | wsCurrent w] +++                    ["hidden"  | wsHidden w] +++                    ["urgent"  | wsUrgent w] +++                    ["empty"   | wsEmpty w]

@@ -1,5 +1,5 @@ name:                tianbar-version:             0.1.3.1+version:             0.2.0.0 synopsis:            A desktop bar based on WebKit description:   A desktop bar using WebKit for rendering as much as possible.@@ -8,7 +8,7 @@ license:             MIT license-file:        LICENSE author:              Alexey Kotlyarov-maintainer:          koterpillar@gmail.com+maintainer:          a@koterpillar.com category:            System build-type:          Simple cabal-version:       >=1.10@@ -43,6 +43,8 @@                      , xmonad                      , xmonad-contrib                      , utf8-string ==0.3.*+                     , blaze-html ==0.5.*+                     , blaze-markup ==0.5.*   hs-source-dirs:      src   exposed-modules:     System.Tianbar.XMonadLog   ghc-options: -Wall -rtsopts