Add the ability to set the console title

System/Console/ANSI/Example.hs

@@ -18,6 +18,7 @@ examples = [ cursorMovementExample
            , scrollExample
            , sgrExample
            , cursorVisibilityExample
+           , titleExample
            ]
 
 main :: IO ()
@@ -249,4 +250,18 @@ cursorVisibilityExample = do
 
     showCursor
     pause
-    -- Cursor Demo|
+    -- Cursor Demo|
+
+titleExample :: IO ()
+titleExample = do
+    putStr "Title Demo"
+    pause
+    -- ~/foo/ - ansi-terminal-ex - 83x70
+    ------------------------------------
+    -- Title Demo
+
+    setTitle "Yup, I'm a new title!"
+    pause
+    -- Yup, I'm a new title! - ansi-terminal-ex - 83x70
+    ---------------------------------------------------
+    -- Title Demo

System/Console/ANSI/Unix.hs

@@ -13,7 +13,7 @@ import Data.List
 #include "Common-Include.hs"
 
 
--- | The reference I used for the escape characters in this module was http://en.wikipedia.org/wiki/ANSI_escape_sequences
+-- | The reference I used for the ANSI escape characters in this module was <http://en.wikipedia.org/wiki/ANSI_escape_sequences>.
 csi :: [Int] -> String -> String
 csi args code = "\ESC[" ++ concat (intersperse ";" (map show args)) ++ code
 
@@ -114,4 +114,12 @@ hideCursorCode = csi [] "?25l"
 showCursorCode = csi [] "?25h"
 
 hHideCursor h = hPutStr h hideCursorCode
-hShowCursor h = hPutStr h showCursorCode
+hShowCursor h = hPutStr h showCursorCode
+
+
+-- | Thanks to Brandon S. Allbery and Curt Sampson for pointing me in the right direction on xterm title setting on haskell-cafe.
+-- The "0" signifies that both the title and "icon" text should be set: i.e. the text for the window in the Start bar (or similar)
+-- as well as that in the actual window title.  This is chosen for consistent behaviour between Unixes and Windows.
+setTitleCode title = "\ESC]0;" ++ filter (/= '\007') title ++ "\007"
+
+hSetTitle h title = hPutStr h $ setTitleCode title

System/Console/ANSI/Windows/Emulator.hs

@@ -219,4 +219,12 @@ hHideCursor h = withHandle h $ \handle -> hChangeCursorVisibility handle False
 hShowCursor h = withHandle h $ \handle -> hChangeCursorVisibility handle True
 
 hideCursorCode = ""
-showCursorCode = ""
+showCursorCode = ""
+
+
+-- Windows only supports setting the terminal title on a process-wide basis, so for now we will
+-- assume that that is what the user intended. This will fail if they are sending the command
+-- over e.g. a network link... but that's not really what I'm designing for.
+hSetTitle _ title = withTString title $ setConsoleTitle
+
+setTitleCode _ = ""

System/Console/ANSI/Windows/Foreign.hs

@@ -21,12 +21,13 @@ module System.Console.ANSI.Windows.Foreign (
         setConsoleTextAttribute,
         setConsoleCursorPosition,
         setConsoleCursorInfo,
+        setConsoleTitle,
 
         fillConsoleOutputAttribute,
         fillConsoleOutputCharacter,
         scrollConsoleScreenBuffer,
 
-        withHandleToHANDLE
+        withTString, withHandleToHANDLE
     ) where
 
 import Foreign.C.Types
@@ -229,6 +230,7 @@ foreign import stdcall unsafe "windows.h GetConsoleCursorInfo" cGetConsoleCursor
 foreign import stdcall unsafe "windows.h SetConsoleTextAttribute" cSetConsoleTextAttribute :: HANDLE -> WORD -> IO BOOL
 foreign import stdcall unsafe "windows.h SetConsoleCursorPosition" cSetConsoleCursorPosition :: HANDLE -> UNPACKED_COORD -> IO BOOL
 foreign import stdcall unsafe "windows.h SetConsoleCursorInfo" cSetConsoleCursorInfo :: HANDLE -> Ptr CONSOLE_CURSOR_INFO -> IO BOOL
+foreign import stdcall unsafe "windows.h SetConsoleTitleW" cSetConsoleTitle :: LPCTSTR -> IO BOOL
 
 foreign import stdcall unsafe "windows.h FillConsoleOutputAttribute" cFillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL
 foreign import stdcall unsafe "windows.h FillConsoleOutputCharacterW" cFillConsoleOutputCharacter :: HANDLE -> TCHAR -> DWORD -> UNPACKED_COORD -> Ptr DWORD -> IO BOOL
@@ -256,6 +258,9 @@ setConsoleCursorInfo :: HANDLE -> CONSOLE_CURSOR_INFO -> IO ()
 setConsoleCursorInfo handle console_cursor_info = with console_cursor_info $ \ptr_console_cursor_info -> do
     failIfFalse_ "setConsoleCursorInfo" $ cSetConsoleCursorInfo handle ptr_console_cursor_info
 
+setConsoleTitle :: LPCTSTR -> IO ()
+setConsoleTitle title = failIfFalse_ "setConsoleTitle" $ cSetConsoleTitle title
+
 
 fillConsoleOutputAttribute :: HANDLE -> WORD -> DWORD -> COORD -> IO DWORD
 fillConsoleOutputAttribute handle attribute fill_length write_origin = alloca $ \ptr_chars_written -> do

includes/Common-Include.hs

@@ -110,4 +110,18 @@ hideCursor, showCursor :: IO ()
 hideCursorCode, showCursorCode :: String
 
 hideCursor = hHideCursor stdout
-showCursor = hShowCursor stdout
+showCursor = hShowCursor stdout
+
+
+-- | Set the terminal window title
+hSetTitle :: Handle
+          -> String -- ^ New title
+          -> IO ()
+-- | Set the terminal window title
+setTitle :: String -- ^ New title
+         -> IO ()
+-- | Set the terminal window title
+setTitleCode :: String -- ^ New title
+             -> String
+
+setTitle = hSetTitle stdout

includes/Exports-Include.hs

@@ -42,4 +42,9 @@ setSGRCode,
 -- * Cursor visibilty changes
 hideCursor, showCursor,
 hHideCursor, hShowCursor,
-hideCursorCode, showCursorCode
+hideCursorCode, showCursorCode,
+
+-- * Changing the title
+setTitle,
+hSetTitle,
+setTitleCode