diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ Changes ======= +Version 0.11.3 +-------------- + +* Add `hyperlink`, `hyperlinkWithId` and `hyperlinkWithParams`, and support for + clicable hyperlinks. + Version 0.11.2 -------------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -16,6 +16,7 @@ - Moving the cursor around - Reporting the position of the cursor - Scrolling the screen up or down +- Clickable hyperlinks to URIs - Changing the title of the terminal By using emulation, it is compatible with versions of 'Command Prompt' and diff --git a/ansi-terminal.cabal b/ansi-terminal.cabal --- a/ansi-terminal.cabal +++ b/ansi-terminal.cabal @@ -1,5 +1,5 @@ Name: ansi-terminal -Version: 0.11.2 +Version: 0.11.3 Cabal-Version: >= 1.10 Category: User Interfaces Synopsis: Simple ANSI terminal support, with Windows compatibility diff --git a/app/Example.hs b/app/Example.hs --- a/app/Example.hs +++ b/app/Example.hs @@ -22,6 +22,7 @@ , sgrColorExample , sgrOtherExample , cursorVisibilityExample + , hyperlinkExample , titleExample , getCursorPositionExample , getTerminalSizeExample @@ -364,6 +365,22 @@ showCursor pause -- Cursor Demo| + +hyperlinkExample :: IO () +hyperlinkExample = do + putStr "Hyperlink demo: " + hyperlink "https://example.com" "Example hyperlink\n" + putStrLn "" + putStrLn "Linked hyperlinks demo:" + hyperlinkWithId "ref" "https://example.com" "Example linked hyperlink one\n" + hyperlinkWithId "ref" "https://example.com" "Example linked hyperlink two\n" + + replicateM_ 5 pause + -- Hyperlink demo: Example hyperlink + -- + -- Linked hyperlinks demo: + -- Example linked hyperlink one + -- Example linked hyperlink two titleExample :: IO () titleExample = do diff --git a/src/System/Console/ANSI.hs b/src/System/Console/ANSI.hs --- a/src/System/Console/ANSI.hs +++ b/src/System/Console/ANSI.hs @@ -21,6 +21,8 @@ * Scrolling the screen up or down + * Clickable hyperlinks to URIs + * Changing the title of the terminal A terminal that supports control character sequences acts on them when they diff --git a/src/System/Console/ANSI/Codes.hs b/src/System/Console/ANSI/Codes.hs --- a/src/System/Console/ANSI/Codes.hs +++ b/src/System/Console/ANSI/Codes.hs @@ -47,6 +47,11 @@ -- * Cursor visibilty changes , hideCursorCode, showCursorCode + -- * Hyperlinks + -- | Some, but not all, terminals support hyperlinks - that is, clickable + -- text that points to a URI. + , hyperlinkCode, hyperlinkWithIdCode, hyperlinkWithParamsCode + -- * Changing the title , setTitleCode @@ -199,6 +204,50 @@ hideCursorCode, showCursorCode :: String hideCursorCode = csi [] "?25l" showCursorCode = csi [] "?25h" + +-- | Code to introduce a hyperlink with (key, value) parameters. Some terminals +-- support an @id@ parameter key, so that hyperlinks with the same @id@ value +-- are treated as connected. +-- +-- @since 0.11.3 +hyperlinkWithParamsCode + :: [(String, String)] + -- ^ Parameters + -> String + -- ^ URI + -> String + -- ^ Link text + -> String +hyperlinkWithParamsCode ps uri link = + "\ESC]8;" ++ ps' ++ ";" ++ uri ++ "\ESC\\" ++ link ++ "\ESC]8;;\ESC\\" + where + ps' = intercalate ":" $ map (\(k, v) -> k ++ "=" ++ v) ps + +-- | Code to introduce a hyperlink. +-- +-- @since 0.11.3 +hyperlinkCode + :: String + -- ^ URI + -> String + -- ^ Link text + -> String +hyperlinkCode = hyperlinkWithParamsCode [] + +-- | Code to introduce a hyperlink with an identifier for the link. Some +-- terminals support an identifier, so that hyperlinks with the same identifier +-- are treated as connected. +-- +-- @since 0.11.3 +hyperlinkWithIdCode + :: String + -- ^ Identifier for the link + -> String + -- ^ URI + -> String + -- ^ Link text + -> String +hyperlinkWithIdCode linkId = hyperlinkWithParamsCode [("id", linkId)] -- | Code to set the terminal window title and the icon name (that is, the text -- for the window in the Start bar, or similar). diff --git a/src/System/Console/ANSI/Unix.hs b/src/System/Console/ANSI/Unix.hs --- a/src/System/Console/ANSI/Unix.hs +++ b/src/System/Console/ANSI/Unix.hs @@ -64,6 +64,9 @@ hHideCursor h = hPutStr h hideCursorCode hShowCursor h = hPutStr h showCursorCode +hHyperlinkWithParams h params uri link = + hPutStr h $ hyperlinkWithParamsCode params uri link + hSetTitle h title = hPutStr h $ setTitleCode title -- hSupportsANSI :: Handle -> IO Bool diff --git a/src/System/Console/ANSI/Windows.hs b/src/System/Console/ANSI/Windows.hs --- a/src/System/Console/ANSI/Windows.hs +++ b/src/System/Console/ANSI/Windows.hs @@ -173,6 +173,32 @@ showCursorCode :: String showCursorCode = nativeOrEmulated U.showCursorCode E.showCursorCode +-- * Hyperlinks +hHyperlinkWithParams = + nativeOrEmulated U.hHyperlinkWithParams E.hHyperlinkWithParams + +hyperlinkWithParamsCode + :: [(String, String)] + -> String + -> String + -> String +hyperlinkWithParamsCode = + nativeOrEmulated U.hyperlinkWithParamsCode E.hyperlinkWithParamsCode + +hyperlinkCode + :: String + -> String + -> String +hyperlinkCode = nativeOrEmulated U.hyperlinkCode E.hyperlinkCode + +hyperlinkWithIdCode + :: String + -> String + -> String + -> String +hyperlinkWithIdCode = + nativeOrEmulated U.hyperlinkWithIdCode E.hyperlinkWithIdCode + -- * Changing the title hSetTitle = nativeOrEmulated U.hSetTitle E.hSetTitle diff --git a/src/System/Console/ANSI/Windows/Emulator.hs b/src/System/Console/ANSI/Windows/Emulator.hs --- a/src/System/Console/ANSI/Windows/Emulator.hs +++ b/src/System/Console/ANSI/Windows/Emulator.hs @@ -14,7 +14,7 @@ import Data.List (foldl', minimumBy) import Data.Maybe (mapMaybe) import qualified Data.Map.Strict as Map (Map, empty, insert, lookup) -import System.IO (Handle, hIsTerminalDevice, stdin) +import System.IO (Handle, hIsTerminalDevice, hPutStr, stdin) import System.IO.Unsafe (unsafePerformIO) import Text.ParserCombinators.ReadP (readP_to_S) @@ -348,6 +348,8 @@ hShowCursor h = emulatorFallback (Unix.hShowCursor h) $ withHandle h $ \handle -> hChangeCursorVisibility handle True + +hHyperlinkWithParams h _ _ = hPutStr h -- 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 diff --git a/src/System/Console/ANSI/Windows/Emulator/Codes.hs b/src/System/Console/ANSI/Windows/Emulator/Codes.hs --- a/src/System/Console/ANSI/Windows/Emulator/Codes.hs +++ b/src/System/Console/ANSI/Windows/Emulator/Codes.hs @@ -29,6 +29,9 @@ -- * Cursor visibilty changes , hideCursorCode, showCursorCode + -- * Hyperlinks + , hyperlinkCode, hyperlinkWithIdCode, hyperlinkWithParamsCode + -- * Changing the title , setTitleCode ) where @@ -89,6 +92,26 @@ hideCursorCode, showCursorCode :: String hideCursorCode = "" showCursorCode = "" + +hyperlinkWithParamsCode + :: ([(String, String)]) + -> String + -> String + -> String +hyperlinkWithParamsCode _ _ _ = "" + +hyperlinkCode + :: String + -> String + -> String +hyperlinkCode _ _ = "" + +hyperlinkWithIdCode + :: String + -> String + -> String + -> String +hyperlinkWithIdCode _ _ _ = "" setTitleCode :: String -- ^ New title -> String diff --git a/src/includes/Common-Include.hs b/src/includes/Common-Include.hs --- a/src/includes/Common-Include.hs +++ b/src/includes/Common-Include.hs @@ -103,6 +103,74 @@ hideCursor = hHideCursor stdout showCursor = hShowCursor stdout +-- | Introduce a hyperlink with (key, value) parameters. Some terminals support +-- an @id@ parameter key, so that hyperlinks with the same @id@ value are +-- treated as connected. +-- +-- @since 0.11.3 +hHyperlinkWithParams + :: Handle + -> [(String, String)] -- ^ Parameters + -> String -- ^ URI + -> String -- ^ Link text + -> IO () + +-- | Introduce a hyperlink with (key, value) parameters. Some terminals support +-- an @id@ parameter key, so that hyperlinks with the same @id@ value are +-- treated as connected. +-- +-- @since 0.11.3 +hyperlinkWithParams + :: [(String, String)] -- ^ Parameters + -> String -- ^ URI + -> String -- ^ Link text + -> IO () +hyperlinkWithParams = hHyperlinkWithParams stdout + +-- | Introduce a hyperlink. +-- +-- @since 0.11.3 +hHyperlink + :: Handle + -> String -- ^ URI + -> String -- ^ Link text + -> IO () +hHyperlink h = hHyperlinkWithParams h [] + +-- | Introduce a hyperlink. +-- +-- @since 0.11.3 +hyperlink + :: String -- ^ URI + -> String -- ^ Link text + -> IO () +hyperlink = hHyperlink stdout + +-- | Introduce a hyperlink with an identifier for the link. Some terminals +-- support an identifier, so that hyperlinks with the same identifier are +-- treated as connected. +-- +-- @since 0.11.3 +hHyperlinkWithId + :: Handle + -> String -- ^ Identifier for the link + -> String -- ^ URI + -> String -- ^ Link text + -> IO () +hHyperlinkWithId h linkId = hHyperlinkWithParams h [("id", linkId)] + +-- | Introduce a hyperlink with an identifier for the link. Some terminals +-- support an identifier, so that hyperlinks with the same identifier are +-- treated as connected. +-- +-- @since 0.11.3 +hyperlinkWithId + :: String -- ^ Identifier for the link + -> String -- ^ URI + -> String -- ^ Link text + -> IO () +hyperlinkWithId = hHyperlinkWithId stdout + -- | Set the terminal window title and icon name (that is, the text for the -- window in the Start bar, or similar). hSetTitle :: Handle diff --git a/src/includes/Exports-Include.hs b/src/includes/Exports-Include.hs --- a/src/includes/Exports-Include.hs +++ b/src/includes/Exports-Include.hs @@ -100,6 +100,20 @@ , hideCursorCode , showCursorCode + -- * Hyperlinks + -- | Some, but not all, terminals support hyperlinks - that is, clickable + -- text that points to a URI. On Windows, if emulation is required, + -- hyperlinks are not emulated. + , hyperlink + , hHyperlink + , hyperlinkCode + , hyperlinkWithId + , hHyperlinkWithId + , hyperlinkWithIdCode + , hyperlinkWithParams + , hHyperlinkWithParams + , hyperlinkWithParamsCode + -- * Changing the title , setTitle , hSetTitle