diff --git a/.nix-helpers/nixpkgs.nix b/.nix-helpers/nixpkgs.nix --- a/.nix-helpers/nixpkgs.nix +++ b/.nix-helpers/nixpkgs.nix @@ -26,13 +26,13 @@ if isNull nixpkgs then builtins.fetchTarball { - # Recent version of nixpkgs master as of 2020-12-27 which uses nightly-2020-12-14. - url = "https://github.com/NixOS/nixpkgs/archive/84917aa00bf23c88e5874c683abe05edb0ba4078.tar.gz"; - sha256 = "1x3qh815d7k9yc72zpn5cfaaq2b1942q4pka6rx8b5i33yz4m61q"; + # Recent version of nixpkgs master as of 2021-05-09 which uses nightly-2020-05-07. + url = "https://github.com/NixOS/nixpkgs/archive/1c16013bd6e94da748b41cc123c6b509a23eb440.tar.gz"; + sha256 = "1m2wif0qnci0q14plbqlb95vx214pxqgw5li86lyw6hsiy7y3zfn"; } else nixpkgs; - compilerVersion = if isNull compiler then "ghc8103" else compiler; + compilerVersion = if isNull compiler then "ghc8104" else compiler; # An overlay that adds termonad to all haskell package sets. haskellPackagesOverlay = self: super: { @@ -46,12 +46,14 @@ ".nix-helpers" "result" ".stack-work" + "stack.yaml" + "stack-nightly.yaml" ".travis.yml" ]; src = builtins.filterSource - (path: type: with self.stdenv.lib; + (path: type: with self.lib; ! elem (baseNameOf path) filesToIgnore && ! any (flip hasPrefix (baseNameOf path)) [ "dist" ".ghc" ] ) diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,26 @@ +## 4.2.0.0 + +* Add new options `highlightFgColour` and `highlightBgColour` for setting + the color of highlighted text + [#190](https://github.com/cdepillabout/termonad/pull/190). + Thanks [@zanculmarktum](https://github.com/zanculmarktum)! + +* Termonad creates a configuration file in `~/.config/termonad/termonad.yaml` + for use with the Preferences editor. This is only used if you don't + have a `termonad.hs` file. + + The configuration file loading code has been updated to be more robust in + loading configurations that are missing fields. This means that if you + update Termonad from an old version, your preferences will still be able to + be loaded in most cases + [#191](https://github.com/cdepillabout/termonad/pull/191). Thanks again + [@jecaro](https://github.com/jecaro)! + +* Added an + [example](https://github.com/cdepillabout/termonad/blob/74d04ba1469184cd8667f88d24dfbc7d50d7f658/example-config/ExamplePaperColourColourExtension.hs) + of how to setup a PaperColour color scheme. Thanks @craigem! + [#193](https://github.com/cdepillabout/termonad/pull/193) + ## 4.1.1.0 * Add new shortcuts to switch to the next and previous tab: diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Dennis Gosnell (c) 2018 +Copyright Dennis Gosnell (c) 2017-2021 All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,13 +2,12 @@ Termonad ========= -[![Build Status](https://secure.travis-ci.org/cdepillabout/termonad.svg)](http://travis-ci.org/cdepillabout/termonad) +[![CI](https://github.com/cdepillabout/termonad/actions/workflows/ci.yml/badge.svg)](https://github.com/cdepillabout/termonad/actions/workflows/ci.yml) [![Hackage](https://img.shields.io/hackage/v/termonad.svg)](https://hackage.haskell.org/package/termonad) [![Stackage LTS](http://stackage.org/package/termonad/badge/lts)](http://stackage.org/lts/package/termonad) [![Stackage Nightly](http://stackage.org/package/termonad/badge/nightly)](http://stackage.org/nightly/package/termonad) [![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](./LICENSE) [![Join the chat at https://gitter.im/termonad/Lobby](https://badges.gitter.im/termonad/Lobby.svg)](https://gitter.im/termonad/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) -[![Join the chat in #termonad on irc.freenode.net](https://img.shields.io/badge/%23termonad-irc.freenode.net-brightgreen.svg)](https://webchat.freenode.net/) Termonad is a terminal emulator configurable in Haskell. It is extremely customizable and provides hooks to modify the default behavior. It can be diff --git a/example-config/ExamplePaperColourColourExtension.hs b/example-config/ExamplePaperColourColourExtension.hs new file mode 100644 --- /dev/null +++ b/example-config/ExamplePaperColourColourExtension.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This is an example Termonad configuration that shows how to use the +-- PaperColor colour scheme https://github.com/NLKNguyen/papercolor-theme + +module Main where + +import Data.Maybe (fromMaybe) +import Termonad + ( CursorBlinkMode(CursorBlinkModeOn) + , Option(Set) + , ShowScrollbar(ShowScrollbarNever) + , TMConfig + , confirmExit + , cursorBlinkMode + , defaultConfigOptions + , defaultTMConfig + , options + , showMenu + , showScrollbar + , start + , FontConfig + , FontSize(FontSizePoints) + , defaultFontConfig + , fontConfig + , fontFamily + , fontSize + ) +import Termonad.Config.Colour + ( AlphaColour + , ColourConfig + , Palette(ExtendedPalette) + , addColourExtension + , createColour + , createColourExtension + , defaultColourConfig + , defaultStandardColours + , defaultLightColours + , backgroundColour + , foregroundColour + , palette + , List8 + , mkList8 + ) + +-- This is our main 'TMConfig'. It holds all of the non-colour settings +-- for Termonad. +-- +-- This shows how a few settings can be changed. +myTMConfig :: TMConfig +myTMConfig = + defaultTMConfig + { options = + defaultConfigOptions + { showScrollbar = ShowScrollbarNever + , confirmExit = False + , showMenu = False + , cursorBlinkMode = CursorBlinkModeOn + , fontConfig = fontConf + } + } + +-- This is our PaperColor dark 'ColourConfig'. It holds all of our dark-related settings. +paperColorDark :: ColourConfig (AlphaColour Double) +paperColorDark = + defaultColourConfig + -- Set the default background & foreground colour of text of the terminal. + { backgroundColour = Set (createColour 28 28 28) -- black.0 + , foregroundColour = Set (createColour 208 208 208) -- white.7 + -- Set the extended palette that has 2 Vecs of 8 PaperColor palette colours + , palette = ExtendedPalette paperColorNormal paperColorBright + } + where + paperColorNormal :: List8 (AlphaColour Double) + paperColorNormal = fromMaybe defaultStandardColours $ mkList8 + [ createColour 28 28 28 -- black.0 + , createColour 175 0 95 -- red.1 + , createColour 95 175 0 -- green.2 + , createColour 215 175 95 -- yellow.3 + , createColour 95 175 215 -- blue.4 + , createColour 128 128 128 -- purple.5 + , createColour 215 135 95 -- aqua.6 + , createColour 208 208 208 -- white.7 + ] + + paperColorBright :: List8 (AlphaColour Double) + paperColorBright = fromMaybe defaultStandardColours $ mkList8 + [ createColour 88 88 88 -- black.8 + , createColour 95 175 95 -- red.9 + , createColour 175 215 0 -- green.10 + , createColour 175 135 215 -- yellow.11 + , createColour 255 175 0 -- blue.12 + , createColour 255 95 175 -- purple.13 + , createColour 0 175 175 -- aqua.14 + , createColour 95 135 135 -- white.15 + ] + +-- This is our PaperColor light 'ColourConfig'. It holds all of our light-related settings +paperColorLight :: ColourConfig (AlphaColour Double) +paperColorLight = + defaultColourConfig + -- Set the default background & foreground colour of text of the terminal. + { backgroundColour = Set (createColour 238 238 238) -- black.0 + , foregroundColour = Set (createColour 68 68 68) -- white.7 + -- Set the extended palette that has 2 Vecs of 8 PaperColor palette colours + , palette = ExtendedPalette paperColorNormal paperColorBright + } + where + paperColorNormal :: List8 (AlphaColour Double) + paperColorNormal = fromMaybe defaultLightColours $ mkList8 + [ createColour 238 238 238 -- black.0 + , createColour 175 0 0 -- red.1 + , createColour 0 135 0 -- green.2 + , createColour 95 135 0 -- yellow.3 + , createColour 0 135 175 -- blue.4 + , createColour 135 135 135 -- purple.5 + , createColour 0 95 135 -- aqua.6 + , createColour 68 68 68 -- white.7 + ] + + paperColorBright :: List8 (AlphaColour Double) + paperColorBright = fromMaybe defaultLightColours $ mkList8 + [ createColour 188 188 188 -- black.8 + , createColour 215 0 0 -- red.9 + , createColour 215 0 135 -- green.10 + , createColour 135 0 175 -- yellow.11 + , createColour 215 95 0 -- blue.12 + , createColour 215 95 0 -- purple.13 + , createColour 0 95 175 -- aqua.14 + , createColour 0 95 135 -- white.15 + ] + + +-- This defines the font for the terminal. +fontConf :: FontConfig +fontConf = + defaultFontConfig + { fontFamily = "Monospace" + , fontSize = FontSizePoints 12 + } + +main :: IO () +main = do + -- First, create the colour extension based on either PaperColor modules. + myColourExt <- createColourExtension paperColorLight + + -- Update 'myTMConfig' with our colour extension. + let newTMConfig = addColourExtension myTMConfig myColourExt + + -- Start Termonad with our updated 'TMConfig'. + start newTMConfig diff --git a/shell.nix b/shell.nix --- a/shell.nix +++ b/shell.nix @@ -24,6 +24,11 @@ # will also index the Termonad libraries, however this will mean the environment # will need to be rebuilt every time the termonad source changes. -{ compiler ? null, indexTermonad ? false, nixpkgs ? null, additionalOverlays ? [] }@args: +{ compiler ? null +, indexTermonad ? false +, nixpkgs ? null +, buildExamples ? false +, additionalOverlays ? [] +}@args: (import .nix-helpers/nixpkgs.nix args).termonadShell diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -68,8 +68,6 @@ , labelNew , notebookGetNPages , notebookNew - , notebookNextPage - , notebookPrevPage , notebookSetShowBorder , onEntryActivate , onNotebookPageRemoved diff --git a/src/Termonad/Config/Colour.hs b/src/Termonad/Config/Colour.hs --- a/src/Termonad/Config/Colour.hs +++ b/src/Termonad/Config/Colour.hs @@ -50,6 +50,8 @@ , lensCursorBgColour , lensForegroundColour , lensBackgroundColour + , lensHighlightFgColour + , lensHighlightBgColour , lensPalette -- * Colour Extension , ColourExtension(..) @@ -119,6 +121,8 @@ #endif , terminalSetColorBackground , terminalSetColorForeground + , terminalSetColorHighlight + , terminalSetColorHighlightForeground ) import Text.Printf (printf) import Text.Show (showString) @@ -672,11 +676,14 @@ -- 'foregroundColour' and 'backgroundColour' allow you to set the color of the -- foreground text and background of the terminal. -- +-- 'highlightFgColour' and 'highlightBgColour' allow you to set the color of +-- the foreground and background of the highlighted text. +-- -- 'palette' allows you to set the full color palette used by the terminal. -- See 'Palette' for more information. -- --- If you don't set 'foregroundColour', 'backgroundColour', or 'palette', the --- defaults from VTE are used. +-- If you don't set 'foregroundColour', 'backgroundColour', 'highlightFgColour', +-- 'highlightBgColour', or 'palette', the defaults from VTE are used. -- -- If you want to use a terminal with a white (or light) background and a black -- foreground, it may be a good idea to change some of the colors in the @@ -751,22 +758,28 @@ -- ^ Color of the default foreground text in the terminal. , backgroundColour :: !(Option c) -- ^ Background color for the terminal + , highlightFgColour :: !(Option c) + -- ^ Foreground color for the highlighted text. + , highlightBgColour :: !(Option c) + -- ^ Background color for the highlighted text. , palette :: !(Palette c) -- ^ Color palette for the terminal. See 'Palette'. } deriving (Eq, Show, Functor) -- | Default setting for a 'ColourConfig'. The cursor colors, font foreground --- color, background color, and color palette are all left at the defaults set --- by VTE. +-- color, background color, highlighted text color, and color palette are all +-- left at the defaults set by VTE. -- -- >>> defaultColourConfig --- ColourConfig {cursorFgColour = Unset, cursorBgColour = Unset, foregroundColour = Unset, backgroundColour = Unset, palette = NoPalette} +-- ColourConfig {cursorFgColour = Unset, cursorBgColour = Unset, foregroundColour = Unset, backgroundColour = Unset, highlightFgColour = Unset, highlightBgColour = Unset, palette = NoPalette} defaultColourConfig :: ColourConfig (AlphaColour Double) defaultColourConfig = ColourConfig { cursorFgColour = Unset , cursorBgColour = Unset , foregroundColour = Unset , backgroundColour = Unset + , highlightFgColour = Unset + , highlightBgColour = Unset , palette = NoPalette } @@ -775,6 +788,8 @@ , ("cursorBgColour", "lensCursorBgColour") , ("foregroundColour", "lensForegroundColour") , ("backgroundColour", "lensBackgroundColour") + , ("highlightFgColour", "lensHighlightFgColour") + , ("highlightBgColour", "lensHighlightBgColour") , ("palette", "lensPalette") ] ''ColourConfig @@ -813,6 +828,10 @@ whenSet (cursorFgColour colourConf) $ terminalSetColorCursorForeground vteTerm . Just <=< colourToRgba #endif + whenSet (highlightFgColour colourConf) $ + terminalSetColorHighlightForeground vteTerm . Just <=< colourToRgba + whenSet (highlightBgColour colourConf) $ + terminalSetColorHighlight vteTerm . Just <=< colourToRgba colourToRgba :: AlphaColour Double -> IO RGBA colourToRgba colour = do diff --git a/src/Termonad/PreferencesFile.hs b/src/Termonad/PreferencesFile.hs --- a/src/Termonad/PreferencesFile.hs +++ b/src/Termonad/PreferencesFile.hs @@ -3,7 +3,12 @@ import Termonad.Prelude -import Data.Yaml (decodeFileEither, encode, prettyPrintParseException) +import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE, withExceptT) +import Data.Aeson (Result(..), fromJSON) +import qualified Data.HashMap.Strict as HashMap +import Data.Yaml (ParseException, ToJSON (toJSON), decodeFileEither, encode, prettyPrintParseException) +import Data.Yaml.Aeson (Value(..)) + import System.Directory ( XdgDirectory(XdgConfig) , createDirectoryIfMissing @@ -30,6 +35,9 @@ -- @~\/.config\/termonad\/termonad.yaml@. This file stores only the 'options' of -- 'TMConfig' so 'hooks' are initialized with 'defaultConfigHooks'. If the -- file doesn't exist, create it with the default values. +-- +-- Any options that do not exist will get initialized with values from +-- 'defaultConfigOptions'. tmConfigFromPreferencesFile :: IO TMConfig tmConfigFromPreferencesFile = do confFile <- getPreferencesFile @@ -37,15 +45,110 @@ exists <- doesFileExist confFile unless exists $ writePreferencesFile confFile defaultConfigOptions -- Read the configuration file - eitherOptions <- decodeFileEither confFile + eitherOptions <- readFileWithDefaults confFile options <- case eitherOptions of Left err -> do - hPutStrLn stderr $ "Error parsing file " <> pack confFile - hPutStrLn stderr $ pack $ prettyPrintParseException err + hPutStrLn stderr $ "Error parsing file " <> pack confFile <> ": " <> err pure defaultConfigOptions Right options -> pure options - pure $ TMConfig { options = options, hooks = defaultConfigHooks } + pure TMConfig { options = options, hooks = defaultConfigHooks } + +-- | Read the 'ConfigOptions' out of a configuration file. +-- +-- Merge the raw 'ConfigOptions' with 'defaultConfigOptions'. This makes sure +-- that old versions of the configuration file will still be able to be read +-- even if new options are added to 'ConfigOptions' in new versions of +-- Termonad. +readFileWithDefaults :: FilePath -> IO (Either Text ConfigOptions) +readFileWithDefaults file = runExceptT $ do + -- Read the configuration file as a JSON object + optsFromFile :: Value <- + withExceptT parseExceptionToText . ExceptT $ decodeFileEither file + let optsDefault :: Value = toJSON $ defaultConfigOptions + -- Then merge it with the default options in JSON before converting it to + -- a 'ConfigOptions' + resultToExcept . fromJSON $ mergeObjVals optsFromFile optsDefault + where + parseExceptionToText :: ParseException -> Text + parseExceptionToText = pack . prettyPrintParseException + + resultToExcept :: Result a -> ExceptT Text IO a + resultToExcept (Success v) = pure v + resultToExcept (Error str) = throwE (pack str) + +-- | Merge 'Value's recursively. +-- +-- This merges 'Value's recursively in 'Object' values, taking values that +-- have been explicitly over the defaults. The defaults are only used if +-- there is no value that has been explicitly set. +-- +-- For 'Array', 'String', 'Number', 'Bool', and 'Null', take the first 'Value' +-- (the one that has been explicitly set in the user's config file): +-- +-- >>> mergeObjVals (Array [Number 1, Number 2]) (Array [String "hello"]) +-- Array [Number 1.0,Number 2.0] +-- >>> mergeObjVals (String "hello") (String "bye") +-- String "hello" +-- >>> mergeObjVals (Number 1) (Number 2) +-- Number 1.0 +-- >>> mergeObjVals (Bool True) (Bool False) +-- Bool True +-- >>> mergeObjVals Null Null +-- Null +-- +-- Note that 'Value's in 'Array's are not recursed into: +-- +-- >>> let obj1 = Object $ HashMap.singleton "hello" (Number 2) +-- >>> let obj2 = Object $ HashMap.singleton "hello" (String "bye") +-- >>> mergeObjVals (Array [obj1]) (Array [obj2]) +-- Array [Object (fromList [("hello",Number 2.0)])] +-- +-- 'Object's are recursed into. Unique keys from both Maps will be used. +-- Keys that are in both Maps will be merged according to the rules above: +-- +-- >>> let hash1 = HashMap.fromList [("hello", Number 1), ("bye", Number 100)] +-- >>> let hash2 = HashMap.fromList [("hello", Number 2), ("goat", String "chicken")] +-- >>> mergeObjVals (Object hash1) (Object hash2) +-- Object (fromList [("bye",Number 100.0),("goat",String "chicken"),("hello",Number 1.0)]) +-- +-- 'Value's of different types will use the second 'Value': +-- +-- >>> mergeObjVals Null (String "bye") +-- String "bye" +-- >>> mergeObjVals (Bool True) (Number 2) +-- Number 2.0 +-- >>> mergeObjVals (Object mempty) (Bool False) +-- Bool False +-- +mergeObjVals + :: Value + -- ^ Value that has been set explicitly in the User's configuration + -- file. + -> Value + -- ^ Default value that will be used if no explicitly set value. + -> Value + -- ^ Merged values. +mergeObjVals optsFromFile optsDefault = + case (optsFromFile, optsDefault) of + -- Both the options from the file and the default options are an Object + -- here. Recursively merge the keys and values. + (Object optsFromFileHashMap, Object optsDefaultHashMap) -> + Object $ HashMap.unionWith mergeObjVals optsFromFileHashMap optsDefaultHashMap + -- Both the value from the file and the default value are the same type. + -- Use the value from the file. + -- + -- XXX: This will end up causing readFileWithDefaults to fail if the value + -- from the file is old and can no longer properly be decoded into a value + -- expected by ConfigOptions. + (Array fromFile, Array _) -> Array fromFile + (String fromFile, String _) -> String fromFile + (Number fromFile, Number _) -> Number fromFile + (Bool fromFile, Bool _) -> Bool fromFile + (Null, Null) -> Null + -- The value from the file and the default value are different types. Just + -- use the default value. + (_, defVal) -> defVal writePreferencesFile :: FilePath -> ConfigOptions -> IO () writePreferencesFile confFile options = do diff --git a/termonad.cabal b/termonad.cabal --- a/termonad.cabal +++ b/termonad.cabal @@ -1,5 +1,5 @@ name: termonad -version: 4.1.1.0 +version: 4.2.0.0 synopsis: Terminal emulator configurable in Haskell description: Termonad is a terminal emulator configurable in Haskell. It is extremely @@ -16,7 +16,7 @@ license-file: LICENSE author: Dennis Gosnell maintainer: cdep.illabout@gmail.com -copyright: 2017 Dennis Gosnell +copyright: 2017-2021 Dennis Gosnell category: Text build-type: Custom cabal-version: 1.12 @@ -64,6 +64,7 @@ other-modules: Paths_termonad build-depends: base >= 4.13 && < 5 , adjunctions + , aeson , classy-prelude , colour , constraints @@ -89,9 +90,10 @@ , QuickCheck , text , transformers - , yaml + , unordered-containers , xml-conduit , xml-html-qq + , yaml default-language: Haskell2010 ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates default-extensions: DataKinds @@ -149,14 +151,7 @@ , template-haskell , termonad default-language: Haskell2010 - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N - -- For some reason doctests appear to be segfaulting when compiling with - -- ghc-8.10.3, so only build them when using ghc-8.10.2 or earlier. - -- See https://github.com/cdepillabout/termonad/issues/174. - if impl(ghc <= 8.10.2) - buildable: True - else - buildable: False + ghc-options: -Wall test-suite termonad-test type: exitcode-stdio-1.0 @@ -225,6 +220,19 @@ executable termonad-example-colour-extension-gruvbox main-is: example-config/ExampleGruvboxColourExtension.hs + build-depends: base + , termonad + , colour + default-language: Haskell2010 + ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N + + if flag(buildexamples) + buildable: True + else + buildable: False + +executable termonad-example-colour-extension-papercolour + main-is: example-config/ExamplePaperColourColourExtension.hs build-depends: base , termonad , colour diff --git a/test/readme/README.lhs b/test/readme/README.lhs --- a/test/readme/README.lhs +++ b/test/readme/README.lhs @@ -2,13 +2,12 @@ Termonad ========= -[![Build Status](https://secure.travis-ci.org/cdepillabout/termonad.svg)](http://travis-ci.org/cdepillabout/termonad) +[![CI](https://github.com/cdepillabout/termonad/actions/workflows/ci.yml/badge.svg)](https://github.com/cdepillabout/termonad/actions/workflows/ci.yml) [![Hackage](https://img.shields.io/hackage/v/termonad.svg)](https://hackage.haskell.org/package/termonad) [![Stackage LTS](http://stackage.org/package/termonad/badge/lts)](http://stackage.org/lts/package/termonad) [![Stackage Nightly](http://stackage.org/package/termonad/badge/nightly)](http://stackage.org/nightly/package/termonad) [![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](./LICENSE) [![Join the chat at https://gitter.im/termonad/Lobby](https://badges.gitter.im/termonad/Lobby.svg)](https://gitter.im/termonad/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) -[![Join the chat in #termonad on irc.freenode.net](https://img.shields.io/badge/%23termonad-irc.freenode.net-brightgreen.svg)](https://webchat.freenode.net/) Termonad is a terminal emulator configurable in Haskell. It is extremely customizable and provides hooks to modify the default behavior. It can be