diff options
author | V3n3RiX <venerix@redcorelinux.org> | 2017-10-09 18:53:29 +0100 |
---|---|---|
committer | V3n3RiX <venerix@redcorelinux.org> | 2017-10-09 18:53:29 +0100 |
commit | 4f2d7949f03e1c198bc888f2d05f421d35c57e21 (patch) | |
tree | ba5f07bf3f9d22d82e54a462313f5d244036c768 /x11-misc/xmonad-log-applet/files |
reinit the tree, so we can have metadata
Diffstat (limited to 'x11-misc/xmonad-log-applet/files')
-rw-r--r-- | x11-misc/xmonad-log-applet/files/xmonad.hs | 60 |
1 files changed, 60 insertions, 0 deletions
diff --git a/x11-misc/xmonad-log-applet/files/xmonad.hs b/x11-misc/xmonad-log-applet/files/xmonad.hs new file mode 100644 index 000000000000..54b0025a97c4 --- /dev/null +++ b/x11-misc/xmonad-log-applet/files/xmonad.hs @@ -0,0 +1,60 @@ +import XMonad +import XMonad.Config.Gnome +import XMonad.Hooks.DynamicLog + +import Control.OldException + +import DBus +import DBus.Connection +import DBus.Message + +main :: IO () +main = withConnection Session $ \dbus -> do + getWellKnownName dbus + xmonad $ gnomeConfig + { logHook = dynamicLogWithPP (prettyPrinter dbus) + } + +prettyPrinter :: Connection -> PP +prettyPrinter dbus = defaultPP + { ppOutput = dbusOutput dbus + , ppTitle = pangoSanitize + , ppCurrent = pangoColor "green" . wrap "[" "]" . pangoSanitize + , ppVisible = pangoColor "yellow" . wrap "(" ")" . pangoSanitize + , ppHidden = const "" + , ppUrgent = pangoColor "red" + , ppLayout = const "" + , ppSep = " " + } + +getWellKnownName :: Connection -> IO () +getWellKnownName dbus = tryGetName `catchDyn` (\(DBus.Error _ _) -> getWellKnownName dbus) + where + tryGetName = do + namereq <- newMethodCall serviceDBus pathDBus interfaceDBus "RequestName" + addArgs namereq [String "org.xmonad.Log", Word32 5] + sendWithReplyAndBlock dbus namereq 0 + return () + +dbusOutput :: Connection -> String -> IO () +dbusOutput dbus str = do + msg <- newSignal "/org/xmonad/Log" "org.xmonad.Log" "Update" + addArgs msg [String ("<b>" ++ str ++ "</b>")] + -- If the send fails, ignore it. + send dbus msg 0 `catchDyn` (\(DBus.Error _ _) -> return 0) + return () + +pangoColor :: String -> String -> String +pangoColor fg = wrap left right + where + left = "<span foreground=\"" ++ fg ++ "\">" + right = "</span>" + +pangoSanitize :: String -> String +pangoSanitize = foldr sanitize "" + where + sanitize '>' xs = ">" ++ xs + sanitize '<' xs = "<" ++ xs + sanitize '\"' xs = """ ++ xs + sanitize '&' xs = "&" ++ xs + sanitize x xs = x:xs |