diff --git a/.nix-helpers/nixpkgs.nix b/.nix-helpers/nixpkgs.nix --- a/.nix-helpers/nixpkgs.nix +++ b/.nix-helpers/nixpkgs.nix @@ -26,7 +26,7 @@ src = builtins.filterSource (path: type: with stdenvLib; - ! elem (baseNameOf path) [ ".git" "result" ".stack-work" ] && + ! elem (baseNameOf path) [ ".git" "result" ".stack-work" ".nix-helpers" ] && ! any (flip hasPrefix (baseNameOf path)) [ "dist" ".ghc" ] ) ./..; @@ -55,14 +55,19 @@ }; in callCabal2nix "focuslist" src {}; - haskellPackagesOL = self: super: with super.haskell.lib; { + haskellPackagesOverlay = self: super: with super.haskell.lib; { haskellPackages = super.haskell.packages.${compilerVersion}.override { overrides = hself: hsuper: { # Only override the version of foculist if it doesn't already exist in # the haskell package set. focuslist = hsuper.focuslist or (myfocuslist hself.callCabal2nix); - termonad = termonadOverride self.stdenv.lib self.gnome3 hself.callCabal2nix self.haskell.lib.overrideCabal; + termonad = + termonadOverride + self.stdenv.lib + self.gnome3 + hself.callCabal2nix + self.haskell.lib.overrideCabal; # This is a tool to use to easily open haddocks in the browser. open-haddock = hsuper.open-haddock.overrideAttrs (oa: { @@ -87,5 +92,4 @@ }); }; -in import nixpkgsSrc { overlays = [ haskellPackagesOL ]; } - +in import nixpkgsSrc { overlays = [ haskellPackagesOverlay ]; } diff --git a/.nix-helpers/stack-fhs-env.nix b/.nix-helpers/stack-fhs-env.nix new file mode 100644 --- /dev/null +++ b/.nix-helpers/stack-fhs-env.nix @@ -0,0 +1,75 @@ +# This is a nix derivation that gives us a `stack` binary that will run in a +# chroot. This is needed to workaround +# https://github.com/cdepillabout/termonad/issues/99. +# +# This is nice to use if you're having trouble running `stack` on nixos +# normally. It generally shouldn't be needed any other time. +# +# You can use this by starting a `nix-shell` with it: +# +# $ nix-shell --pure .nix-helpers/stack-fhs-env.nix +# +# From here, you can run `stack` normally. + +let + # recent version of nixpkgs master as of 2018-12-23 + nixpkgsTarball = builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/c31c0558ddad7161a4025117694197264cda9750.tar.gz"; + sha256 = "09xl8fshyyddcm5nw5fkl6fbjlh5szjcdm43ii6jsvykdr516ghp"; + }; + + # Additional packages or fixes for individual packages. + pkgOverlay = self: pkgs: { + fhsStack = + self.buildFHSUserEnv { + name = "stack"; + runScript = "stack"; + targetPkgs = _: with self; [ + binutils + cairo + ghc + git + gnome3.atk + gnome3.gdk_pixbuf + gnome3.glib + gnome3.gtk + gnome3.vte + gnutls + gobjectIntrospection + gtk3 + haskell.compiler.ghc863 + iana-etc + pango + pcre2 + pkgconfig + stack + zlib + ] ++ + self.stdenv.lib.optional + (self.stdenv.hostPlatform.libc == "glibc") + self.glibcLocales; + profile = '' + export STACK_IN_NIX_SHELL=1 + export GI_TYPELIB_PATH=/usr/lib/girepository-1.0 + ''; + extraOutputsToInstall = ["dev"]; + }; + }; + + nixpkgs = import nixpkgsTarball { + overlays = [ + pkgOverlay + ]; + }; + +in + +with nixpkgs; + +mkShell { + buildInputs = [ + fhsStack + gitAndTools.gitFull + gitAndTools.hub + ]; +} diff --git a/.nix-helpers/stack-nix-shell.nix b/.nix-helpers/stack-nix-shell.nix deleted file mode 100644 --- a/.nix-helpers/stack-nix-shell.nix +++ /dev/null @@ -1,38 +0,0 @@ -# This is the shell file specified in the stack.yaml file. -# This runs stack commands in an environment created with nix. - -let - # recent version of nixpkgs as of 2018-10-17 - nixpkgsTarball = builtins.fetchTarball { - url = "https://github.com/NixOS/nixpkgs/archive/6a23e11e658b7a7a77f1b61d30d64153b46bc852.tar.gz"; - sha256 = "03n4bacfk1bbx3v0cx8xcgcmz44l0knswzh7hwih9nx0hj3x41yc"; - }; - - # Fixes for individual packages. Currently none needed. - pkgFixes = self: pkgs: { - }; - - nixpkgs = import nixpkgsTarball { - overlays = [ - pkgFixes - ]; - }; -in - -with nixpkgs; - -haskell.lib.buildStackProject { - name = "termonad"; - buildInputs = [ - cairo - git - gnome3.vte - gobjectIntrospection - gtk3 - zlib - ]; - ghc = haskell.compiler.ghc843; - extraArgs = [ - "--stack-yaml stack-lts-12.yaml" - ]; -} diff --git a/.nix-helpers/stack-shell.nix b/.nix-helpers/stack-shell.nix new file mode 100644 --- /dev/null +++ b/.nix-helpers/stack-shell.nix @@ -0,0 +1,38 @@ +# This is the shell file specified in the stack.yaml file. +# This runs stack commands in an environment created with nix. + +let + # recent version of nixpkgs master as of 2018-12-23 + nixpkgsTarball = builtins.fetchTarball { + url = "https://github.com/NixOS/nixpkgs/archive/c31c0558ddad7161a4025117694197264cda9750.tar.gz"; + sha256 = "09xl8fshyyddcm5nw5fkl6fbjlh5szjcdm43ii6jsvykdr516ghp"; + }; + + # Fixes for individual packages. Currently none needed. + pkgFixes = self: pkgs: { + }; + + nixpkgs = import nixpkgsTarball { + overlays = [ + pkgFixes + ]; + }; +in + +with nixpkgs; + +haskell.lib.buildStackProject { + name = "termonad"; + buildInputs = [ + cairo + git + gnome3.vte + gobjectIntrospection + gtk3 + zlib + ]; + ghc = haskell.compiler.ghc863; + extraArgs = [ + "--stack-yaml stack-lts-13.yaml" + ]; +} diff --git a/.nix-helpers/termonad-with-packages.nix b/.nix-helpers/termonad-with-packages.nix --- a/.nix-helpers/termonad-with-packages.nix +++ b/.nix-helpers/termonad-with-packages.nix @@ -105,17 +105,22 @@ with (import ./nixpkgs.nix { inherit compiler nixpkgs; }); let - ghcWithPackages = haskellPackages.ghcWithPackages; - env = ghcWithPackages (self: [ self.termonad ] ++ extraHaskellPackages self); + env = haskellPackages.ghcWithPackages (self: [ + self.termonad + ] ++ extraHaskellPackages self); in stdenv.mkDerivation { name = "termonad-with-packages-${env.version}"; - nativeBuildInputs = [ makeWrapper ]; + buildInputs = [ gnome3.adwaita-icon-theme hicolor-icon-theme ]; + nativeBuildInputs = [ wrapGAppsHook ]; buildCommand = '' mkdir -p $out/bin - makeWrapper ${env}/bin/termonad $out/bin/termonad \ + ln -sf ${env}/bin/termonad $out/bin/termonad + gappsWrapperArgs+=( --set NIX_GHC "${env}/bin/ghc" + ) + wrapGAppsHook ''; preferLocalBuild = true; allowSubstitutes = false; diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,19 @@ + +## 1.1.0.0 + +* Added an + [example](https://github.com/cdepillabout/termonad/blob/0cd741d51958806092418b55abdf1c1dc078841c/example-config/ExampleSolarizedColourExtension.hs) + of how to setup a solarized color scheme. Thanks @craigem. + [#90](https://github.com/cdepillabout/termonad/pull/90) and [#103](https://github.com/cdepillabout/termonad/pull/103) +* Various fixes in the nix files. + * Make sure Termonad can see the GTK icons. + [#91](https://github.com/cdepillabout/termonad/pull/91) and + [#92](https://github.com/cdepillabout/termonad/pull/92) +* Add a menu option to change the font size at runtime. You should be able to + do this with the `Ctrl-+` and `Ctrl--` keys. + [#95](https://github.com/cdepillabout/termonad/pull/95) +* Get building with GHC 8.6. Thanks @clinty. [#98](https://github.com/cdepillabout/termonad/pull/98) + ## 1.0.1.0 * Stop using the `widgetSetFocusOnClick` function, which is not supported on diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -226,6 +226,8 @@ |------------|--------| | Ctrl Shift t | Open new tab. | | Ctrl Shift w | Close tab. | +| Ctrl + | Increase font size. | +| Ctrl - | Decrease font size. | | Alt (number key) | Switch to tab `number`. For example, Alt 2 switches to tab 2. | ### Configuring Termonad @@ -291,6 +293,9 @@ `addColourExtension` colExt defaultMain termonadConf ``` + +There are other example configuration files in the +[example-config/](./example-config) directory. ### Compiling Local Settings diff --git a/example-config/ExampleColourExtension.hs b/example-config/ExampleColourExtension.hs --- a/example-config/ExampleColourExtension.hs +++ b/example-config/ExampleColourExtension.hs @@ -4,6 +4,8 @@ module Main where +import Data.Colour.SRGB (Colour, sRGB24) +import Data.Singletons (sing) import Termonad ( CursorBlinkMode(CursorBlinkModeOff), Option(Set) , ShowScrollbar(ShowScrollbarNever), TMConfig, confirmExit, cursorBlinkMode @@ -15,8 +17,9 @@ , createColourExtension, cursorBgColour, defaultColourConfig, foregroundColour , palette, sRGB24 ) -import Termonad.Config.Vec (Vec((:*), EmptyVec), N8, unsafeFromListVec_) -import Data.Colour.SRGB (Colour, sRGB24) +import Termonad.Config.Vec + ( N4, N8, Sing, Vec((:*), EmptyVec), fin_, setAtVec, unsafeFromListVec_ + ) -- This is our main 'TMConfig'. It holds all of the non-colour settings -- for Termonad. @@ -62,7 +65,7 @@ :* sRGB24 180 160 120 -- light brown :* EmptyVec - -- This is an example of creating a length-indenxed linked-list of colours, + -- This is an example of creating a length-indexed linked-list of colours, -- using the 'unsafeFromListVec_' function. 'unsafeFromListVec_' is okay to -- use as long as you're absolutely sure you have 8 elements. myLightColours :: Vec N8 (Colour Double) @@ -77,6 +80,13 @@ , sRGB24 50 200 160 -- light teal , sRGB24 220 200 150 -- light brown ] + + -- This is an example of updating just a single value in a 'Colour' 'Vec'. + -- Here we are updating the 5th 'Colour' (which is at index 4). + updateSingleColor :: Vec N8 (Colour Double) + updateSingleColor = + let fin4 = fin_ (sing :: Sing N4) + in setAtVec fin4 (sRGB24 40 30 150) myStandardColours main :: IO () main = do diff --git a/example-config/ExampleSolarizedColourExtension.hs b/example-config/ExampleSolarizedColourExtension.hs new file mode 100644 --- /dev/null +++ b/example-config/ExampleSolarizedColourExtension.hs @@ -0,0 +1,114 @@ +-- | This is an example Termonad configuration that shows how to use the +-- Solarized colour scheme https://ethanschoonover.com/solarized/ + + +module Main where + +import Termonad + ( CursorBlinkMode(CursorBlinkModeOff), Option(Set) + , ShowScrollbar(ShowScrollbarNever), TMConfig, confirmExit, cursorBlinkMode + , defaultConfigOptions, defaultTMConfig, options, showMenu, showScrollbar + , start + ) +import Termonad.Config.Colour + ( Colour, ColourConfig, Palette(ExtendedPalette), addColourExtension + , createColourExtension, cursorBgColour, defaultColourConfig, foregroundColour + , palette, sRGB24 + ) +import Termonad.Config.Vec (Vec((:*), EmptyVec), N8, unsafeFromListVec_) +import Data.Colour.SRGB (Colour, sRGB24) + +-- 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 = CursorBlinkModeOff + } + } + +-- This is our Solarized dark 'ColourConfig'. It holds all of our dark-related settings. +solarizedDark :: ColourConfig (Colour Double) +solarizedDark = + defaultColourConfig + -- Set the default foreground colour of text of the terminal. + { foregroundColour = sRGB24 131 148 150 -- base0 + -- Set the extended palette that has 2 Vecs of 8 Solarized pallette colours + , palette = ExtendedPalette solarizedDark1 solarizedDark2 + } + where + solarizedDark1 :: Vec N8 (Colour Double) + solarizedDark1 = + sRGB24 0 43 54 -- base03, background + :* sRGB24 220 50 47 -- red + :* sRGB24 133 153 0 -- green + :* sRGB24 181 137 0 -- yellow + :* sRGB24 38 139 210 -- blue + :* sRGB24 211 54 130 -- magenta + :* sRGB24 42 161 152 -- cyan + :* sRGB24 238 232 213 -- base2 + :* EmptyVec + + solarizedDark2 :: Vec N8 (Colour Double) + solarizedDark2 = + sRGB24 7 54 66 -- base02, background highlights + :* sRGB24 203 75 22 -- orange + :* sRGB24 88 110 117 -- base01, comments / secondary text + :* sRGB24 131 148 150 -- base0, body text / default code / primary content + :* sRGB24 147 161 161 -- base1, optional emphasised content + :* sRGB24 108 113 196 -- violet + :* sRGB24 101 123 131 -- base00 + :* sRGB24 253 246 227 -- base3 + :* EmptyVec + +-- This is our Solarized light 'ColourConfig'. It holds all of our light-related settings. +solarizedLight :: ColourConfig (Colour Double) +solarizedLight = + defaultColourConfig + -- Set the default foreground colour of text of the terminal. + { foregroundColour = sRGB24 101 123 131 -- base00 + -- Set the extended palette that has 2 Vecs of 8 Solarized pallette colours + , palette = ExtendedPalette solarizedLight1 solarizedLight2 + } + where + solarizedLight1 :: Vec N8 (Colour Double) + solarizedLight1 = + sRGB24 238 232 213 -- base2, background highlights + :* sRGB24 220 50 47 -- red + :* sRGB24 133 153 0 -- green + :* sRGB24 181 137 0 -- yellow + :* sRGB24 38 139 210 -- blue + :* sRGB24 211 54 130 -- magenta + :* sRGB24 42 161 152 -- cyan + :* sRGB24 7 54 66 -- base02 + :* EmptyVec + + solarizedLight2 :: Vec N8 (Colour Double) + solarizedLight2 = + sRGB24 253 246 227 -- base3, background + :* sRGB24 203 75 22 -- orange + :* sRGB24 147 161 161 -- base1, comments / secondary text + :* sRGB24 101 123 131 -- base00, body text / default code / primary content + :* sRGB24 88 110 117 -- base01, optional emphasised content + :* sRGB24 108 113 196 -- violet + :* sRGB24 131 148 150 -- base0 + :* sRGB24 0 43 54 -- base03 + :* EmptyVec + +main :: IO () +main = do + -- First, create the colour extension based on either Solarixed modules. + myColourExt <- createColourExtension solarizedDark + + -- Update 'myTMConfig' with our colour extension. + let newTMConfig = addColourExtension myTMConfig myColourExt + + -- Start Termonad with our updated 'TMConfig'. + start newTMConfig diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -4,7 +4,7 @@ import Termonad.Prelude import Config.Dyre (defaultParams, projectName, realMain, showError, wrapMain) -import Control.Lens ((&), (.~), (^.)) +import Control.Lens ((&), (.~), (^.), (^..)) import Data.FocusList (focusList, moveFromToFL, updateFocusFL) import Data.Sequence (findIndexR) import GI.Gdk (castTo, managedForeignPtr, screenGetDefault) @@ -64,17 +64,23 @@ import GI.Pango ( FontDescription , pattern SCALE + , fontDescriptionGetSize + , fontDescriptionGetSizeIsAbsolute , fontDescriptionNew , fontDescriptionSetFamily , fontDescriptionSetSize , fontDescriptionSetAbsoluteSize ) import GI.Vte - ( terminalCopyClipboard + ( Terminal + , terminalCopyClipboard , terminalPasteClipboard + , terminalSetFont ) import Paths_termonad (getDataFileName) +import Termonad.Gtk (appNew, objFromBuildUnsafe) +import Termonad.Keys (handleKeyPress) import Termonad.Lenses ( lensConfirmExit , lensFontConfig @@ -84,11 +90,10 @@ , lensTMNotebookTabs , lensTMStateApp , lensTMStateConfig + , lensTMStateFontDesc , lensTMStateNotebook , lensTerm ) -import Termonad.Gtk (appNew, objFromBuildUnsafe) -import Termonad.Keys (handleKeyPress) import Termonad.Term (createTerm, relabelTabs, termExitFocused, setShowTabs) import Termonad.Types ( FontConfig(fontFamily, fontSize) @@ -98,6 +103,7 @@ , TMState , TMState'(TMState) , getFocusedTermFromState + , modFontSize , newEmptyTMState , tmNotebookTabTermContainer , tmNotebookTabs @@ -149,18 +155,49 @@ cssProvider (fromIntegral STYLE_PROVIDER_PRIORITY_APPLICATION) -createFontDesc :: TMConfig -> IO FontDescription -createFontDesc tmConfig = do - fontDesc <- fontDescriptionNew +createFontDescFromConfig :: TMConfig -> IO FontDescription +createFontDescFromConfig tmConfig = do let fontConf = tmConfig ^. lensOptions . lensFontConfig - fontDescriptionSetFamily fontDesc (fontFamily fontConf) - case fontSize fontConf of - FontSizePoints points -> - fontDescriptionSetSize fontDesc $ fromIntegral (points * fromIntegral SCALE) - FontSizeUnits units -> - fontDescriptionSetAbsoluteSize fontDesc $ units * fromIntegral SCALE + createFontDesc (fontSize fontConf) (fontFamily fontConf) + +createFontDesc :: FontSize -> Text -> IO FontDescription +createFontDesc fontSz fontFam = do + fontDesc <- fontDescriptionNew + fontDescriptionSetFamily fontDesc fontFam + setFontDescSize fontDesc fontSz pure fontDesc +setFontDescSize :: FontDescription -> FontSize -> IO () +setFontDescSize fontDesc (FontSizePoints points) = + fontDescriptionSetSize fontDesc $ fromIntegral (points * fromIntegral SCALE) +setFontDescSize fontDesc (FontSizeUnits units) = + fontDescriptionSetAbsoluteSize fontDesc $ units * fromIntegral SCALE + +adjustFontDescSize :: (FontSize -> FontSize) -> FontDescription -> IO () +adjustFontDescSize f fontDesc = do + currSize <- fontDescriptionGetSize fontDesc + currAbsolute <- fontDescriptionGetSizeIsAbsolute fontDesc + let currFontSz = + if currAbsolute + then FontSizeUnits $ fromIntegral currSize / fromIntegral SCALE + else FontSizePoints $ round (fromIntegral currSize / fromIntegral SCALE) + let newFontSz = f currFontSz + setFontDescSize fontDesc newFontSz + +modifyFontSizeForAllTerms :: (FontSize -> FontSize) -> TMState -> IO () +modifyFontSizeForAllTerms modFontSize mvarTMState = do + tmState <- readMVar mvarTMState + let fontDesc = tmState ^. lensTMStateFontDesc + adjustFontDescSize modFontSize fontDesc + let terms = + tmState ^.. + lensTMStateNotebook . + lensTMNotebookTabs . + traverse . + lensTMNotebookTabTerm . + lensTerm + foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms + compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool compareScrolledWinAndTab scrollWin flTab = let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer flTab @@ -256,7 +293,7 @@ setupScreenStyle box <- objFromBuildUnsafe builder "content_box" Box - fontDesc <- createFontDesc tmConfig + fontDesc <- createFontDescFromConfig tmConfig note <- notebookNew widgetSetCanFocus note False boxPackStart box note True True 0 @@ -342,6 +379,18 @@ maybe (pure ()) terminalPasteClipboard maybeTerm actionMapAddAction app pasteAction applicationSetAccelsForAction app "app.paste" ["V"] + + enlargeFontAction <- simpleActionNew "enlargefont" Nothing + void $ onSimpleActionActivate enlargeFontAction $ \_ -> + modifyFontSizeForAllTerms (modFontSize 1) mvarTMState + actionMapAddAction app enlargeFontAction + applicationSetAccelsForAction app "app.enlargefont" ["plus"] + + reduceFontAction <- simpleActionNew "reducefont" Nothing + void $ onSimpleActionActivate reduceFontAction $ \_ -> + modifyFontSizeForAllTerms (modFontSize (-1)) mvarTMState + actionMapAddAction app reduceFontAction + applicationSetAccelsForAction app "app.reducefont" ["minus"] aboutAction <- simpleActionNew "about" Nothing void $ onSimpleActionActivate aboutAction (const $ showAboutDialog app) 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 @@ -189,7 +189,7 @@ affineCombo [(1, d), (coef x, i), (coef y, j), (coef z, k)] black where coef :: Fin N6 -> b - coef fin = fromIntegral (toIntFin fin) / 5 + coef fin' = fromIntegral (toIntFin fin') / 5 -- | A matrix of a 6 x 6 x 6 color cube. Default value for 'ColourCubePalette'. -- diff --git a/src/Termonad/Config/Vec.hs b/src/Termonad/Config/Vec.hs --- a/src/Termonad/Config/Vec.hs +++ b/src/Termonad/Config/Vec.hs @@ -51,6 +51,7 @@ import Data.Singletons.Prelude import Data.Singletons.TH import Text.Show (showParen, showString) +import Unsafe.Coerce (unsafeCoerce) -------------------------- -- Misc VecT Operations -- @@ -166,6 +167,18 @@ if n == 0 then Z else S (fromInteger (n - 1)) |]) +-- | This is a proof that if we know @'S' n@ is less than @'S' m@, then we +-- know @n@ is also less than @m@. +-- +-- >>> ltSuccProof (sing :: Sing N4) (sing :: Sing N5) +-- Refl +ltSuccProof :: + forall (n :: Peano) (m :: Peano) proxy. ('S n < 'S m) ~ 'True + => proxy n + -> proxy m + -> (n < m) :~: 'True +ltSuccProof _ _ = unsafeCoerce (Refl :: Int :~: Int) + --------- -- Fin -- --------- @@ -182,6 +195,27 @@ toIntFin FZ = 0 toIntFin (FS x) = succ $ toIntFin x +-- | Similar to 'ifin' but for 'Fin'. +-- +-- >>> fin (sing :: Sing N5) (sing :: Sing N1) :: Fin N5 +-- FS FZ +fin :: + forall total n. (n < total) ~ 'True + => Sing total + -> Sing n + -> Fin total +fin total n = toFinIFin $ ifin total n + +-- | Similar to 'ifin_' but for 'Fin'. +-- +-- >>> fin_ @N4 (sing :: Sing N2) :: Fin N4 +-- FS (FS FZ) +fin_ :: + forall total n. (SingI total, (n < total) ~ 'True) + => Sing n + -> Fin total +fin_ n = toFinIFin $ ifin_ n + data instance Sing (z :: Fin n) where SFZ :: Sing 'FZ SFS :: Sing x -> Sing ('FS x) @@ -196,12 +230,12 @@ type Demote (Fin n) = Fin n fromSing :: forall (a :: Fin n). Sing a -> Fin n fromSing SFZ = FZ - fromSing (SFS fin) = FS (fromSing fin) + fromSing (SFS fin') = FS (fromSing fin') toSing :: Fin n -> SomeSing (Fin n) toSing FZ = SomeSing SFZ - toSing (FS fin) = - case toSing fin of + toSing (FS fin') = + case toSing fin' of SomeSing n -> SomeSing (SFS n) instance Show (Sing 'FZ) where @@ -231,6 +265,32 @@ toIntIFin :: IFin n m -> Int toIntIFin = toIntFin . toFinIFin +-- | Create an 'IFin'. +-- +-- >>> ifin (sing :: Sing N5) (sing :: Sing N2) :: IFin N5 N2 +-- IFS (IFS IFZ) +ifin :: + forall total n. ((n < total) ~ 'True) + => Sing total + -> Sing n + -> IFin total n +ifin (SS _) SZ = IFZ +ifin (SS total') (SS n') = + IFS $ + case ltSuccProof n' total' of + Refl -> ifin total' n' +ifin _ _ = error "ifin: pattern impossible but GHC doesn't realize it" + +-- | Create an 'IFin', but take the total implicitly. +-- +-- >>> ifin_ @N5 (sing :: Sing N3) :: IFin N5 N3 +-- IFS (IFS (IFS IFZ)) +ifin_ :: + forall total n. (SingI total, (n < total) ~ 'True) + => Sing n + -> IFin total n +ifin_ = ifin sing + data instance Sing (z :: IFin n m) where SIFZ :: Sing 'IFZ SIFS :: Sing x -> Sing ('IFS x) @@ -245,12 +305,12 @@ type Demote (IFin n m) = IFin n m fromSing :: forall (a :: IFin n m). Sing a -> IFin n m fromSing SIFZ = IFZ - fromSing (SIFS fin) = IFS (fromSing fin) + fromSing (SIFS fin') = IFS (fromSing fin') toSing :: IFin n m -> SomeSing (IFin n m) toSing IFZ = SomeSing SIFZ - toSing (IFS fin) = - case toSing fin of + toSing (IFS fin') = + case toSing fin' of SomeSing n -> SomeSing (SIFS n) instance Show (Sing 'IFZ) where @@ -345,7 +405,7 @@ imapVec :: forall n a b. (Fin n -> a -> b) -> Vec n a -> Vec n b imapVec _ EmptyVec = EmptyVec -imapVec f (a :* as) = f FZ a :* imapVec (\fin vec -> f (FS fin) vec) as +imapVec f (a :* as) = f FZ a :* imapVec (\fin' vec -> f (FS fin') vec) as replaceVec_ :: SingI n => a -> Vec n a replaceVec_ = replaceVec sing @@ -370,7 +430,7 @@ updateAtVec (FS n) f (a :* vec) = a :* updateAtVec n f vec setAtVec :: Fin n -> a -> Vec n a -> Vec n a -setAtVec fin a = updateAtVec fin (const a) +setAtVec fin' a = updateAtVec fin' (const a) fromListVec :: Sing n -> [a] -> Maybe (Vec n a) fromListVec SZ _ = Just EmptyVec @@ -506,7 +566,7 @@ imapMatrix SNil f (Matrix a) = Matrix (f EmptyHList a) imapMatrix (SCons _ ns) f matrix = onMatrixTF - (imapVec (\fin -> onMatrix (imapMatrix ns (\hlist -> f (ConsHList fin hlist))))) + (imapVec (\fin' -> onMatrix (imapMatrix ns (\hlist -> f (ConsHList fin' hlist))))) matrix imapMatrix_ :: SingI ns => (HList Fin ns -> a -> b) -> Matrix ns a -> Matrix ns b @@ -538,14 +598,14 @@ instance SingI ns => Functor (Matrix ns) where fmap :: (a -> b) -> Matrix ns a -> Matrix ns b - fmap = fmapSingMatrix (sing @_ @ns) + fmap = fmapSingMatrix sing instance SingI ns => Data.Foldable.Foldable (Matrix ns) where foldr :: (a -> b -> b) -> b -> Matrix ns a -> b - foldr comb b = Data.Foldable.foldr comb b . toListMatrix (sing @_ @ns) + foldr comb b = Data.Foldable.foldr comb b . toListMatrix sing toList :: Matrix ns a -> [a] - toList = toListMatrix (sing @_ @ns) + toList = toListMatrix sing instance SingI ns => Distributive (Matrix ns) where distribute :: Functor f => f (Matrix ns a) -> Matrix ns (f a) diff --git a/src/Termonad/Types.hs b/src/Termonad/Types.hs --- a/src/Termonad/Types.hs +++ b/src/Termonad/Types.hs @@ -267,6 +267,33 @@ defaultFontSize :: FontSize defaultFontSize = FontSizePoints 12 +-- | Modify a 'FontSize' by adding some value. +-- +-- >>> modFontSize 1 (FontSizePoints 13) +-- FontSizePoints 14 +-- >>> modFontSize 1 (FontSizeUnits 9.0) +-- FontSizeUnits 10.0 +-- +-- You can reduce the font size by passing a negative value. +-- +-- >>> modFontSize (-2) (FontSizePoints 13) +-- FontSizePoints 11 +-- +-- If you try to create a font size less than 1, then the old font size will be +-- used. +-- +-- >>> modFontSize (-10) (FontSizePoints 5) +-- FontSizePoints 5 +-- >>> modFontSize (-1) (FontSizeUnits 1.0) +-- FontSizeUnits 1.0 +modFontSize :: Int -> FontSize -> FontSize +modFontSize i (FontSizePoints oldPoints) = + let newPoints = oldPoints + i + in FontSizePoints $ if newPoints < 1 then oldPoints else newPoints +modFontSize i (FontSizeUnits oldUnits) = + let newUnits = oldUnits + fromIntegral i + in FontSizeUnits $ if newUnits < 1 then oldUnits else newUnits + -- | Settings for the font to be used in Termonad. data FontConfig = FontConfig { fontFamily :: !Text diff --git a/src/Termonad/XML.hs b/src/Termonad/XML.hs --- a/src/Termonad/XML.hs +++ b/src/Termonad/XML.hs @@ -80,6 +80,17 @@ + View + + _Enlarge Font Size + app.enlargefont + + + _Reduce Font Size + app.reducefont + + + Help _About diff --git a/termonad.cabal b/termonad.cabal --- a/termonad.cabal +++ b/termonad.cabal @@ -1,5 +1,5 @@ name: termonad -version: 1.0.1.0 +version: 1.1.0.0 synopsis: Terminal emulator configurable in Haskell description: Please see . homepage: https://github.com/cdepillabout/termonad @@ -17,7 +17,8 @@ , img/termonad.png , .nix-helpers/nixops.nix , .nix-helpers/nixpkgs.nix - , .nix-helpers/stack-nix-shell.nix + , .nix-helpers/stack-fhs-env.nix + , .nix-helpers/stack-shell.nix , .nix-helpers/termonad-with-packages.nix , shell.nix data-files: img/termonad-lambda.png @@ -50,7 +51,7 @@ , Termonad.Types , Termonad.XML other-modules: Paths_termonad - build-depends: base >= 4.7 && < 5 + build-depends: base >= 4.11 && < 5 , adjunctions , classy-prelude , colour @@ -190,6 +191,20 @@ build-depends: base , termonad , colour + , singletons + default-language: Haskell2010 + + if flag(buildexamples) + buildable: True + else + buildable: False + +executable termonad-example-colour-extension-solarized + main-is: example-config/ExampleSolarizedColourExtension.hs + build-depends: base + , termonad + , colour + , singletons default-language: Haskell2010 if flag(buildexamples) diff --git a/test/readme/README.lhs b/test/readme/README.lhs --- a/test/readme/README.lhs +++ b/test/readme/README.lhs @@ -226,6 +226,8 @@ |------------|--------| | Ctrl Shift t | Open new tab. | | Ctrl Shift w | Close tab. | +| Ctrl + | Increase font size. | +| Ctrl - | Decrease font size. | | Alt (number key) | Switch to tab `number`. For example, Alt 2 switches to tab 2. | ### Configuring Termonad @@ -291,6 +293,9 @@ `addColourExtension` colExt defaultMain termonadConf ``` + +There are other example configuration files in the +[example-config/](./example-config) directory. ### Compiling Local Settings