packages feed

gtk-sni-tray (empty) → 0.1.0.0

raw patch · 7 files changed

+601/−0 lines, 7 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, dbus, directory, gi-dbusmenugtk3, gi-gdk, gi-gdkpixbuf, gi-glib, gi-gtk, gtk-sni-tray, gtk-strut, hslogger, optparse-applicative, status-notifier-item, text, transformers, unix

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for gtk-sni-tray++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,19 @@+gtk-sni-tray+===============++gtk-sni-tray provides a [StatusNotifiedHost](https://www.freedesktop.org/wiki/Specifications/StatusNotifierItem/StatusNotifierHost/) widget written using the gtk+3 bindings for haskell provided by [gi-gtk](https://hackage.haskell.org/package/gi-gtk). It also provides a simple standalone executable, `gtk-sni-tray-standalone`, that is configured with command line arguments. This executable will run the aforementioned widget by itself in a strut window, on each monitor for each it is requested.++taffybar+----------+It is generally recommeneded that you use this widget with [taffybar](https://github.com/travitch/taffybar), which will allow you to combine it with other useful widgets, and will give more flexibility in configuration.++StatusNotifierWatcher+--------------------------+By default, it is assumed that you are running an isolated StatusNotifierWatcher daemon. [status-notifier-item](https://github.com/IvanMalison/status-notifier-item) provides a StatusNotifierWatcher executable that you can use for this purpose. If you get an error like++```+MethodError {methodErrorName = ErrorName "org.freedesktop.DBus.Error.ServiceUnknown", methodErrorSerial = Serial 7, methodErrorSender = Just (BusName "org.freedesktop.DBus"), methodErrorDestination = Just (BusName ":1.549"), methodErrorBody = [Variant "The name org.kde.StatusNotifierWatcher was not provided by any .service files"]}+```++when you start `gtk-sni-tray-standalone` it is probably because you have not started a StatusNotifierWatcher on your system. You can solve this problem by passing the `--watcher` flag to `gtk-sni-tray-standalone`, but this is not recommeneded, because many SNI processes do not monitor for new watcher processes, and so may not immediately register when this new watcher is started.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           Control.Monad+import           DBus.Client+import           Data.Int+import           Data.Maybe+import           Data.Ratio+import           Data.Semigroup ((<>))+import qualified Data.Text as T+import qualified GI.Gtk as Gtk+import qualified GI.Gdk as Gdk+import           Graphics.UI.GIGtkStrut+import           Options.Applicative+import qualified StatusNotifier.Host.Service as Host+import           StatusNotifier.Tray+import           System.Log.Logger+import           System.Posix.Process+import           Text.Printf++positionP :: Parser StrutPosition+positionP = fromMaybe TopPos <$> optional+  (   flag' TopPos+  (  long "top"+  <> help "Position the bar at the top of the screen"+  )+  <|> flag' BottomPos+  (  long "bottom"+  <> help "Position the bar at the bottom of the screen"+  )+  <|> flag' LeftPos+  (  long "left"+  <> help "Position the bar on the left side of the screen"+  )+  <|> flag' RightPos+  (  long "right"+  <> help "Position the bar on the right side of the screen"+  ))++alignmentP :: Parser StrutAlignment+alignmentP = fromMaybe Center <$> optional+  (   flag' Beginning+  (  long "beginning"+  <> help "Use beginning alignment"+  )+  <|> flag' Center+  (  long "center"+  <> help "Use center alignment"+  )+  <|> flag' End+  (  long "end"+  <> help "Use end alignment"+  ))++sizeP :: Parser Int32+sizeP =+  option auto+  (  long "size"+  <> short 's'+  <> help "Set the size of the bar"+  <> value 30+  <> metavar "SIZE"+  )++paddingP :: Parser Int32+paddingP =+  option auto+  (  long "padding"+  <> short 'p'+  <> help "Set the padding of the bar"+  <> value 0+  <> metavar "PADDING"+  )++monitorNumberP :: Parser [Int32]+monitorNumberP = many $+  option auto+  (  long "monitor"+  <> short 'm'+  <> help "Run on the selected monitor"+  <> metavar "MONITOR"+  )++logP :: Parser Priority+logP =+  option auto+  (  long "log-level"+  <> short 'l'+  <> help "Set the log level"+  <> metavar "LEVEL"+  <> value WARNING+  )++colorP :: Parser String+colorP =+  strOption+  (  long "color"+  <> short 'c'+  <> help "Set the background color of the tray"+  <> metavar "COLOR"+  <> value "000000"+  )++expandP :: Parser Bool+expandP =+  switch+  (  long "expand"+  <> help "Whether to let icons expand into the space allocated to the tray"+  <> short 'e'+  )++startWatcherP :: Parser Bool+startWatcherP =+  switch+  (  long "watcher"+  <> help "Whether to start a Watcher to handle SNI registration"+  <> short 'w'+  )++getColor colorString = do+  rgba <- Gdk.newZeroRGBA+  colorParsed <- Gdk.rGBAParse rgba (T.pack colorString)+  unless colorParsed $ do+    logM "StatusNotifier.Tray" WARNING "Failed to parse provided color"+    void $ Gdk.rGBAParse rgba "000000"+  return rgba++buildWindows :: StrutPosition+             -> StrutAlignment+             -> Int32+             -> Int32+             -> [Int32]+             -> Priority+             -> String+             -> Bool+             -> Bool+             -> IO ()+buildWindows pos align size padding monitors priority colorString expand startWatcher = do+  Gtk.init Nothing+  logger <- getLogger "StatusNotifier"+  saveGlobalLogger $ setLevel priority logger+  client <- connectSession+  logger <- getRootLogger+  pid <- getProcessID+  -- Okay to use a forced pattern here because we want to die if this fails anyway+  Just host <- Host.build Host.defaultParams+    { Host.dbusClient = Just client+    , Host.uniqueIdentifier = printf "standalone-%s" $ show pid+    , Host.startWatcher = startWatcher+    }+  let c1 = defaultStrutConfig+           { strutPosition = pos+           , strutAlignment = align+           , strutXPadding = padding+           , strutYPadding = padding+           }+      defaultRatio = ScreenRatio (4 % 5)+      configBase = case pos of+             TopPos -> c1+                       { strutHeight = ExactSize size+                       , strutWidth = defaultRatio+                       }+             BottomPos -> c1+                          { strutHeight = ExactSize size+                          , strutWidth = defaultRatio+                          }+             RightPos -> c1+                         { strutHeight = defaultRatio+                         , strutWidth = ExactSize size+                         }+             LeftPos -> c1+                        { strutHeight = defaultRatio+                        , strutWidth = ExactSize size+                        }+      buildWithConfig config = do+        let orientation =+              case strutPosition config of+                TopPos -> Gtk.OrientationHorizontal+                BottomPos -> Gtk.OrientationHorizontal+                _ -> Gtk.OrientationVertical+        tray <- buildTray TrayParams+                    { trayClient = client+                    , trayOrientation = orientation+                    , trayHost = host+                    , trayImageSize = Expand+                    , trayIconExpand = expand+                    }+        window <- Gtk.windowNew Gtk.WindowTypeToplevel+        setupStrutWindow config window+        (Just <$> getColor colorString) >>=+             Gtk.widgetOverrideBackgroundColor window [Gtk.StateFlagsNormal]+        Gtk.containerAdd window tray+        Gtk.widgetShowAll window+      runForMonitor monitor =+        buildWithConfig configBase { strutMonitor = Just monitor }+  if null monitors+  then buildWithConfig configBase+  else mapM_ runForMonitor monitors+  Gtk.main++parser :: Parser (IO ())+parser = buildWindows <$> positionP <*> alignmentP <*> sizeP <*> paddingP <*>+         monitorNumberP <*> logP <*> colorP <*> expandP <*> startWatcherP++main :: IO ()+main = do+  -- TODO: start watcher if it doesn't exist+  join $ execParser $ info (parser <**> helper)+               (  fullDesc+               <> progDesc "Run a standalone StatusNotifierItem/AppIndicator tray")
+ gtk-sni-tray.cabal view
@@ -0,0 +1,76 @@+-- This file has been generated from package.yaml by hpack version 0.27.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 5b235b7f79be706daee2b55416bfcd57ccbe4b938c9a8946952054d97c72d088++name:           gtk-sni-tray+version:        0.1.0.0+synopsis:       A standalone StatusNotifierItem/AppIndicator tray+description:    Please see the README on Github at <https://github.com/IvanMalison/gtk-sni-tray#readme>+category:       System+homepage:       https://github.com/IvanMalison/gtk-sni-tray#readme+bug-reports:    https://github.com/IvanMalison/gtk-sni-tray/issues+author:         Ivan Malison+maintainer:     IvanMalison@gmail.com+copyright:      2018 Ivan Malison+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/IvanMalison/gtk-sni-tray++library+  exposed-modules:+      StatusNotifier.Tray+  other-modules:+      Paths_gtk_sni_tray+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring+    , containers+    , dbus >=1.0.0 && <2.0.0+    , directory+    , gi-dbusmenugtk3+    , gi-gdk+    , gi-gdkpixbuf >=2.0.15+    , gi-glib+    , gi-gtk >=3.0.21+    , hslogger+    , status-notifier-item >=0.2.0.0 && <0.3.0.0+    , text+    , transformers+    , unix+  pkgconfig-depends:+      gtk+-3.0+  default-language: Haskell2010++executable gtk-sni-tray-standalone+  main-is: Main.hs+  other-modules:+      Paths_gtk_sni_tray+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , dbus >=1.0.0 && <2.0.0+    , gi-gdk+    , gi-gtk >=3.0.21+    , gtk-sni-tray+    , gtk-strut+    , hslogger+    , optparse-applicative+    , status-notifier-item >=0.2.0.0 && <0.3.0.0+    , text+    , unix+  default-language: Haskell2010
+ src/StatusNotifier/Tray.hs view
@@ -0,0 +1,261 @@+{-# LANGUAGE OverloadedLabels #-}+module StatusNotifier.Tray where++import           Control.Concurrent.MVar as MV+import           Control.Monad+import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Maybe+import           Control.Monad.Trans.Reader+import           DBus.Client+import qualified DBus.Internal.Types as DBusTypes+import qualified Data.ByteString as BS+import           Data.ByteString.Unsafe+import           Data.Coerce+import           Data.Int+import           Data.List+import qualified Data.Map.Strict as Map+import           Data.Maybe+import           Data.Ord+import qualified Data.Text as T+import           Foreign.Ptr+import qualified GI.DbusmenuGtk3.Objects.Menu as DM+import qualified GI.GLib as GLib+import           GI.GLib.Structs.Bytes+import qualified GI.Gdk as Gdk+import           GI.Gdk.Enums+import           GI.Gdk.Objects.Screen+import           GI.GdkPixbuf.Callbacks+import           GI.GdkPixbuf.Enums+import           GI.GdkPixbuf.Objects.Pixbuf+import           GI.GdkPixbuf.Structs.Pixdata+import qualified GI.Gtk as Gtk+import           GI.Gtk.Flags+import qualified GI.Gtk.Objects.Box as Gtk+import qualified GI.Gtk.Objects.HBox as Gtk+import           GI.Gtk.Objects.IconTheme+import           StatusNotifier.Host.Service+import qualified StatusNotifier.Item.Client as IC+import           StatusNotifier.Util+import           System.Directory+import           System.Log.Logger+import           System.Posix.Process+import           Text.Printf++trayLogger = logM "StatusNotifier.Tray"++themeLoadFlags = [IconLookupFlagsGenericFallback, IconLookupFlagsUseBuiltin]++getThemeWithDefaultFallbacks :: String -> IO IconTheme+getThemeWithDefaultFallbacks themePath = do+  themeForIcon <- iconThemeNew+  defaultTheme <- iconThemeGetDefault++  runMaybeT $ do+    screen <- MaybeT screenGetDefault+    lift $ iconThemeSetScreen themeForIcon screen++  filePaths <- iconThemeGetSearchPath defaultTheme+  iconThemeAppendSearchPath themeForIcon themePath+  mapM_ (iconThemeAppendSearchPath themeForIcon) filePaths++  return themeForIcon++getIconPixbufByName :: IsIconTheme it =>  Int32 -> T.Text -> it -> IO (Maybe Pixbuf)+getIconPixbufByName size name themeForIcon = do+  trayLogger DEBUG "Getting Pixbuf from name"+  let panelName = T.pack $ printf "%s-panel" name+  hasPanelIcon <- iconThemeHasIcon themeForIcon panelName+  hasIcon <- iconThemeHasIcon themeForIcon name+  if hasIcon || hasPanelIcon+  then do+    let targetName = if hasPanelIcon then panelName else name+    iconThemeLoadIcon themeForIcon targetName size themeLoadFlags+  else do+    -- Try to load the icon as a filepath+    let nameString = T.unpack name+    fileExists <- doesFileExist nameString+    if fileExists+    then Just <$> pixbufNewFromFile name+    else return Nothing++getIconPixbufFromByteString :: Int32 -> Int32 -> BS.ByteString -> IO Pixbuf+getIconPixbufFromByteString width height byteString = do+  trayLogger DEBUG "Getting Pixbuf from bytestring"+  bytes <- bytesNew $ Just byteString+  let bytesPerPixel = 4+      rowStride = width * bytesPerPixel+      sampleBits = 8+  pixbufNewFromBytes bytes ColorspaceRgb True sampleBits width height rowStride++data ItemContext = ItemContext+  { contextName :: DBusTypes.BusName+  , contextMenu :: Maybe DM.Menu+  , contextImage :: Gtk.Image+  , contextButton :: Gtk.EventBox+  }++data TrayImageSize = Expand | TrayImageSize Int32++data TrayParams = TrayParams+  { trayHost :: Host+  , trayClient :: Client+  , trayOrientation :: Gtk.Orientation+  , trayImageSize :: TrayImageSize+  , trayIconExpand :: Bool+  }++buildTray :: TrayParams -> IO Gtk.Box+buildTray TrayParams { trayHost = Host+                       { itemInfoMap = getInfoMap+                       , addUpdateHandler = addHandler+                       , removeUpdateHandler = removeHandler+                       }+                     , trayClient = client+                     , trayOrientation = orientation+                     , trayImageSize = imageSize+                     , trayIconExpand = shouldExpand+                     } = do+  trayLogger INFO "Building tray"++  trayBox <- Gtk.boxNew orientation 0+  contextMap <- MV.newMVar Map.empty++  let getContext name = Map.lookup name <$> MV.readMVar contextMap++      getSize rectangle =+        case orientation of+          Gtk.OrientationHorizontal ->+            Gdk.getRectangleHeight rectangle+          Gtk.OrientationVertical ->+            Gdk.getRectangleWidth rectangle++      getInfo def name = fromMaybe def . Map.lookup name <$> getInfoMap++      updateIconFromInfo info@ItemInfo { itemServiceName = name } =+        getContext name >>= updateIcon+        where updateIcon Nothing = updateHandler ItemAdded info+              updateIcon (Just ItemContext { contextImage = image } ) = do+                size <- case imageSize of+                          TrayImageSize size -> return size+                          Expand -> Gtk.widgetGetAllocation image >>= getSize+                getScaledPixBufFromInfo size info >>=+                                  let handlePixbuf mpbuf =+                                        if isJust mpbuf+                                        then Gtk.imageSetFromPixbuf image mpbuf+                                        else updateHandler ItemRemoved info+                                  in handlePixbuf++      updateHandler ItemAdded+                    info@ItemInfo { menuPath = pathForMenu+                                  , itemServiceName = serviceName+                                  , itemServicePath = servicePath+                                  } =+        do+          let serviceNameStr = coerce serviceName+              servicePathStr = coerce servicePath :: String+              serviceMenuPathStr = coerce <$> pathForMenu+              logText = printf "Adding widget for %s - %s."+                        serviceNameStr servicePathStr++          trayLogger INFO logText++          button <- Gtk.eventBoxNew++          image <-+            case imageSize of+              Expand -> do+                traySize <- Gtk.widgetGetAllocation trayBox >>= getSize+                image <- getScaledPixBufFromInfo traySize info >>= Gtk.imageNewFromPixbuf+                let setPixbuf rectangle =+                      do+                        size <- getSize rectangle+                        pixBuf <- getInfo info serviceName >>= getScaledPixBufFromInfo size+                        Gtk.imageSetFromPixbuf image pixBuf+                Gtk.onWidgetSizeAllocate image setPixbuf+                return image+              TrayImageSize size -> do+                pixBuf <- getScaledPixBufFromInfo size info+                image <- Gtk.imageNewFromPixbuf pixBuf+                return image++          Gtk.containerAdd button image++          maybeMenu <- sequenceA $ DM.menuNew (T.pack serviceNameStr) .+                       T.pack <$> serviceMenuPathStr++          let context =+                ItemContext { contextName = serviceName+                            , contextMenu = maybeMenu+                            , contextImage = image+                            , contextButton = button+                            }+              popupItemForMenu menu =+                Gtk.menuPopupAtWidget menu image+                   GravitySouthWest GravityNorthWest Nothing+              popupItemMenu =+                maybe activateItem popupItemForMenu maybeMenu >> return False+              activateItem = void $ IC.activate client serviceName servicePath 0 0++          Gtk.onWidgetButtonPressEvent button $ const popupItemMenu++          MV.modifyMVar_ contextMap $ return . Map.insert serviceName context++          Gtk.widgetShowAll button+          Gtk.boxPackStart trayBox button shouldExpand True 0++      updateHandler ItemRemoved ItemInfo { itemServiceName = name }+        = getContext name >>= removeWidget+        where removeWidget Nothing =+                trayLogger INFO "Attempt to remove widget with unrecognized service name."+              removeWidget (Just ItemContext { contextButton = widgetToRemove }) =+                do+                  Gtk.containerRemove trayBox widgetToRemove+                  MV.modifyMVar_ contextMap $ return . Map.delete name++      updateHandler IconUpdated i = updateIconFromInfo i++      updateHandler IconNameUpdated i = updateIconFromInfo i++      updateHandler _ _ = return ()++      logItemInfo info message =+        trayLogger INFO $ printf "%s - %s pixmap count: %s" message+               (show $ info { iconPixmaps = []})+               (show $ length $ iconPixmaps info)++      getScaledPixBufFromInfo size info = runMaybeT $ do+        pixBuf <- MaybeT $ getPixBufFromInfo size info+        MaybeT $ pixbufScaleSimple pixBuf size size InterpTypeBilinear++      getPixBufFromInfo size+                        info@ItemInfo { iconName = name+                                      , iconThemePath = mpath+                                      , iconPixmaps = pixmaps+                                      } = do+        logItemInfo info "Getting pixbuf"+        themeForIcon <- maybe iconThemeGetDefault getThemeWithDefaultFallbacks mpath+        let tooSmall (w, h, _) = w < size || h < size+            largeEnough = filter (not . tooSmall) pixmaps+            orderer (w1, h1, _) (w2, h2, _) =+              case comparing id w1 w2 of+                EQ -> comparing id h1 h2+                a -> a+            selectedPixmap =+              if null largeEnough+              then maximumBy orderer pixmaps+              else minimumBy orderer largeEnough+            getFromPixmaps (w, h, p) =+              if BS.length p == 0+              then Nothing+              else Just $ getIconPixbufFromByteString w h p+        if null pixmaps+        then getIconPixbufByName size (T.pack name) themeForIcon+        else sequenceA $ getFromPixmaps selectedPixmap++      uiUpdateHandler updateType info =+        void $ Gdk.threadsAddIdle GLib.PRIORITY_DEFAULT $+             updateHandler updateType info >> return False++  handlerId <- addHandler uiUpdateHandler+  _ <- Gtk.onWidgetDestroy trayBox $ removeHandler handlerId+  return trayBox