tianbar 0.3.5.0 → 0.3.6.0
raw patch · 10 files changed
+335/−151 lines, 10 files
Files
- scripts/dbus.js +1/−0
- scripts/location_shim.js +1/−0
- scripts/power.js +186/−19
- scripts/time.js +1/−0
- scripts/weather.js +1/−0
- scripts/xmonad.js +1/−0
- src/System/Tianbar/DBus.hs +45/−126
- src/System/Tianbar/DBus/JSON.hs +87/−0
- src/System/Tianbar/UriOverride.hs +10/−5
- tianbar.cabal +2/−1
scripts/dbus.js view
@@ -2,6 +2,7 @@ * A plugin to receive DBus events. */ define(['jquery'], function ($) {+ "use strict"; function copyProperties(properties, from, to) { $.each(properties, function(_, x) { if (x in from) {
scripts/location_shim.js view
@@ -4,6 +4,7 @@ * Requires 'jquery' to be available through RequireJS. */ define(['jquery'], function ($) {+ "use strict"; var my_geolocation; navigator.geolocation = {};
scripts/power.js view
@@ -1,21 +1,186 @@ /* * A plugin to show the power (e.g. battery) state through UPower. *- * Requires 'jquery' to be available through RequireJS.+ * Requires 'jquery' and 'moment' to be available through RequireJS. */-define(['jquery', './dbus'], function ($, dbus) {- var self = {- /**- * Format an HTML element displaying the device status.- * @param st {Object} The device status, as returned by UPower- */- formatDevice: function (st) {- // TODO: better default formatting- return st.Percentage;+define(['jquery', 'moment', './dbus'], function ($, moment, dbus) {+ "use strict";++ var self = {};++ self.HOUR = 3600;++ self.TERMINAL_HEIGHT = 6;+ self.HEIGHT = 8;+ self.WIDTH = 25;++ self.FILL_COLOR = 'black';+ self.FILL_LOW_COLOR = 'red';+ self.EMPTY_COLOR = 'transparent';+ self.SEGMENT_COLOR = '#888';+ self.OUTLINE_COLOR = 'black';++ self.DEFAULT_TIME = 4 * self.HOUR;+ self.LOW_TIME = self.HOUR / 4;++ self.DEVICE_STATE = {+ Unknown: 0,+ Charging: 1,+ Discharging: 2,+ Empty: 3,+ FullyCharged: 4,+ PendingCharge: 5,+ PendingDischarge: 6+ };++ self.DEVICE_TYPE = {+ Unknown: 0,+ LinePower: 1,+ Battery: 2,+ UPS: 3,+ Monitor: 4,+ Mouse: 5,+ Keyboard: 6,+ PDA: 7,+ Phone: 8+ };++ self.block = function (width, color, border, leftBorder) {+ var result = $('<div />');+ result.css({+ 'display': 'inline-block',+ 'background-color': color,+ 'width': width - (border ? 1 : 0),+ 'height': self.HEIGHT,+ 'border-top': '1px solid black',+ 'border-bottom': '1px solid black',+ 'margin-top': -1,+ 'margin-bottom': -1+ });+ if (border) {+ result.css({+ 'padding-right': -1,+ 'border-right-width': '1px',+ 'border-right-style': 'solid',+ 'border-right-color': border,+ }); }+ if (leftBorder) {+ result.css({+ 'border-left-width': '1px',+ 'border-left-style': 'solid',+ 'border-left-color': leftBorder,+ });+ }+ return result; }; - function updatePower() {+ /**+ * Format an HTML element displaying the device status.+ * @param st {Object} The device status, as returned by UPower+ */+ self.formatDevice = function (st) {+ if (st.Type == self.DEVICE_TYPE.LinePower) {+ return '';+ }++ var percentage = st.Percentage;++ var timeToEmpty = st.TimeToEmpty;+ var timeToFull = st.TimeToFull;++ var haveTTE = timeToEmpty !== 0;+ var haveTTF = timeToFull !== 0;++ // Sanity checks if one or the other time is missing+ if (haveTTE && !haveTTF) {+ if (percentage > 0) {+ timeToFull = timeToEmpty * (100 - percentage) / percentage;+ } else {+ timeToFull = self.DEFAULT_TIME;+ }+ } else if (haveTTF && !haveTTE) {+ if (percentage < 100) {+ timeToEmpty = timeToFull * percentage / (100 - percentage);+ } else {+ timeToFull = self.DEFAULT_TIME;+ }+ } else if (!haveTTF && !haveTTE) {+ timeToEmpty = self.DEFAULT_TIME * percentage;+ timeToFull = self.DEFAULT_TIME * (100 - percentage);+ }++ var hour_width = self.WIDTH * self.HOUR / (timeToEmpty + timeToFull);++ var result = $('<div />').css({+ 'display': 'inline-block'+ });++ var fillColor = timeToEmpty > self.LOW_TIME ?+ self.FILL_COLOR : self.FILL_LOW_COLOR;+ var firstSegment = true;+ if (haveTTE) {+ for (; timeToEmpty > self.HOUR; timeToEmpty -= self.HOUR) {+ result.append(self.block(+ hour_width,+ fillColor,+ self.SEGMENT_COLOR,+ firstSegment ? self.OUTLINE_COLOR : null+ ));+ firstSegment = false;+ }+ }+ result.append(self.block(+ timeToEmpty / self.HOUR * hour_width,+ fillColor,+ null,+ firstSegment ? self.OUTLINE_COLOR : null+ ));++ if (haveTTF) {+ for (; timeToFull > self.HOUR; timeToFull -= self.HOUR) {+ result.append(self.block(+ hour_width,+ self.EMPTY_COLOR,+ self.SEGMENT_COLOR+ ));+ }+ }+ result.append(self.block(+ timeToFull / self.HOUR * hour_width,+ self.EMPTY_COLOR,+ self.OUTLINE_COLOR+ ));++ result.append($('<span>').css({+ 'display': 'inline-block',+ 'background-color': self.OUTLINE_COLOR,+ 'width': 1,+ 'height': self.TERMINAL_HEIGHT,+ 'margin-top': (self.HEIGHT - self.TERMINAL_HEIGHT) / 2,+ 'margin-bottom': (self.HEIGHT - self.TERMINAL_HEIGHT) / 2+ }));++ var title = percentage + '%';+ if (st.TimeToEmpty !== 0) {+ title += ' (' + moment.duration(st.TimeToEmpty, 's').humanize() + ')';+ }+ if (st.Type != self.DEVICE_TYPE.Battery) {+ title += '\n' + st.Vendor + ' ' + st.Model;+ }++ result.attr('title', title);++ if (st.State === self.DEVICE_STATE.Charging) {+ result.append('⚡');+ }++ return result;+ };++ self.updated = $.Callbacks();++ self.refresh = function () { dbus.system.call({ 'destination': 'org.freedesktop.UPower', 'path': '/org/freedesktop/UPower',@@ -41,22 +206,24 @@ var widget = $('.widget-power'); widget.empty();- // TODO: externalize styling $.each(results, function (_, st) { st = st.body[0];- // Do not show AC power- if (st.Type === 1) {- return;- } widget.append(self.formatDevice(st)); });++ self.updated.fire(); }); });- }+ }; $(document).ready(function () {- updatePower();- setInterval(updatePower, 10000);+ dbus.system.listen(+ {+ iface: 'org.freedesktop.UPower'+ },+ self.refresh+ );+ self.refresh(); }); return self;
scripts/time.js view
@@ -10,6 +10,7 @@ * (this can be done by providing 'moment-with-langs.js' as 'moment'). */ define(['jquery', 'moment'], function ($, moment) {+ "use strict"; var config = { format: 'llll' };
scripts/weather.js view
@@ -9,6 +9,7 @@ * functional, so location_shim.js is required to be loaded before. */ define(['jquery', 'moment'], function ($, moment) {+ "use strict"; var APPID = '41fff6331bf67509b73740427d14c562'; var SECOND = 1000; // ms
scripts/xmonad.js view
@@ -11,6 +11,7 @@ * The plugin requires 'jquery' to be available through RequireJS. */ define(['jquery', './dbus'], function ($, dbus) {+ "use strict"; var change = $.Callbacks(); dbus.session.listen(
src/System/Tianbar/DBus.hs view
@@ -1,17 +1,16 @@ {-# Language OverloadedStrings #-} module System.Tianbar.DBus where +-- DBus connectivity+ import Control.Concurrent.MVar import Control.Monad import Data.Aeson hiding (Array)-import Data.Int import Data.List import Data.List.Split-import qualified Data.Map as M import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as E-import Data.Word import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk.WebKit.WebView@@ -21,107 +20,28 @@ import Network.URI +import System.Tianbar.DBus.JSON () import System.Tianbar.UriOverride --- DBus callback override+type DBusState = MVar DBusConn -type DBusClient = MVar Client+data DBusConn = DBusConn { dbusSession :: Client+ , dbusSystem :: Client+ } -data DBusState = DBusState { dbusSession :: DBusClient- , dbusSystem :: DBusClient- }+connectState :: IO DBusConn+connectState = do+ session <- connectSession+ system <- connectSystem+ return $ DBusConn session system initDBusState :: IO DBusState-initDBusState = do- session <- connectSession >>= newMVar- system <- connectSystem >>= newMVar- return $ DBusState session system+initDBusState = connectState >>= newMVar reloadDBusState :: DBusState -> IO ()-reloadDBusState dbus = do- modifyMVar_ (dbusSession dbus) $ \client -> do- disconnect client- connectSession- modifyMVar_ (dbusSystem dbus) $ \client -> do- disconnect client- connectSystem--instance ToJSON Variant where- toJSON v = case variantType v of- TypeBoolean -> let Just b = fromVariant v :: Maybe Bool in toJSON b- TypeWord8 -> let Just i = fromVariant v :: Maybe Word8 in toJSON i- TypeWord16 -> let Just i = fromVariant v :: Maybe Word16 in toJSON i- TypeWord32 -> let Just i = fromVariant v :: Maybe Word32 in toJSON i- TypeWord64 -> let Just i = fromVariant v :: Maybe Word64 in toJSON i- TypeInt16 -> let Just i = fromVariant v :: Maybe Int16 in toJSON i- TypeInt32 -> let Just i = fromVariant v :: Maybe Int32 in toJSON i- TypeInt64 -> let Just i = fromVariant v :: Maybe Int64 in toJSON i- TypeDouble -> let Just i = fromVariant v :: Maybe Double in toJSON i- TypeString -> let Just s = fromVariant v :: Maybe String in toJSON s-- TypeSignature -> let Just s = fromVariant v :: Maybe Signature in- toJSON $ formatSignature s- TypeObjectPath -> let Just p = fromVariant v :: Maybe ObjectPath in- toJSON $ formatObjectPath p-- TypeVariant -> let Just n = fromVariant v :: Maybe Variant in toJSON n- TypeArray _ -> let Just a = fromVariant v :: Maybe Array in- toJSON $ arrayItems a- TypeDictionary _ _ -> let Just d = fromVariant v :: Maybe Dictionary in- toJSON $ M.fromList $ map variantStringKey $ dictionaryItems d- TypeStructure _ -> let Just a = fromVariant v :: Maybe Structure in- toJSON $ structureItems a--variantString :: Variant -> String-variantString v = s- where Just s = case variantType v of- TypeString -> fromVariant v- TypeVariant -> Just $ variantString v'- where Just v' = fromVariant v- _ -> Just $ show v--variantStringKey :: (Variant, Variant) -> (String, Variant)-variantStringKey (k, v) = (variantString k, v)--instance ToJSON ObjectPath where- toJSON = toJSON . formatObjectPath--instance ToJSON InterfaceName where- toJSON = toJSON . formatInterfaceName--instance ToJSON MemberName where- toJSON = toJSON . formatMemberName--instance ToJSON Signal where- toJSON s = object [ "path" .= toJSON (signalPath s)- , "iface" .= toJSON (signalInterface s)- , "member" .= toJSON (signalMember s)- ]--instance ToJSON ErrorName where- toJSON = toJSON . formatErrorName--instance ToJSON Serial where- toJSON = toJSON . serialValue--instance ToJSON BusName where- toJSON = toJSON . formatBusName--instance ToJSON MethodError where- toJSON e = object [ "name" .= toJSON (methodErrorName e)- , "serial" .= toJSON (methodErrorSerial e)- , "sender" .= toJSON (methodErrorSender e)- , "destination" .= toJSON (methodErrorDestination e)- , "body" .= toJSON (methodErrorBody e)- , "message" .= toJSON (methodErrorMessage e)- ]--instance ToJSON MethodReturn where- toJSON r = object [ "serial" .= toJSON (methodReturnSerial r)- , "sender" .= toJSON (methodReturnSender r)- , "destination" .= toJSON (methodReturnDestination r)- , "body" .= toJSON (methodReturnBody r)- ]+reloadDBusState state = modifyMVar_ state $ \dbus -> do+ mapM_ disconnect [dbusSession dbus, dbusSystem dbus]+ connectState callback :: WebView -> Int -> Signal -> IO () callback wk index sig =@@ -140,56 +60,55 @@ returnJSON = returnContent . T.unpack . E.decodeUtf8 . encode . toJSON dbusOverride :: WebView -> DBusState -> UriOverride-dbusOverride wk dbus = withScheme "dbus:" $ \uri -> do- let [busName, busCall] = splitOn "/" (uriPath uri)- let bus = uriBus busName dbus- withMVar bus $ \client -> case busCall of- "listen" -> do- dbusListen wk client uri+dbusOverride wk state = withScheme "dbus:" $ \uri -> do+ let busCall = splitOn "/" (uriPath uri)+ let params = parseQuery uri+ case busCall of+ [bus, "listen"] -> withMVar state $ \dbus -> do+ let client = uriBus bus dbus+ dbusListen wk client params returnContent ""- "call" -> do- result <- dbusCall wk client uri+ [bus, "call"] -> withMVar state $ \dbus -> do+ let client = uriBus bus dbus+ result <- dbusCall client params returnJSON result _ -> returnContent "" -dbusListen :: WebView -> Client -> URI -> IO ()-dbusListen wk client uri = do- let params = parseQuery uri- let matcher = matchRuleUri uri+dbusListen :: WebView -> Client -> URIParams -> IO ()+dbusListen wk client params = do+ let matcher = matchRuleUri params let (Just index) = liftM read $ lookupQueryParam "index" params _ <- addMatch client matcher $ callback wk index return () -dbusCall :: WebView -> Client -> URI -> IO (Either MethodError MethodReturn)-dbusCall _ client uri = do- let mcall = methodCallUri uri+dbusCall :: Client -> URIParams -> IO (Either MethodError MethodReturn)+dbusCall client params = do+ let mcall = methodCallUri params call client mcall -uriBus :: String -> DBusState -> MVar Client+uriBus :: String -> DBusConn -> Client uriBus "session" = dbusSession uriBus "system" = dbusSystem uriBus _ = error "Unknown bus" -matchRuleUri :: URI -> MatchRule-matchRuleUri uri = matchAny { matchSender = Nothing- , matchDestination = Nothing- , matchPath = lookupQueryParam "path" params >>= parseObjectPath- , matchInterface = lookupQueryParam "iface" params >>= parseInterfaceName- , matchMember = lookupQueryParam "member" params >>= parseMemberName- }- where params = parseQuery uri+matchRuleUri :: URIParams -> MatchRule+matchRuleUri params = matchAny { matchSender = Nothing+ , matchDestination = Nothing+ , matchPath = lookupQueryParam "path" params >>= parseObjectPath+ , matchInterface = lookupQueryParam "iface" params >>= parseInterfaceName+ , matchMember = lookupQueryParam "member" params >>= parseMemberName+ } variantFromString :: String -> Variant variantFromString param = case splitOn ":" param of ["string", str] -> toVariant str _ -> error "Invalid variant string" -methodCallUri :: URI -> MethodCall-methodCallUri uri = (methodCall callPath iface member) { methodCallBody = body- , methodCallDestination = dest- }- where params = parseQuery uri- (Just callPath) = parseObjectPath $ getQueryParam "path" params+methodCallUri :: URIParams -> MethodCall+methodCallUri params = (methodCall callPath iface member) { methodCallBody = body+ , methodCallDestination = dest+ }+ where (Just callPath) = parseObjectPath $ getQueryParam "path" params (Just iface) = parseInterfaceName $ getQueryParam "iface" params (Just member) = parseMemberName $ getQueryParam "member" params body = map variantFromString $ getQueryParams "body[]" params
+ src/System/Tianbar/DBus/JSON.hs view
@@ -0,0 +1,87 @@+{-# Language OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module System.Tianbar.DBus.JSON () where++import Data.Aeson hiding (Array)+import Data.Int+import qualified Data.Map as M+import Data.Word++import DBus++instance ToJSON Variant where+ toJSON v = case variantType v of+ TypeBoolean -> let Just b = fromVariant v :: Maybe Bool in toJSON b+ TypeWord8 -> let Just i = fromVariant v :: Maybe Word8 in toJSON i+ TypeWord16 -> let Just i = fromVariant v :: Maybe Word16 in toJSON i+ TypeWord32 -> let Just i = fromVariant v :: Maybe Word32 in toJSON i+ TypeWord64 -> let Just i = fromVariant v :: Maybe Word64 in toJSON i+ TypeInt16 -> let Just i = fromVariant v :: Maybe Int16 in toJSON i+ TypeInt32 -> let Just i = fromVariant v :: Maybe Int32 in toJSON i+ TypeInt64 -> let Just i = fromVariant v :: Maybe Int64 in toJSON i+ TypeDouble -> let Just i = fromVariant v :: Maybe Double in toJSON i+ TypeString -> let Just s = fromVariant v :: Maybe String in toJSON s++ TypeSignature -> let Just s = fromVariant v :: Maybe Signature in+ toJSON $ formatSignature s+ TypeObjectPath -> let Just p = fromVariant v :: Maybe ObjectPath in+ toJSON $ formatObjectPath p++ TypeVariant -> let Just n = fromVariant v :: Maybe Variant in toJSON n+ TypeArray _ -> let Just a = fromVariant v :: Maybe Array in+ toJSON $ arrayItems a+ TypeDictionary _ _ -> let Just d = fromVariant v :: Maybe Dictionary in+ toJSON $ M.fromList $ map variantStringKey $ dictionaryItems d+ TypeStructure _ -> let Just a = fromVariant v :: Maybe Structure in+ toJSON $ structureItems a++variantString :: Variant -> String+variantString v = s+ where Just s = case variantType v of+ TypeString -> fromVariant v+ TypeVariant -> Just $ variantString v'+ where Just v' = fromVariant v+ _ -> Just $ show v++variantStringKey :: (Variant, Variant) -> (String, Variant)+variantStringKey (k, v) = (variantString k, v)++instance ToJSON ObjectPath where+ toJSON = toJSON . formatObjectPath++instance ToJSON InterfaceName where+ toJSON = toJSON . formatInterfaceName++instance ToJSON MemberName where+ toJSON = toJSON . formatMemberName++instance ToJSON Signal where+ toJSON s = object [ "path" .= toJSON (signalPath s)+ , "iface" .= toJSON (signalInterface s)+ , "member" .= toJSON (signalMember s)+ ]++instance ToJSON ErrorName where+ toJSON = toJSON . formatErrorName++instance ToJSON Serial where+ toJSON = toJSON . serialValue++instance ToJSON BusName where+ toJSON = toJSON . formatBusName++instance ToJSON MethodError where+ toJSON e = object [ "name" .= toJSON (methodErrorName e)+ , "serial" .= toJSON (methodErrorSerial e)+ , "sender" .= toJSON (methodErrorSender e)+ , "destination" .= toJSON (methodErrorDestination e)+ , "body" .= toJSON (methodErrorBody e)+ , "message" .= toJSON (methodErrorMessage e)+ ]++instance ToJSON MethodReturn where+ toJSON r = object [ "serial" .= toJSON (methodReturnSerial r)+ , "sender" .= toJSON (methodReturnSender r)+ , "destination" .= toJSON (methodReturnDestination r)+ , "body" .= toJSON (methodReturnBody r)+ ]
src/System/Tianbar/UriOverride.hs view
@@ -23,23 +23,28 @@ multiMap = foldr addElement M.empty where addElement (k, v) = M.insertWith (++) k [v] -parseQuery :: URI -> M.Map String [String]+type URIParams = M.Map String [String]++parseQuery :: URI -> URIParams parseQuery = multiMap . map ((\[a, b] -> (a, b)) . map unEscapeString . splitOn "=") . splitOn "&" . tail . uriQuery -lookupQueryParam :: String -> M.Map String [String] -> Maybe String+lookupQueryParam :: String -> URIParams -> Maybe String lookupQueryParam key queryMap = M.lookup key queryMap >>= \value -> case value of [v] -> Just v _ -> Nothing -getQueryParam :: String -> M.Map String [String] -> String+getQueryParam :: String -> URIParams -> String getQueryParam key = fromJust . lookupQueryParam key -getQueryParams :: String -> M.Map String [String] -> [String]+getQueryParams :: String -> URIParams -> [String] getQueryParams key = fromMaybe [] . M.lookup key +plainContent :: String -> String+plainContent content = "data:text/plain," ++ content+ returnContent :: String -> IO String-returnContent content = return $ "data:text/plain," ++ content+returnContent = return . plainContent
tianbar.cabal view
@@ -1,5 +1,5 @@ name: tianbar-version: 0.3.5.0+version: 0.3.6.0 synopsis: A desktop bar based on WebKit description: A desktop bar using WebKit for rendering as much as possible.@@ -41,6 +41,7 @@ other-modules: System.Tianbar , System.Tianbar.Configuration , System.Tianbar.DBus+ , System.Tianbar.DBus.JSON , System.Tianbar.StrutProperties , System.Tianbar.Systray , System.Tianbar.UriOverride