From 81ec487529b2ff018e7523996f5da52702fe5504 Mon Sep 17 00:00:00 2001
From: Richard Cook <rcook@rcook.org>
Date: Mon, 5 Nov 2018 22:38:54 -0800
Subject: [PATCH] Set correct application title in GNOME shell

---
 GUI/App.hs        | 15 +++++++++++++--
 GUI/Dialogs.hs    |  3 ++-
 GUI/Main.hs       |  2 --
 GUI/MainWindow.hs |  5 +++--
 4 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/GUI/App.hs b/GUI/App.hs
index 9635685b..9bc97e72 100644
--- a/GUI/App.hs
+++ b/GUI/App.hs
@@ -7,23 +7,32 @@
 -- Platform-specific application functionality
 -------------------------------------------------------------------------------
 
-module GUI.App (initApp) where
+module GUI.App (appTitle, initApp) where
 
 -- Mac OS X-specific GTK imports
 #if defined(darwin_HOST_OS)
+import Control.Monad (void)
 import qualified Graphics.UI.Gtk as Gtk
 import qualified Graphics.UI.Gtk.OSX as OSX
 import GUI.DataFiles (loadLogo)
+#else
+import Control.Monad (void)
+import qualified Graphics.UI.Gtk as Gtk
+import System.Glib.Utils (setProgramName)
 #endif
 
 -------------------------------------------------------------------------------
 
+appTitle :: String
+appTitle = "ThreadScope"
+
 #if defined(darwin_HOST_OS)
 
 -- | Initialize application
 -- Perform Mac OS X-specific application initialization
 initApp :: IO ()
 initApp = do
+  void Gtk.initGUI
   app <- OSX.applicationNew
   menuBar <- Gtk.menuBarNew
   OSX.applicationSetMenuBar app menuBar
@@ -36,6 +45,8 @@ initApp = do
 -- | Initialize application
 -- Perform application initialization for non-Mac OS X platforms
 initApp :: IO ()
-initApp = return ()
+initApp = do
+  setProgramName appTitle
+  void Gtk.initGUI
 
 #endif
diff --git a/GUI/Dialogs.hs b/GUI/Dialogs.hs
index 38be694f..7ca90c55 100644
--- a/GUI/Dialogs.hs
+++ b/GUI/Dialogs.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 module GUI.Dialogs where
 
+import GUI.App (appTitle)
 import GUI.DataFiles (loadLogo)
 import Paths_threadscope (version)
 
@@ -17,7 +18,7 @@ aboutDialog parent
  = do dialog <- aboutDialogNew
       logo <- $loadLogo
       set dialog [
-         aboutDialogName      := "ThreadScope",
+         aboutDialogName      := appTitle,
          aboutDialogVersion   := showVersion version,
          aboutDialogCopyright := "Released under the GHC license as part of the Glasgow Haskell Compiler.",
          aboutDialogComments  := "A GHC eventlog profile viewer",
diff --git a/GUI/Main.hs b/GUI/Main.hs
index 66796725..d9711f3d 100644
--- a/GUI/Main.hs
+++ b/GUI/Main.hs
@@ -442,8 +442,6 @@ eventLoop uienv@UIEnv{..} eventlogState = do
 
 runGUI :: Maybe (Either FilePath String) -> IO ()
 runGUI initialTrace = do
-  Gtk.initGUI
-
   App.initApp
 
   uiEnv <- constructUI
diff --git a/GUI/MainWindow.hs b/GUI/MainWindow.hs
index 90ddec3d..57d6d64d 100644
--- a/GUI/MainWindow.hs
+++ b/GUI/MainWindow.hs
@@ -14,6 +14,7 @@ module GUI.MainWindow (
 import Graphics.UI.Gtk as Gtk
 import qualified System.Glib.GObject as Glib
 
+import GUI.App (appTitle)
 import GUI.DataFiles (loadLogo)
 
 -------------------------------------------------------------------------------
@@ -69,11 +70,11 @@ data MainWindowActions = MainWindowActions {
 setFileLoaded :: MainWindow -> Maybe FilePath -> IO ()
 setFileLoaded mainWin Nothing =
   set (mainWindow mainWin) [
-      windowTitle := "ThreadScope"
+      windowTitle := appTitle
     ]
 setFileLoaded mainWin (Just file) =
   set (mainWindow mainWin) [
-      windowTitle := file ++ " - ThreadScope"
+      windowTitle := file ++ " - " ++ appTitle
     ]
 
 setStatusMessage :: MainWindow -> String -> IO ()