From cb08446df4da47b219d9230ed4890b5bf0f837c4 Mon Sep 17 00:00:00 2001
From: Jonathan Daugherty <cygnus@foobox.com>
Date: Wed, 15 Jul 2020 10:42:29 -0700
Subject: [PATCH] Graphics.Vty: add setWindowTitle (fixes #188)

---
 src/Graphics/Vty.hs | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

diff --git a/src/Graphics/Vty.hs b/src/Graphics/Vty.hs
index 87f8831..923eae1 100644
--- a/src/Graphics/Vty.hs
+++ b/src/Graphics/Vty.hs
@@ -33,6 +33,7 @@
 module Graphics.Vty
   ( Vty(..)
   , mkVty
+  , setWindowTitle
   , Mode(..)
   , module Graphics.Vty.Config
   , module Graphics.Vty.Input
@@ -54,6 +55,9 @@ import Graphics.Vty.Attributes
 import Graphics.Vty.UnicodeWidthTable.IO
 import Graphics.Vty.UnicodeWidthTable.Install
 
+import Data.Char (isPrint, showLitChar)
+import qualified Data.ByteString.Char8 as BS8
+
 import qualified Control.Exception as E
 import Control.Monad (when)
 import Control.Concurrent.STM
@@ -224,3 +228,24 @@ internalMkVty input out = do
                  , shutdown = shutdownIo
                  , isShutdown = shutdownStatus
                  }
+
+-- | Set the terminal window title string.
+--
+-- This function emits an Xterm-compatible escape sequence that we
+-- anticipate will work for essentially all modern terminal emulators.
+-- Ideally we'd use a terminal capability for this, but there does not
+-- seem to exist a termcap for setting window titles. If you find that
+-- this function does not work for a given terminal emulator, please
+-- report the issue.
+--
+-- For details, see:
+--
+-- https://tldp.org/HOWTO/Xterm-Title-3.html
+setWindowTitle :: Vty -> String -> IO ()
+setWindowTitle vty title = do
+    let sanitize :: String -> String
+        sanitize = concatMap sanitizeChar
+        sanitizeChar c | not (isPrint c) = showLitChar c ""
+                       | otherwise = [c]
+    let buf = BS8.pack $ "\ESC]2;" <> sanitize title <> "\007"
+    outputByteBuffer (outputIface vty) buf