termonad 4.5.0.0 → 4.6.0.0

raw patch · 30 files changed

+2451/−1324 lines, 30 filesdep +bytestringdep +gi-gdkpixbufdep +optparse-applicativedep −adjunctionsdep −classy-preludedep −constraintsdep ~dyrePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, gi-gdkpixbuf, optparse-applicative

Dependencies removed: adjunctions, classy-prelude, constraints, distributive, genvalidity-containers, genvalidity-hspec, hedgehog, mono-traversable, tasty-hedgehog, tasty-hspec

Dependency ranges changed: dyre

API changes (from Hackage documentation)

Files

• .nix-helpers/nixops.nix +0/−110
• .nix-helpers/nixos-vm.nix +110/−0
• .nix-helpers/overlays.nix +7/−3
• .nix-helpers/termonad-with-packages.nix +1/−1
• CHANGELOG.md +46/−0
• README.md +43/−34
• default.nix +1/−2
• flake.lock +3/−3
• flake.nix +1/−1
• src/Termonad.hs +4/−2
• src/Termonad/App.hs +67/−719
• src/Termonad/Cli.hs +434/−0
• src/Termonad/Config.hs +7/−5
• src/Termonad/Config/Colour.hs +9/−5
• src/Termonad/Gtk.hs +19/−9
• src/Termonad/IdMap.hs +25/−0
• src/Termonad/IdMap/Internal.hs +165/−0
• src/Termonad/Keys.hs +29/−22
• src/Termonad/Lenses.hs +8/−3
• src/Termonad/Preferences.hs +315/−0
• src/Termonad/Preferences/File.hs +209/−0
• src/Termonad/PreferencesFile.hs +0/−195
• src/Termonad/Prelude.hs +26/−1
• src/Termonad/Startup.hs +149/−0
• src/Termonad/Term.hs +84/−61
• src/Termonad/Types.hs +222/−83
• src/Termonad/Window.hs +386/−0
• src/Termonad/XML.hs +23/−12
• termonad.cabal +15/−19
• test/readme/README.lhs +43/−34

@@ -1,110 +0,0 @@-# This file can be used with `nixops` to create a virtual machine that has-# Termonad installed.-#-# I use this to test out Termonad in a desktop environment with a menubar.-#-# On my development machine, I use XMonad as a Window Manager, so there are-# no Window decorations for any X application.  This file creates a VM-# with Termonad installed in Gnome 3.  This lets you see what Termonad-# looks like when it has Window decorations, a title bar, etc.-#-# A virtual machine can be created based on this file with the following-# commands:-#-# $ nixops create --deployment termonad-test .nix-helpers/nixops.nix-# $ nixops deploy --deployment termonad-test-#-# This should open up a VirtualBox machine and start installing Gnome 3,-# Termonad, etc.-#-# You should be able to login with the username "myuser" and password "foobar".-#-# When you are done you can destroy the machine and delete the deployment:-#-# $ nixops destroy --deployment termonad-test-# $ nixops delete --deployment termonad-test-#--{-  network.description = "Gnome With Termonad";--  termonad-machine =-    { config, pkgs, ...}:-    {-      imports = [ ];--      deployment = {-        targetEnv = "virtualbox";-        virtualbox = {-          disks.disk1.size = 20480;-          headless = false;-          memorySize = 2024;-          vcpu = 1;-        };-      };--      environment = {-        systemPackages =-          let-            pkgList = with pkgs; [-              acpi aspell aspellDicts.en autojump bash bash-completion bc-              chromium curl dmenu emacs evince file firefoxWrapper gcc geeqie-              gimp gitAndTools.gitFull gitAndTools.hub gnumake gnupg hexchat-              htop imagemagick jq k2pdfopt ltrace manpages ncurses-              nix-bash-completions nixops p7zip pkgconfig psmisc python3-              redshift roxterm screen strace tree unzip usbutils vimHugeX wget-              wirelesstools xfce.terminal xorg.xbacklight xorg.xmodmap-              xscreensaver xterm zlib-            ];-            termonad = import ../default.nix { };-          in [ termonad ] ++ pkgList;-        variables.EDITOR = "vim";-      };--      fonts.fonts = with pkgs; [-        dejavu_fonts ipafont source-code-pro ttf_bitstream_vera-      ];--      i18n = {-        consoleFont = "Lat2-Terminus16";-        consoleKeyMap = "us";-        defaultLocale = "en_US.UTF-8";-        inputMethod = {-          enabled = "fcitx";-          fcitx.engines = with pkgs.fcitx-engines; [ mozc ];-        };-      };--      programs.bash.enableCompletion = true;--      services = {-        xserver = {-          enable = true;-          layout = "us";-          desktopManager.gnome3.enable = true;-        };-        openssh = {-          enable = true;-          forwardX11 = true;-          challengeResponseAuthentication = true;-          passwordAuthentication = true;-          permitRootLogin = "yes";-        };-      };--      security.sudo = {-        enable = true;-        extraConfig = ''-          %wheel      ALL=(ALL:ALL) NOPASSWD: ${pkgs.systemd}/bin/poweroff-          %wheel      ALL=(ALL:ALL) NOPASSWD: ${pkgs.systemd}/bin/reboot-          %wheel      ALL=(ALL:ALL) NOPASSWD: ${pkgs.systemd}/bin/systemctl suspend-        '';-      };--      users.extraUsers.myuser = {-        extraGroups = [ "audio" "systemd-journal" "video" "wheel" ];-        initialPassword = "foobar";-        isNormalUser = true;-      };-    };-}

@@ -0,0 +1,110 @@++# This file is used to build a NixOS VM that can be used to test Termonad in a+# known-working desktop environment (DE) / window manager (WM).+#+# This is helpful for developers using a minimal WM (like XMonad), but want to+# check how Termonad looks in a more full-featured desktop environment.+#+# You can build the VM with the following command:+#+# $ nix-build "$(nix-instantiate --eval -E 'with import ./nixpkgs.nix {}; path')"/nixos -A vm -I nixpkgs=./nixpkgs.nix -I nixos-config=./nixos-vm.nix+#+# You can run the resulting VM with the following command:+#+# $ ./result/bin/run-termonad-nixos-vm-vm -m 4G+#+# The `-m` flag allows you to specify how much RAM is used.++{ config, pkgs, lib, ... }:++{+  nixpkgs.overlays = import ./overlays.nix;++  boot.loader.systemd-boot.enable = true;+  boot.loader.efi.canTouchEfiVariables = true;++  networking.hostName = "termonad-nixos-vm";+  networking.networkmanager.enable = true;+  networking.useDHCP = lib.mkDefault true;++  time.timeZone = "UTC";++  environment.systemPackages = with pkgs; [+    curl+    file+    firefox+    htop+    jq+    ltrace+    nix-bash-completions+    pkg-config+    psmisc+    screen+    strace+    termonad+    tree+    unzip+    vimHugeX+    wget+    xterm+  ];++  environment.variables = {+    EDITOR = "vim";+  };++  fonts.fonts = with pkgs; [+    dejavu_fonts ipafont+  ];++  i18n = {+    defaultLocale = "en_US.UTF-8";+    supportedLocales = [ "C.UTF-8/UTF-8" "en_US.UTF-8/UTF-8" "ja_JP.UTF-8/UTF-8" ];+    inputMethod = {+      enabled = "fcitx5";+      fcitx5.addons = with pkgs; [ fcitx5-mozc fcitx5-rime fcitx5-chinese-addons ];+    };+  };++  console = {+    font = "Lat2-Terminus16";+    keyMap = "us";+  };++  programs.bash.enableCompletion = true;++  services.xserver = {+    enable = true;+    layout = "us";+    desktopManager.gnome.enable = true;+  };++  services.openssh = {+    enable = true;+    settings = {+      X11Forwarding = true;+      KbdInteractiveAuthentication = true;+      ChallengeResponseAuthentication = true;+      PasswordAuthentication = true;+      PermitRootLogin = "yes";+      MaxAuthTries = 12;+    };+  };++  security.sudo = {+    enable = true;+    extraConfig = ''+      %wheel      ALL=(ALL:ALL) NOPASSWD: ${pkgs.systemd}/bin/poweroff+      %wheel      ALL=(ALL:ALL) NOPASSWD: ${pkgs.systemd}/bin/reboot+      %wheel      ALL=(ALL:ALL) NOPASSWD: ${pkgs.systemd}/bin/systemctl suspend+    '';+  };++  users.extraUsers.myuser = {+    extraGroups = [ "audio" "systemd-journal" "video" "wheel" ];+    initialPassword = "foobar";+    isNormalUser = true;+  };++  system.stateVersion = "23.05"; # Did you read the comment?+}

@@ -78,7 +78,7 @@     #     # Either this, or termonadKnownWorkingHaskellPkgSet can be changed in an overlay     # if you want to use a different GHC to build Termonad.-    termonadCompilerVersion = "ghc92";+    termonadCompilerVersion = "ghc94";      # A Haskell package set where we know the GHC version works to compile     # Termonad.  This is basically just a shortcut so that other Nix files@@ -146,7 +146,7 @@       lens     ]; -    termonad-with-packages =+    termonad =       let         # GHC environment that has termonad available, as well as the packages         # specified above in extraHaskellPackages.@@ -155,7 +155,7 @@             (hpkgs: [ hpkgs.termonad ] ++ self.termonadExtraHaskellPackages hpkgs);       in       self.stdenv.mkDerivation {-        name = "termonad-with-packages-ghc-${env.version}";+        name = "termonad-${self.termonadKnownWorkingHaskellPkgSet.termonad.version}-ghc-${env.version}";         buildInputs = [           self.gdk-pixbuf           self.gnome.adwaita-icon-theme@@ -178,6 +178,10 @@         preferLocalBuild = true;         allowSubstitutes = false;       };++    # This is just a small compatibility layer for people that used to use+    # termonad-with-packages instead of just termonad.+    termonad-with-packages = self.termonad;   }; in 

@@ -100,4 +100,4 @@   }; in -pkgs.termonad-with-packages+pkgs.termonad

@@ -1,3 +1,49 @@+## 4.6.0.0++*   The thing that may affect end users the most in this release is that the+    **`defaultMain` function moved from `Termonad.App` to `Termonad.Startup`**.+    (_However, it is also exported from the top-level `Termonad` module, so most+    users will likely want to get it from the top-level `Termonad` module_.)+    [#239](https://github.com/cdepillabout/termonad/pull/239)++*   There has been a big refactoring of the guts of Termonad.  As an end user,+    if you reach into any modules like `Termonad.App`, `Termonad.Term`, or+    `Termonad.Types`, you may notice some functions have moved around or gained+    new arguments.  Some data types have changed as well.  Most end users don't+    use these modules, so I don't expect that this refactoring will affect most+    users.++*   Add support for setting Termonad options with CLI arguments.  Add a whole+    CLI argument parser based on optparse-applicative.+    [#234](https://github.com/cdepillabout/termonad/pull/234)++    Check out `termonad --help` to see the options available to be set from the CLI.++    By default, passing CLI options will override options specified in the+    `termonad.hs` file, as well as options specified in the Preferences dialog.++    In your own `termonad.hs` file, if you want to not use this CLI argument+    funtionality, you should be able to use the `Termonad.start` function (in+    place of `Termonad.defaultMain`).++*   Embed the Termonad icon into the Termonad library (instead of having it set+    as a `data-file` in `termonad.cabal`).++    This fixes a problem some users were seeing when garbaging-collecting their+    Nix store and losing the required `termonad-lambda.png` file that their+    Termonad binary was referencing:+    [#165](https://github.com/cdepillabout/termonad/issues/165)++    Thanks [@refaelsh](https://github.com/refaelsh)! [#236](https://github.com/cdepillabout/termonad/pull/236)++*   Rename the `Termonad.PreferencesFile` module to `Termonad.Preferences.File`.++    Also, add a `Termonad.Preferences` module that re-exports everything helpful+    from the `Termonad.Preferences.File` module.  Also, some of the+    preferences-related functionality from `Termonad.App` has been moved into+    `Termonad.Preferences`.+    [#238](https://github.com/cdepillabout/termonad/pull/238)+ ## 4.5.0.0  *   Add an `allowBold` option (which defaults to `True`).  This can be used if

@@ -292,35 +292,34 @@  Termonad is similar to XMonad. The above steps will install a `termonad` binary somewhere on your system. If you have installed Termonad using `stack`, the-`termonad` binary will be in `~/.local/bin/`. This binary is a version of-Termonad configured with default settings. You can try running it to get an idea-of what Termonad is like:+`termonad` binary will be in `~/.local/bin/`. If you have installed Termonad using+your Linux distro, the `termonad` binary will likely be in `/usr/bin/`. This+binary is a version of Termonad configured with default settings. You can try+running it to get an idea of what Termonad is like:  ```sh-$ ~/.local/bin/termonad+$ /usr/bin/termonad ``` -The following section describes the default key bindings.- If you would like to configure Termonad with your own settings, first you will need to create a Haskell file called `~/.config/termonad/termonad.hs`. A following section gives an example configuration file. -If this configuration file exists, when the `~/.local/bin/termonad` binary+If this configuration file exists, when the `/usr/bin/termonad` binary launches, it will try to use GHC to compile the configuration file. If GHC is able to successfully compile the configuration file, a separate binary will be created called something like `~/.cache/termonad/termonad-linux-x86_64`. This binary file can be thought of as your own personal Termonad, configured with all your own settings. -When you run `~/.local/bin/termonad`, it will re-exec+When you run `/usr/bin/termonad`, it will re-exec `~/.cache/termonad/termonad-linux-x86_64` if it exists.  However, there is one difficulty with this setup. In order for the-`~/.local/bin/termonad` binary to be able to compile your+`/usr/bin/termonad` binary to be able to compile your `~/.config/termonad/termonad.hs` configuration file, Termonad needs to know where GHC is, as well as where all your Haskell packages live. This presents-some difficulties that will be discussed in a following section.+some difficulties that will be discussed in one of the following sections.  ### Default Key Bindings @@ -341,31 +340,40 @@  ### Configuring Termonad -Termonad has two different ways to be configured.+Termonad has three different ways to be configured. -The first way is to use the built-in Preferences editor.  You can find this in-the `Preferences` menu under `Edit` in the menubar.+1.  Pass arguments on the command line.  For instance, run+    `termonad --no-show-menu` to never show the `File` menubar. -When opening Termonad for the first time, it will create a preferences file at-`~/.config/termonad/termonad.yaml`.  When you change a setting in the-Preferences editor, Termonad will update the setting in the preferences file.+    Arguments passed on the command line will normally override other+    configuration methods. -When running Termonad, it will load settings from the preferences file.-Do not edit the preferences file by hand, because it will be overwritten when-updating settings in the Preferences editor.+2.  Use the built-in Preferences editor.  You can find this in+    the `Preferences` menu under `Edit` in the menubar. -This method is perfect for users who only want to make small changes to the-Termonad settings, like the default font size.+    When opening Termonad for the first time, it will create a preferences file+    at `~/.config/termonad/termonad.yaml`.  When you change a setting in the+    Preferences editor, Termonad will update the setting in the preferences+    file. -The second way to configure Termonad is to use a Haskell-based settings file,-called `~/.config/termonad/termonad.hs` by default.  This method allows you to-make large, sweeping changes to Termonad.  This method is recommended for power-users.+    When running Termonad, it will load settings from the preferences file. Do+    not edit the preferences file by hand, because it will be overwritten when+    updating settings in the Preferences editor. +    This method is perfect for users who only want to make small changes to the+    Termonad settings, like the default font size.++3.  Use a Haskell-based settings file, called `~/.config/termonad/termonad.hs` by default.+    This method allows you to make large, sweeping changes to Termonad.  This+    method is recommended for power users.++    The rest of this section explains the `~/.config/termonad/termonad.hs` file.+ **WARNING: If you have a `~/.config/termonad/termonad.hs` file, then all settings from `~/.config/termonad/termonad.yaml` will be ignored.  If you want to set *ANY* settings in `~/.config/termonad/termonad.hs`, then you must-set *ALL* settings in `~/.config/termonad/termonad.hs`.**+set *ALL* settings in `~/.config/termonad/termonad.hs`.  However, as stated above,+CLI arguments will override settings in `~/.config/termonad/termonad.hs` by default.**  The following is an example Termonad configuration file. You should save this to `~/.config/termonad/termonad.hs`. You can find more information on the available@@ -378,11 +386,11 @@  module Main where -import Termonad.App (defaultMain)-import Termonad.Config+import Termonad   ( FontConfig, FontSize(FontSizePoints), Option(Set)   , ShowScrollbar(ShowScrollbarAlways), defaultConfigOptions, defaultFontConfig-  , defaultTMConfig, fontConfig, fontFamily, fontSize, options, showScrollbar+  , defaultMain, defaultTMConfig, fontConfig, fontFamily, fontSize, options+  , showScrollbar   ) import Termonad.Config.Colour   ( AlphaColour, ColourConfig, addColourExtension, createColour@@ -439,9 +447,9 @@  ### Compiling Local Settings -If you launch Termonad by calling `~/.local/bin/termonad`, it will try to+If you launch Termonad by calling `/usr/bin/termonad`, it will try to compile the `~/.config/termonad/termonad.hs` file if it exists.  The problem is-that `~/.local/bin/termonad` needs to be able to see GHC and the required+that `/usr/bin/termonad` needs to be able to see GHC and the required Haskell libraries to be able to compile `~/.config/termonad/termonad.hs`.  There are a couple solutions to this problem, listed in the sections below.@@ -452,9 +460,10 @@  #### Running with `stack` -If you originally compiled Termonad with `stack`, you can use `stack` to-execute Termonad.  First, you must change to the directory with the Termonad-source code.  From there, you can run `stack exec`:+If you originally compiled Termonad with `stack` and installed it to+`~/.local/bin/termonad`, you can use `stack` to execute Termonad.  First, you+must change to the directory with the Termonad source code.  From there, you+can run `stack exec`:  ```sh $ cd termonad/  # change to the termonad source code directory

@@ -24,5 +24,4 @@ , enableSixelSupport ? false }@args: -(import .nix-helpers/nixpkgs.nix args).termonad-with-packages-+(import .nix-helpers/nixpkgs.nix args).termonad

@@ -2,11 +2,11 @@   "nodes": {     "nixpkgs": {       "locked": {-        "lastModified": 1680213900,-        "narHash": "sha256-cIDr5WZIj3EkKyCgj/6j3HBH4Jj1W296z7HTcWj1aMA=",+        "lastModified": 1704194953,+        "narHash": "sha256-RtDKd8Mynhe5CFnVT8s0/0yqtWFMM9LmCzXv/YKxnq4=",         "owner": "NixOS",         "repo": "nixpkgs",-        "rev": "e3652e0735fbec227f342712f180f4f21f0594f2",+        "rev": "bd645e8668ec6612439a9ee7e71f7eac4099d4f6",         "type": "github"       },       "original": {

@@ -44,7 +44,7 @@         let           pkgs = nixpkgsFor.${system};         in {-          termonad = pkgs.termonad-with-packages;+          termonad = pkgs.termonad;         }       ); 

@@ -5,15 +5,17 @@ -- Stability   : experimental -- Portability : POSIX ----- This module exposes termonad's basic configuration options, as well as 'defaultMain'.+-- This module exposes Termonad's basic configuration options, as well as 'defaultMain', 'startWithCliArgs', and 'start'. -- -- If you want to configure Termonad, please take a look at "Termonad.Config".  module Termonad   ( defaultMain+  , startWithCliArgs   , start   , module Config   ) where -import Termonad.App (defaultMain, start)+import Termonad.App (start) import Termonad.Config as Config+import Termonad.Startup (defaultMain, startWithCliArgs)

@@ -1,13 +1,14 @@+{-# LANGUAGE TemplateHaskell #-}+ module Termonad.App where  import Termonad.Prelude -import Config.Dyre (defaultParams, projectName, realMain, showError, wrapMain)-import Control.Lens ((.~), (^.), (^..), over, set, view)-import Control.Monad.Fail (fail)-import Data.FocusList (focusList, moveFromToFL, updateFocusFL)-import Data.Sequence (findIndexR)-import GI.Gdk (castTo, managedForeignPtr, screenGetDefault)+import Control.Lens ((^.))+import Data.FileEmbed (embedFile)+import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8)+import GI.Gdk (screenGetDefault) import GI.Gio   ( ApplicationFlags(ApplicationFlagsFlagsNone)   , MenuModel(MenuModel)@@ -23,20 +24,9 @@   ( Application   , ApplicationWindow(ApplicationWindow)   , Box(Box)-  , CheckButton(CheckButton)-  , ComboBoxText(ComboBoxText)-  , Dialog(Dialog)-  , Entry(Entry)-  , FontButton(FontButton)-  , Label(Label)-  , PolicyType(PolicyTypeAutomatic)-  , PositionType(PositionTypeRight)-  , ResponseType(ResponseTypeAccept, ResponseTypeNo, ResponseTypeYes)-  , ScrolledWindow(ScrolledWindow)-  , SpinButton(SpinButton)+  , Notebook+  , ResponseType(ResponseTypeNo, ResponseTypeYes)   , pattern STYLE_PROVIDER_PRIORITY_APPLICATION-  , aboutDialogNew-  , adjustmentNew   , applicationAddWindow   , applicationGetActiveWindow   , applicationSetAccelsForAction@@ -45,142 +35,55 @@   , boxPackStart   , builderNewFromString   , builderSetApplication-  , comboBoxGetActiveId-  , comboBoxSetActiveId-  , comboBoxTextAppend   , containerAdd   , cssProviderLoadFromData   , cssProviderNew   , dialogAddButton   , dialogGetContentArea   , dialogNew-  , dialogResponse   , dialogRun-  , entryBufferGetText-  , entryBufferSetText-  , entryGetText-  , entryNew-  , fontChooserSetFontDesc-  , fontChooserGetFontDesc-  , getEntryBuffer-  , gridAttachNextTo-  , gridNew   , labelNew   , notebookGetNPages   , notebookNew   , notebookSetShowBorder-  , onEntryActivate   , onNotebookPageRemoved-  , onNotebookPageReordered-  , onNotebookSwitchPage   , onWidgetDeleteEvent-  , scrolledWindowSetPolicy   , setWidgetMargin-  , spinButtonGetValueAsInt-  , spinButtonSetAdjustment-  , spinButtonSetValue   , styleContextAddProviderForScreen-  , toggleButtonGetActive-  , toggleButtonSetActive   , widgetDestroy   , widgetGrabFocus   , widgetSetCanFocus-  , widgetSetVisible   , widgetShow   , widgetShowAll   , windowPresent-  , windowSetDefaultIconFromFile+  , windowSetDefaultIcon   , windowSetTitle   , windowSetTransientFor   ) import qualified GI.Gtk as Gtk-import GI.Pango-  ( FontDescription-  , pattern SCALE-  , fontDescriptionGetFamily-  , fontDescriptionGetSize-  , fontDescriptionGetSizeIsAbsolute-  , fontDescriptionNew-  , fontDescriptionSetFamily-  , fontDescriptionSetSize-  , fontDescriptionSetAbsoluteSize-  )-import GI.Vte-  ( CursorBlinkMode(..)-  , catchRegexError-  , regexNewForSearch-  , terminalCopyClipboard-  , terminalPasteClipboard-  , terminalSearchFindNext-  , terminalSearchFindPrevious-  , terminalSearchSetRegex-  , terminalSearchSetWrapAround-  , terminalSetBoldIsBright-  , terminalSetCursorBlinkMode-  , terminalSetFont-  , terminalSetScrollbackLines-  , terminalSetWordCharExceptions-  , terminalSetAllowBold-  )-import System.Environment (getExecutablePath)-import System.FilePath (takeFileName)--import Paths_termonad (getDataFileName)-import Termonad.Gtk (appNew, objFromBuildUnsafe, terminalSetEnableSixelIfExists)+import Termonad.Gtk (appNew, imgToPixbuf, objFromBuildUnsafe) import Termonad.Keys (handleKeyPress) import Termonad.Lenses-  ( lensBoldIsBright-  , lensEnableSixel-  , lensAllowBold-  , lensConfirmExit-  , lensCursorBlinkMode-  , lensFontConfig+  ( lensConfirmExit   , lensOptions   , lensShowMenu-  , lensShowScrollbar-  , lensShowTabBar-  , lensScrollbackLen-  , lensTMNotebook-  , lensTMNotebookTabTermContainer-  , lensTMNotebookTabs-  , lensTMNotebookTabTerm   , lensTMStateApp-  , lensTMStateAppWin   , lensTMStateConfig-  , lensTMStateFontDesc-  , lensTMStateNotebook   , lensTerm-  , lensWordCharExceptions   )-import Termonad.PreferencesFile (saveToPreferencesFile)-import Termonad.Term-  ( createTerm-  , relabelTabs-  , termNextPage-  , termPrevPage-  , termExitFocused-  , setShowTabs-  , showScrollbarToPolicy-  )+import Termonad.Preferences (showPreferencesDialog)+import Termonad.Term (createTerm, setShowTabs) import Termonad.Types-  ( ConfigOptions(..)-  , FontConfig(..)-  , FontSize(FontSizePoints, FontSizeUnits)-  , ShowScrollbar(..)-  , ShowTabBar(..)-  , TMConfig-  , TMNotebookTab+  ( TMConfig   , TMState-  , TMState'(TMState)-  , getFocusedTermFromState+  , TMState'+  , TMWindowId+  , createFontDescFromConfig   , modFontSize   , newEmptyTMState-  , tmNotebookTabTermContainer-  , tmNotebookTabs-  , tmStateApp-  , tmStateNotebook   )-import Termonad.XML (interfaceText, menuText, preferencesText)+import Termonad.XML (interfaceText, menuText)+import Termonad.Window (showAboutDialog, modifyFontSizeForAllTerms, setupWindowCallbacks)  setupScreenStyle :: IO () setupScreenStyle = do@@ -219,95 +122,13 @@             , "  background-color: transparent;"             , "}"             ]-      let styleData = encodeUtf8 (unlines textLines :: Text)+      let styleData = encodeUtf8 (Text.unlines textLines)       cssProviderLoadFromData cssProvider styleData       styleContextAddProviderForScreen         screen         cssProvider         (fromIntegral STYLE_PROVIDER_PRIORITY_APPLICATION) -createFontDescFromConfig :: TMConfig -> IO FontDescription-createFontDescFromConfig tmConfig = do-  let fontConf = tmConfig ^. lensOptions . lensFontConfig-  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-  currFontSz <- fontSizeFromFontDescription fontDesc-  let newFontSz = f currFontSz-  setFontDescSize fontDesc newFontSz--modifyFontSizeForAllTerms :: (FontSize -> FontSize) -> TMState -> IO ()-modifyFontSizeForAllTerms modFontSizeFunc mvarTMState = do-  tmState <- readMVar mvarTMState-  let fontDesc = tmState ^. lensTMStateFontDesc-  adjustFontDescSize modFontSizeFunc fontDesc-  let terms =-        tmState ^..-          lensTMStateNotebook .-          lensTMNotebookTabs .-          traverse .-          lensTMNotebookTabTerm .-          lensTerm-  foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms--fontSizeFromFontDescription :: FontDescription -> IO FontSize-fontSizeFromFontDescription fontDesc = do-  currSize <- fontDescriptionGetSize fontDesc-  currAbsolute <- fontDescriptionGetSizeIsAbsolute fontDesc-  return $ if currAbsolute-             then FontSizeUnits $ fromIntegral currSize / fromIntegral SCALE-             else-               let fontRatio :: Double = fromIntegral currSize / fromIntegral SCALE-               in FontSizePoints $ round fontRatio--fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)-fontConfigFromFontDescription fontDescription = do-  fontSize <- fontSizeFromFontDescription fontDescription-  maybeFontFamily <- fontDescriptionGetFamily fontDescription-  return $ (`FontConfig` fontSize) <$> maybeFontFamily--compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool-compareScrolledWinAndTab scrollWin flTab =-  let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer flTab-      foreignPtrFLTab = managedForeignPtr managedPtrFLTab-      ScrolledWindow managedPtrScrollWin = scrollWin-      foreignPtrScrollWin = managedForeignPtr managedPtrScrollWin-  in foreignPtrFLTab == foreignPtrScrollWin--updateFLTabPos :: TMState -> Int -> Int -> IO ()-updateFLTabPos mvarTMState oldPos newPos =-  modifyMVar_ mvarTMState $ \tmState -> do-    let tabs = tmState ^. lensTMStateNotebook . lensTMNotebookTabs-        maybeNewTabs = moveFromToFL oldPos newPos tabs-    case maybeNewTabs of-      Nothing -> do-        putStrLn $-          "in updateFLTabPos, Strange error: couldn't move tabs.\n" <>-          "old pos: " <> tshow oldPos <> "\n" <>-          "new pos: " <> tshow newPos <> "\n" <>-          "tabs: " <> tshow tabs <> "\n" <>-          "maybeNewTabs: " <> tshow maybeNewTabs <> "\n" <>-          "tmState: " <> tshow tmState-        pure tmState-      Just newTabs ->-        pure $-          tmState &-            lensTMStateNotebook . lensTMNotebookTabs .~ newTabs- -- | Try to figure out whether Termonad should exit.  This also used to figure -- out if Termonad should close a given terminal. --@@ -369,23 +190,16 @@   let app = tmState ^. lensTMStateApp   applicationQuit app -setupTermonad :: TMConfig -> Application -> ApplicationWindow -> Gtk.Builder -> IO ()-setupTermonad tmConfig app win builder = do-  termonadIconPath <- getDataFileName "img/termonad-lambda.png"-  windowSetDefaultIconFromFile termonadIconPath--  setupScreenStyle-  box <- objFromBuildUnsafe builder "content_box" Box-  fontDesc <- createFontDescFromConfig tmConfig-  note <- notebookNew-  widgetSetCanFocus note False-  -- If this is not set to False, then there will be a one pixel white border-  -- shown around the notebook.-  notebookSetShowBorder note False-  boxPackStart box note True True 0--  mvarTMState <- newEmptyTMState tmConfig app win note fontDesc-  terminal <- createTerm handleKeyPress mvarTMState+setupAppCallbacks :: TMState -> TMConfig -> Application -> ApplicationWindow -> Notebook -> TMWindowId -> IO ()+setupAppCallbacks mvarTMState tmConfig app win note tmWinId = do+  newWindowAction <- simpleActionNew "newwin" Nothing+  void $ onSimpleActionActivate newWindowAction $ \_ ->+    pure ()+    -- void $ createTerm handleKeyPress mvarTMState tmWinId+  actionMapAddAction app newWindowAction+  -- TODO: Uncomment this when adding the actual functionality+  -- for creating new windows.+  -- applicationSetAccelsForAction app "app.newwin" ["<Shift><Ctrl>N"]    void $ onNotebookPageRemoved note $ \_ _ -> do     pages <- notebookGetNPages note@@ -393,65 +207,6 @@       then forceQuit mvarTMState       else setShowTabs tmConfig note -  void $ onNotebookSwitchPage note $ \_ pageNum -> do-    modifyMVar_ mvarTMState $ \tmState -> do-      let notebook = tmStateNotebook tmState-          tabs = tmNotebookTabs notebook-          maybeNewTabs = updateFocusFL (fromIntegral pageNum) tabs-      case maybeNewTabs of-        Nothing -> pure tmState-        Just (tab, newTabs) -> do-          widgetGrabFocus $ tab ^. lensTMNotebookTabTerm . lensTerm-          pure $-            tmState &-              lensTMStateNotebook . lensTMNotebookTabs .~ newTabs--  void $ onNotebookPageReordered note $ \childWidg pageNum -> do-    maybeScrollWin <- castTo ScrolledWindow childWidg-    case maybeScrollWin of-      Nothing ->-        fail $-          "In setupTermonad, in callback for onNotebookPageReordered, " <>-          "child widget is not a ScrolledWindow.\n" <>-          "Don't know how to continue.\n"-      Just scrollWin -> do-        TMState{tmStateNotebook} <- readMVar mvarTMState-        let fl = tmStateNotebook ^. lensTMNotebookTabs-        let maybeOldPosition =-              findIndexR (compareScrolledWinAndTab scrollWin) (focusList fl)-        case maybeOldPosition of-          Nothing ->-            fail $-              "In setupTermonad, in callback for onNotebookPageReordered, " <>-              "the ScrolledWindow is not already in the FocusList.\n" <>-              "Don't know how to continue.\n"-          Just oldPos -> do-            updateFLTabPos mvarTMState oldPos (fromIntegral pageNum)-            relabelTabs mvarTMState--  newTabAction <- simpleActionNew "newtab" Nothing-  void $ onSimpleActionActivate newTabAction $ \_ -> void $ createTerm handleKeyPress mvarTMState-  actionMapAddAction app newTabAction-  applicationSetAccelsForAction app "app.newtab" ["<Shift><Ctrl>T"]--  nextPageAction <- simpleActionNew "nextpage" Nothing-  void $ onSimpleActionActivate nextPageAction $ \_ ->-    termNextPage mvarTMState-  actionMapAddAction app nextPageAction-  applicationSetAccelsForAction app "app.nextpage" ["<Ctrl>Page_Down"]--  prevPageAction <- simpleActionNew "prevpage" Nothing-  void $ onSimpleActionActivate prevPageAction $ \_ ->-    termPrevPage mvarTMState-  actionMapAddAction app prevPageAction-  applicationSetAccelsForAction app "app.prevpage" ["<Ctrl>Page_Up"]--  closeTabAction <- simpleActionNew "closetab" Nothing-  void $ onSimpleActionActivate closeTabAction $ \_ ->-    termExitFocused mvarTMState-  actionMapAddAction app closeTabAction-  applicationSetAccelsForAction app "app.closetab" ["<Shift><Ctrl>W"]-   quitAction <- simpleActionNew "quit" Nothing   void $ onSimpleActionActivate quitAction $ \_ -> do     shouldExit <- askShouldExit mvarTMState@@ -459,63 +214,26 @@   actionMapAddAction app quitAction   applicationSetAccelsForAction app "app.quit" ["<Shift><Ctrl>Q"] -  copyAction <- simpleActionNew "copy" Nothing-  void $ onSimpleActionActivate copyAction $ \_ -> do-    maybeTerm <- getFocusedTermFromState mvarTMState-    maybe (pure ()) terminalCopyClipboard maybeTerm-  actionMapAddAction app copyAction-  applicationSetAccelsForAction app "app.copy" ["<Shift><Ctrl>C"]--  pasteAction <- simpleActionNew "paste" Nothing-  void $ onSimpleActionActivate pasteAction $ \_ -> do-    maybeTerm <- getFocusedTermFromState mvarTMState-    maybe (pure ()) terminalPasteClipboard maybeTerm-  actionMapAddAction app pasteAction-  applicationSetAccelsForAction app "app.paste" ["<Shift><Ctrl>V"]-   preferencesAction <- simpleActionNew "preferences" Nothing   void $ onSimpleActionActivate preferencesAction (const $ showPreferencesDialog mvarTMState)   actionMapAddAction app preferencesAction    enlargeFontAction <- simpleActionNew "enlargefont" Nothing   void $ onSimpleActionActivate enlargeFontAction $ \_ ->-    modifyFontSizeForAllTerms (modFontSize 1) mvarTMState+    modifyFontSizeForAllTerms (modFontSize 1) mvarTMState tmWinId   actionMapAddAction app enlargeFontAction   applicationSetAccelsForAction app "app.enlargefont" ["<Ctrl>plus"]    reduceFontAction <- simpleActionNew "reducefont" Nothing   void $ onSimpleActionActivate reduceFontAction $ \_ ->-    modifyFontSizeForAllTerms (modFontSize (-1)) mvarTMState+    modifyFontSizeForAllTerms (modFontSize (-1)) mvarTMState tmWinId   actionMapAddAction app reduceFontAction   applicationSetAccelsForAction app "app.reducefont" ["<Ctrl>minus"] -  findAction <- simpleActionNew "find" Nothing-  void $ onSimpleActionActivate findAction $ \_ -> doFind mvarTMState-  actionMapAddAction app findAction-  applicationSetAccelsForAction app "app.find" ["<Shift><Ctrl>F"]--  findAboveAction <- simpleActionNew "findabove" Nothing-  void $ onSimpleActionActivate findAboveAction $ \_ -> findAbove mvarTMState-  actionMapAddAction app findAboveAction-  applicationSetAccelsForAction app "app.findabove" ["<Shift><Ctrl>P"]--  findBelowAction <- simpleActionNew "findbelow" Nothing-  void $ onSimpleActionActivate findBelowAction $ \_ -> findBelow mvarTMState-  actionMapAddAction app findBelowAction-  applicationSetAccelsForAction app "app.findbelow" ["<Shift><Ctrl>I"]-   aboutAction <- simpleActionNew "about" Nothing-  void $ onSimpleActionActivate aboutAction $ \_ -> showAboutDialog app+  void $ onSimpleActionActivate aboutAction $ \_ -> showAboutDialog win   actionMapAddAction app aboutAction -  menuBuilder <- builderNewFromString menuText $ fromIntegral (length menuText)-  menuModel <- objFromBuildUnsafe menuBuilder "menubar" MenuModel-  applicationSetMenubar app (Just menuModel)-  let showMenu = tmConfig ^. lensOptions . lensShowMenu-  applicationWindowSetShowMenubar win showMenu--  windowSetTitle win "Termonad"-   -- This event will happen if the user requests that the top-level Termonad   -- window be closed through their window manager. It will also happen   -- normally when the user tries to close Termonad through normal methods,@@ -531,349 +249,57 @@         ResponseTypeYes -> False         _ -> True +setupTermonad :: TMConfig -> Application -> ApplicationWindow -> Gtk.Builder -> IO ()+setupTermonad tmConfig app win builder = do+  setupScreenStyle+  box <- objFromBuildUnsafe builder "content_box" Box+  fontDesc <- createFontDescFromConfig tmConfig+  note <- notebookNew+  widgetSetCanFocus note False+  -- If this is not set to False, then there will be a one pixel white border+  -- shown around the notebook.+  notebookSetShowBorder note False+  boxPackStart box note True True 0++  (mvarTMState, tmWinId) <- newEmptyTMState tmConfig app win note fontDesc+  terminal <- createTerm handleKeyPress mvarTMState tmWinId++  setupAppCallbacks mvarTMState tmConfig app win note tmWinId+  setupWindowCallbacks mvarTMState app win note tmWinId++  menuBuilder <- builderNewFromString menuText $ fromIntegral (Text.length menuText)+  menuModel <- objFromBuildUnsafe menuBuilder "menubar" MenuModel+  applicationSetMenubar app (Just menuModel)+  let showMenu = tmConfig ^. lensOptions . lensShowMenu+  applicationWindowSetShowMenubar win showMenu++  windowSetTitle win "Termonad"+   widgetShowAll win   widgetGrabFocus $ terminal ^. lensTerm  appActivate :: TMConfig -> Application -> IO () appActivate tmConfig app = do+  let img = $(embedFile "img/termonad-lambda.png")+  iconPixbuf <- imgToPixbuf img+  windowSetDefaultIcon iconPixbuf   uiBuilder <--    builderNewFromString interfaceText $ fromIntegral (length interfaceText)+    builderNewFromString interfaceText $ fromIntegral (Text.length interfaceText)   builderSetApplication uiBuilder app   appWin <- objFromBuildUnsafe uiBuilder "appWin" ApplicationWindow   applicationAddWindow app appWin   setupTermonad tmConfig app appWin uiBuilder   windowPresent appWin -showAboutDialog :: Application -> IO ()-showAboutDialog app = do-  win <- applicationGetActiveWindow app-  aboutDialog <- aboutDialogNew-  windowSetTransientFor aboutDialog win-  void $ dialogRun aboutDialog-  widgetDestroy aboutDialog--showFindDialog :: Application -> IO (Maybe Text)-showFindDialog app = do-  win <- applicationGetActiveWindow app-  dialog <- dialogNew-  box <- dialogGetContentArea dialog-  grid <- gridNew--  searchForLabel <- labelNew (Just "Search for regex:")-  containerAdd grid searchForLabel-  widgetShow searchForLabel-  setWidgetMargin searchForLabel 10--  searchEntry <- entryNew-  gridAttachNextTo grid searchEntry (Just searchForLabel) PositionTypeRight 1 1-  widgetShow searchEntry-  setWidgetMargin searchEntry 10-  -- setWidgetMarginBottom searchEntry 20-  void $-    onEntryActivate searchEntry $-      dialogResponse dialog (fromIntegral (fromEnum ResponseTypeYes))--  void $-    dialogAddButton-      dialog-      "Close"-      (fromIntegral (fromEnum ResponseTypeNo))-  void $-    dialogAddButton-      dialog-      "Find"-      (fromIntegral (fromEnum ResponseTypeYes))--  containerAdd box grid-  widgetShow grid-  windowSetTransientFor dialog win-  res <- dialogRun dialog--  searchString <- entryGetText searchEntry-  let maybeSearchString =-        case toEnum (fromIntegral res) of-          ResponseTypeYes -> Just searchString-          _ -> Nothing--  widgetDestroy dialog--  pure maybeSearchString--doFind :: TMState -> IO ()-doFind mvarTMState = do-  tmState <- readMVar mvarTMState-  let app = tmStateApp tmState-  maybeSearchString <- showFindDialog app-  -- putStrLn $ "trying to find: " <> tshow maybeSearchString-  maybeTerminal <- getFocusedTermFromState mvarTMState-  case (maybeSearchString, maybeTerminal) of-    (Just searchString, Just terminal) -> do-      -- TODO: Figure out how to import the correct pcre flags.-      ---      -- If you don't pass the pcre2Multiline flag, VTE gives-      -- the following warning:-      ---      -- (termonad-linux-x86_64:18792): Vte-WARNING **:-      -- 21:56:31.193: (vtegtk.cc:2269):void-      -- vte_terminal_search_set_regex(VteTerminal*,-      -- VteRegex*, guint32): runtime check failed:-      -- (regex == nullptr ||-      -- _vte_regex_get_compile_flags(regex) & PCRE2_MULTILINE)-      ---      -- However, if you do add the pcre2Multiline flag,-      -- the terminalSearchSetRegex appears to just completely-      -- not work.-      let pcreFlags = 0-      let newRegex =-            regexNewForSearch-              searchString-              (fromIntegral $ length searchString)-              pcreFlags-      eitherRegex <--        catchRegexError-          (fmap Right newRegex)-          (\_ errMsg -> pure (Left errMsg))-      case eitherRegex of-        Left errMsg -> do-          let msg = "error when creating regex: " <> errMsg-          hPutStrLn stderr msg-        Right regex -> do-          terminalSearchSetRegex terminal (Just regex) pcreFlags-          terminalSearchSetWrapAround terminal True-          _matchFound <- terminalSearchFindPrevious terminal-          -- TODO: Setup an actual logging framework to show these-          -- kinds of log messages.  Also make a similar change in-          -- findAbove and findBelow.-          -- putStrLn $ "was match found: " <> tshow matchFound-          pure ()-    _ -> pure ()--findAbove :: TMState -> IO ()-findAbove mvarTMState = do-  maybeTerminal <- getFocusedTermFromState mvarTMState-  case maybeTerminal of-    Nothing -> pure ()-    Just terminal -> do-      _matchFound <- terminalSearchFindPrevious terminal-      -- putStrLn $ "was match found: " <> tshow matchFound-      pure ()--findBelow :: TMState -> IO ()-findBelow mvarTMState = do-  maybeTerminal <- getFocusedTermFromState mvarTMState-  case maybeTerminal of-    Nothing -> pure ()-    Just terminal -> do-      _matchFound <- terminalSearchFindNext terminal-      -- putStrLn $ "was match found: " <> tshow matchFound-      pure ()--setShowMenuBar :: Application -> Bool -> IO ()-setShowMenuBar app visible = do-  void $ runMaybeT $ do-    win <- MaybeT $ applicationGetActiveWindow app-    appWin <- MaybeT $ castTo ApplicationWindow win-    lift $ applicationWindowSetShowMenubar appWin visible---- | Fill a combo box with ids and labels------ The ids are stored in the combobox as 'Text', so their type should be an--- instance of the 'Show' type class.-comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()-comboBoxFill comboBox = mapM_ go-  where-    go :: (a, Text) -> IO ()-    go (value, textId) =-      comboBoxTextAppend comboBox (Just $ tshow value) textId---- | Set the current active item in a combobox given an input id.-comboBoxSetActive :: Show a => ComboBoxText -> a -> IO ()-comboBoxSetActive cb item = void $ comboBoxSetActiveId cb (Just $ tshow item)---- | Get the current active item in a combobox------ The list of values to be searched in the combobox must be given as a--- parameter. These values are converted to Text then compared to the current--- id.-comboBoxGetActive-  :: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)-comboBoxGetActive cb values = findEnumFromMaybeId <$> comboBoxGetActiveId cb-  where-    findEnumFromMaybeId :: Maybe Text -> Maybe a-    findEnumFromMaybeId maybeId = maybeId >>= findEnumFromId--    findEnumFromId :: Text -> Maybe a-    findEnumFromId label = find (\x -> tshow x == label) values--applyNewPreferences :: TMState -> IO ()-applyNewPreferences mvarTMState = do-  tmState <- readMVar mvarTMState-  let appWin = tmState ^. lensTMStateAppWin-      config = tmState ^. lensTMStateConfig-      notebook = tmState ^. lensTMStateNotebook . lensTMNotebook-      tabFocusList = tmState ^. lensTMStateNotebook . lensTMNotebookTabs-      showMenu = config  ^. lensOptions . lensShowMenu-  applicationWindowSetShowMenubar appWin showMenu-  setShowTabs config notebook-  -- Sets the remaining preferences to each tab-  foldMap (applyNewPreferencesToTab mvarTMState) tabFocusList--applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()-applyNewPreferencesToTab mvarTMState tab = do-  tmState <- readMVar mvarTMState-  let fontDesc = tmState ^. lensTMStateFontDesc-      term = tab ^. lensTMNotebookTabTerm . lensTerm-      scrolledWin = tab ^. lensTMNotebookTabTermContainer-      options = tmState ^. lensTMStateConfig . lensOptions-  terminalSetFont term (Just fontDesc)-  terminalSetCursorBlinkMode term (cursorBlinkMode options)-  terminalSetWordCharExceptions term (wordCharExceptions options)-  terminalSetScrollbackLines term (fromIntegral (scrollbackLen options))-  terminalSetBoldIsBright term (boldIsBright options)-  terminalSetEnableSixelIfExists term (enableSixel options)-  terminalSetAllowBold term (allowBold options)--  let vScrollbarPolicy = showScrollbarToPolicy (options ^. lensShowScrollbar)-  scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy---- | Show the preferences dialog.------ When the user clicks on the Ok button, it copies the new settings to TMState.--- Then apply them to the current terminals.-showPreferencesDialog :: TMState -> IO ()-showPreferencesDialog mvarTMState = do-  -- Get app out of mvar-  tmState <- readMVar mvarTMState-  let app = tmState ^. lensTMStateApp--  -- Create the preference dialog and get some widgets-  preferencesBuilder <--    builderNewFromString preferencesText $ fromIntegral (length preferencesText)-  preferencesDialog <--    objFromBuildUnsafe preferencesBuilder "preferences" Dialog-  confirmExitCheckButton <--    objFromBuildUnsafe preferencesBuilder "confirmExit" CheckButton-  showMenuCheckButton <--    objFromBuildUnsafe preferencesBuilder "showMenu" CheckButton-  boldIsBrightCheckButton <--    objFromBuildUnsafe preferencesBuilder "boldIsBright" CheckButton-  enableSixelCheckButton <--    objFromBuildUnsafe preferencesBuilder "enableSixel" CheckButton-  allowBoldCheckButton <--    objFromBuildUnsafe preferencesBuilder "allowBold" CheckButton-  wordCharExceptionsEntryBuffer <--    objFromBuildUnsafe preferencesBuilder "wordCharExceptions" Entry >>=-      getEntryBuffer-  fontButton <- objFromBuildUnsafe preferencesBuilder "font" FontButton-  showScrollbarComboBoxText <--    objFromBuildUnsafe preferencesBuilder "showScrollbar" ComboBoxText-  comboBoxFill-    showScrollbarComboBoxText-    [ (ShowScrollbarNever, "Never")-    , (ShowScrollbarAlways, "Always")-    , (ShowScrollbarIfNeeded, "If needed")-    ]-  showTabBarComboBoxText <--    objFromBuildUnsafe preferencesBuilder "showTabBar" ComboBoxText-  comboBoxFill-    showTabBarComboBoxText-    [ (ShowTabBarNever, "Never")-    , (ShowTabBarAlways, "Always")-    , (ShowTabBarIfNeeded, "If needed")-    ]-  cursorBlinkModeComboBoxText <--    objFromBuildUnsafe preferencesBuilder "cursorBlinkMode" ComboBoxText-  comboBoxFill-    cursorBlinkModeComboBoxText-    [ (CursorBlinkModeSystem, "System")-    , (CursorBlinkModeOn, "On")-    , (CursorBlinkModeOff, "Off")-    ]-  scrollbackLenSpinButton <--    objFromBuildUnsafe preferencesBuilder "scrollbackLen" SpinButton-  adjustmentNew 0 0 (fromIntegral (maxBound :: Int)) 1 10 0 >>=-    spinButtonSetAdjustment scrollbackLenSpinButton-  warningLabel <- objFromBuildUnsafe preferencesBuilder "warning" Label--  -- We show the warning label only if the user has launched termonad with a-  -- termonad.hs file-  executablePath <- getExecutablePath-  let hasTermonadHs = takeFileName executablePath == "termonad-linux-x86_64"-  widgetSetVisible warningLabel hasTermonadHs--  -- Make the dialog modal-  maybeWin <- applicationGetActiveWindow app-  windowSetTransientFor preferencesDialog maybeWin--  -- Init with current state-  fontChooserSetFontDesc fontButton (tmState ^. lensTMStateFontDesc)-  let options = tmState ^. lensTMStateConfig . lensOptions-  comboBoxSetActive showScrollbarComboBoxText $ showScrollbar options-  comboBoxSetActive showTabBarComboBoxText $ showTabBar options-  comboBoxSetActive cursorBlinkModeComboBoxText $ cursorBlinkMode options-  spinButtonSetValue scrollbackLenSpinButton (fromIntegral $ scrollbackLen options)-  toggleButtonSetActive confirmExitCheckButton $ confirmExit options-  toggleButtonSetActive showMenuCheckButton $ showMenu options-  toggleButtonSetActive boldIsBrightCheckButton $ boldIsBright options-  toggleButtonSetActive enableSixelCheckButton $ enableSixel options-  toggleButtonSetActive allowBoldCheckButton $ allowBold options-  entryBufferSetText wordCharExceptionsEntryBuffer (wordCharExceptions options) (-1)--  -- Run dialog then close-  res <- dialogRun preferencesDialog--  -- When closing the dialog get the new settings-  when (toEnum (fromIntegral res) == ResponseTypeAccept) $ do-    maybeFontDesc <- fontChooserGetFontDesc fontButton-    maybeFontConfig <--      join <$> mapM fontConfigFromFontDescription maybeFontDesc-    maybeShowScrollbar <--      comboBoxGetActive showScrollbarComboBoxText [ShowScrollbarNever ..]-    maybeShowTabBar <--      comboBoxGetActive showTabBarComboBoxText [ShowTabBarNever ..]-    maybeCursorBlinkMode <--      comboBoxGetActive cursorBlinkModeComboBoxText [CursorBlinkModeSystem ..]-    scrollbackLenVal <--      fromIntegral <$> spinButtonGetValueAsInt scrollbackLenSpinButton-    confirmExitVal <- toggleButtonGetActive confirmExitCheckButton-    showMenuVal <- toggleButtonGetActive showMenuCheckButton-    boldIsBrightVal <- toggleButtonGetActive boldIsBrightCheckButton-    enableSixelVal <- toggleButtonGetActive enableSixelCheckButton-    allowBoldVal <- toggleButtonGetActive allowBoldCheckButton-    wordCharExceptionsVal <- entryBufferGetText wordCharExceptionsEntryBuffer--    -- Apply the changes to mvarTMState-    modifyMVar_ mvarTMState $ pure-      . over lensTMStateFontDesc (`fromMaybe` maybeFontDesc)-      . over (lensTMStateConfig . lensOptions)-        ( set lensConfirmExit confirmExitVal-        . set lensShowMenu showMenuVal-        . set lensBoldIsBright boldIsBrightVal-        . set lensEnableSixel enableSixelVal-        . set lensAllowBold allowBoldVal-        . set lensWordCharExceptions wordCharExceptionsVal-        . over lensFontConfig (`fromMaybe` maybeFontConfig)-        . set lensScrollbackLen scrollbackLenVal-        . over lensShowScrollbar (`fromMaybe` maybeShowScrollbar)-        . over lensShowTabBar (`fromMaybe` maybeShowTabBar)-        . over lensCursorBlinkMode (`fromMaybe` maybeCursorBlinkMode)-        )--    -- Save the changes to the preferences files-    withMVar mvarTMState $ saveToPreferencesFile . view lensTMStateConfig--    -- Update the app with new settings-    applyNewPreferences mvarTMState--  widgetDestroy preferencesDialog- appStartup :: Application -> IO () appStartup _app = pure ()  -- | Run Termonad with the given 'TMConfig'. ----- Do not perform any of the recompilation operations that the 'defaultMain'+-- Do not perform any of the recompilation operations that the 'Termonad.Startup.defaultMain' -- function does.+--+-- This function __does not__ parse command line arguments. start :: TMConfig -> IO () start tmConfig = do   -- app <- appNew (Just "haskell.termonad") [ApplicationFlagsFlagsNone]@@ -882,81 +308,3 @@   void $ onApplicationStartup app (appStartup app)   void $ onApplicationActivate app (appActivate tmConfig app)   void $ applicationRun app Nothing---- | Run Termonad with the given 'TMConfig'.------ This function will check if there is a @~\/.config\/termonad\/termonad.hs@ file--- and a @~\/.cache\/termonad\/termonad-linux-x86_64@ binary.  Termonad will--- perform different actions based on whether or not these two files exist.------ Here are the four different possible actions based on the existence of these--- two files.------ - @~\/.config\/termonad\/termonad.hs@ exists, @~\/.cache\/termonad\/termonad-linux-x86_64@ exists------     The timestamps of these two files are checked.  If the---     @~\/.config\/termonad\/termonad.hs@ file has been modified after the---     @~\/.cache\/termonad\/termonad-linux-x86_64@ binary, then Termonad will use---     GHC to recompile the @~\/.config\/termonad\/termonad.hs@ file, producing a---     new binary at @~\/.cache\/termonad\/termonad-linux-x86_64@.  This new binary---     will be re-executed.  The 'TMConfig' passed to this 'defaultMain' will be---     effectively thrown away.------     If GHC fails to recompile the @~\/.config\/termonad\/termonad.hs@ file, then---     Termonad will just execute 'start' with the 'TMConfig' passed in.------     If the @~\/.cache\/termonad\/termonad-linux-x86_64@ binary has been modified---     after the @~\/.config\/termonad\/termonad.hs@ file, then Termonad will---     re-exec the @~\/.cache\/termonad\/termonad-linux-x86_64@ binary.  The---     'TMConfig' passed to this 'defaultMain' will be effectively thrown away.------ - @~\/.config\/termonad\/termonad.hs@ exists, @~\/.cache\/termonad\/termonad-linux-x86_64@ does not exist------     Termonad will use GHC to recompile the @~\/.config\/termonad\/termonad.hs@---     file, producing a new binary at @~\/.cache\/termonad\/termonad-linux-x86_64@.---     This new binary will be re-executed.  The 'TMConfig' passed to this---     'defaultMain' will be effectively thrown away.------     If GHC fails to recompile the @~\/.config\/termonad\/termonad.hs@ file, then---     Termonad will just execute 'start' with the 'TMConfig' passed in.------ - @~\/.config\/termonad\/termonad.hs@ does not exist, @~\/.cache\/termonad\/termonad-linux-x86_64@ exists------     Termonad will ignore the @~\/.cache\/termonad\/termonad-linux-x86_64@ binary---     and just run 'start' with the 'TMConfig' passed to this function.------ - @~\/.config\/termonad\/termonad.hs@ does not exist, @~\/.cache\/termonad\/termonad-linux-x86_64@ does not exist------     Termonad will run 'start' with the 'TMConfig' passed to this function.------ Other notes:------ 1. That the locations of @~\/.config\/termonad\/termonad.hs@ and---    @~\/.cache\/termonad\/termonad-linux-x86_64@ may differ depending on your---    system.------ 2. In your own @~\/.config\/termonad\/termonad.hs@ file, you can use either---    'defaultMain' or 'start'.  As long as you always execute the system-wide---    @termonad@ binary (instead of the binary produced as---    @~\/.cache\/termonad\/termonad-linux-x86_64@), the effect should be the same.-defaultMain :: TMConfig -> IO ()-defaultMain tmConfig = do-  let params =-        defaultParams-          { projectName = "termonad"-          , showError = \(cfg, oldErrs) newErr -> (cfg, oldErrs <> "\n" <> newErr)-          , realMain = \(cfg, errs) -> putStrLn (pack errs) *> start cfg-          }-  eitherRes <- tryIOError $ wrapMain params (tmConfig, "")-  case eitherRes of-    Left ioErr-      | ioeGetErrorType ioErr == doesNotExistErrorType && ioeGetFileName ioErr == Just "ghc" -> do-          putStrLn $-            "Could not find ghc on your PATH.  Ignoring your termonad.hs " <>-            "configuration file and running termonad with default settings."-          start tmConfig-      | otherwise -> do-          putStrLn "IO error occurred when trying to run termonad:"-          print ioErr-          putStrLn "Don't know how to recover.  Exiting."-    Right _ -> pure ()

@@ -0,0 +1,434 @@+-- | Module    : Termonad.Cli+-- Description : Termonad CLI argument parsing module.+-- Copyright   : (c) Dennis Gosnell, 2023+-- License     : BSD3+-- Stability   : experimental+-- Portability : POSIX+--+-- This module exposes Termonad's CLI argument parsing functionality.+--+-- The main function for parsing CLI arguments is 'parseCliArgs'.  The function+-- that knows how to combine CLI arguments with normal 'ConfigOptions' is+-- 'applyCliArgs'.++module Termonad.Cli where++import Termonad.Prelude++import Control.Applicative ((<|>), (<**>))+import Data.Text (pack)+import GI.Vte (CursorBlinkMode)+import Options.Applicative (fullDesc, info, helper, progDesc, ParserInfo, execParser, Parser, Mod, OptionFields, option, str, value, short, long, metavar, help, ReadM, maybeReader, auto, flag')+import Termonad.Types (ConfigOptions (..), Option (Set, Unset), ShowScrollbar, FontSize (..), ShowTabBar, showScrollbarFromString, showTabBarFromString, cursorBlinkModeFromString, FontConfig (..))+++-- | A data type that contains arguments from the command line.+data CliArgs = CliArgs+  { cliConfigOptions :: CliConfigOptions+  , extraCliArgs :: ExtraCliArgs+  } deriving (Eq, Show)++-- | The default 'CliArgs'.  This corresponds to the value 'CliArgs' will+-- become when no CLI arguments have been passed.+--+-- >>> :{+--   let defCliArgs =+--         CliArgs+--           { cliConfigOptions = defaultCliConfigOptions+--           , extraCliArgs = defaultExtraCliArgs+--           }+--   in defaultCliArgs == defCliArgs+-- :}+-- True+defaultCliArgs :: CliArgs+defaultCliArgs =+  CliArgs+    { cliConfigOptions = defaultCliConfigOptions+    , extraCliArgs = defaultExtraCliArgs+    }++-- | CLI arguments that correspond to fields in 'ConfigOptions'.+--+-- See 'ConfigOptions' for what each of these options mean.+data CliConfigOptions = CliConfigOptions+  { cliConfFontFamily :: !(Option Text)+  , cliConfFontSize :: !(Option FontSize)+  , cliConfShowScrollbar :: !(Option ShowScrollbar)+  , cliConfScrollbackLen :: !(Option Integer)+  , cliConfConfirmExit :: !(Option Bool)+  , cliConfWordCharExceptions :: !(Option Text)+  , cliConfShowMenu :: !(Option Bool)+  , cliConfShowTabBar :: !(Option ShowTabBar)+  , cliConfCursorBlinkMode :: !(Option CursorBlinkMode)+  , cliConfBoldIsBright :: !(Option Bool)+  , cliConfEnableSixel :: !(Option Bool)+  , cliConfAllowBold :: !(Option Bool)+  } deriving (Eq, Show)++-- | The default 'CliConfigOptions'.  All 'Option's are 'Unset', which means+-- they won't override options from 'ConfigOptions' in 'applyCliArgs'.+--+-- >>> :{+--   let defCliConfOpt =+--         CliConfigOptions+--           { cliConfFontFamily = Unset+--           , cliConfFontSize = Unset+--           , cliConfShowScrollbar = Unset+--           , cliConfScrollbackLen = Unset+--           , cliConfConfirmExit = Unset+--           , cliConfWordCharExceptions = Unset+--           , cliConfShowMenu = Unset+--           , cliConfShowTabBar = Unset+--           , cliConfCursorBlinkMode = Unset+--           , cliConfBoldIsBright = Unset+--           , cliConfEnableSixel = Unset+--           , cliConfAllowBold = Unset+--           }+--   in defaultCliConfigOptions == defCliConfOpt+-- :}+-- True+defaultCliConfigOptions :: CliConfigOptions+defaultCliConfigOptions =+  CliConfigOptions+    { cliConfFontFamily = Unset+    , cliConfFontSize = Unset+    , cliConfShowScrollbar = Unset+    , cliConfScrollbackLen = Unset+    , cliConfConfirmExit = Unset+    , cliConfWordCharExceptions = Unset+    , cliConfShowMenu = Unset+    , cliConfShowTabBar = Unset+    , cliConfCursorBlinkMode = Unset+    , cliConfBoldIsBright = Unset+    , cliConfEnableSixel = Unset+    , cliConfAllowBold = Unset+    }++-- | Extra CLI arguments for values that don't make sense in 'ConfigOptions'.+data ExtraCliArgs = ExtraCliArgs+  deriving (Eq, Show)++-- | The default 'ExtraCliArgs'.+--+-- >>> :{+--   let defExtraCliArgs =+--         ExtraCliArgs+--   in defaultExtraCliArgs == defExtraCliArgs+-- :}+-- True+defaultExtraCliArgs :: ExtraCliArgs+defaultExtraCliArgs = ExtraCliArgs++-- | Similar to 'Options.Applicative.strOption', but specifically work on a+-- value that is an 'Option'.+strOption' :: IsString s => Mod OptionFields (Option s) -> Parser (Option s)+strOption' mods = option (fmap Set str) (value Unset <> mods)++-- | Similar to 'Options.Applicative.option', but specifically work on a+-- value that is an 'Option'.+option' :: ReadM a -> Mod OptionFields (Option a) -> Parser (Option a)+option' readM mods = option (fmap Set readM) (value Unset <> mods)++-- | Similar to 'Options.Applicative.maybeReader', but work on 'Text' instead+-- of 'String'.+maybeTextReader :: (Text -> Maybe a) -> ReadM a+maybeTextReader f = maybeReader (f . pack)++-- | Helper for making a 'flag' CLI argument that optionally takes a @no-@ prefix.+--+-- Example:+--+-- > 'optionFlag' 'True' 'False' 'f' 'n' "foo" "Does foo" "Does not do foo" :: Parser (Option Bool)+--+-- This creates a 'Parser' that accepts both a @--foo@ and a @--no-foo@ flag.+-- Passing @--foo@ returns @'Set' 'True'@, while passing @--no-foo@ returns+-- @'Set' 'False'@.  Passing neither @--foo@ nor @--no-foo@ returns 'Unset'.+--+-- TODO: This doesn't quite work.  If the user passes both @--foo@ and+-- @--no-foo@ flags, this should ideally take the value of the last flag+-- passed.  However, it appears that if you pass both flags, the second+-- flag is just not recognized and optparse-applicative raises an error.+optionFlag+  :: a -- ^ Value when specified /without/ @no-@ prefix.+  -> a -- ^ Value when specified /with/ @no-@ prefix.+  -> Char -- ^ Short flag for /without/ @no-@ prefix.+  -> Char -- ^ Short flag for /with/ @no-@ prefix.+  -> String -- ^ Long flag.+  -> String -- ^ Help text for /without/ @no-@ prefix option.+  -> String -- ^ Help text for /with/ @no-@ prefix option.+  -> Parser (Option a)+optionFlag valNormal valNo shortNormal shortNo longFlag helpNormal helpNo =+  flagNormal <|> flagNo <|> pure Unset+  where+    flagNormal =+      flag' (Set valNormal) (short shortNormal <> long longFlag <> help helpNormal)+    flagNo =+      flag' (Set valNo) (short shortNo <> long ("no-" <> longFlag) <> help helpNo)++cliConfigOptionsParser :: Parser CliConfigOptions+cliConfigOptionsParser =+  CliConfigOptions+    <$> fontFamilyParser+    <*> fontSizeParser+    <*> showScrollbarParser+    <*> scrollbackLenParser+    <*> confirmExitParser+    <*> wordCharExceptionsParser+    <*> showMenuParser+    <*> showTabBarParser+    <*> cursorBlinkModeParser+    <*> boldIsBrightParser+    <*> enableSixelParser+    <*> allowBoldParser++fontFamilyParser :: Parser (Option Text)+fontFamilyParser =+  strOption'+    ( short 'f' <>+      long "font-family" <>+      metavar "FONT_FAMILY" <>+      help+        "Font family to use. Defaults to \"Monospace\". Examples: \+        \\"DejaVu Sans Mono\", \"Source Code Pro\""+    )++fontSizeParser :: Parser (Option FontSize)+fontSizeParser = f <$> pointsParser <*> unitsParser+  where+    f :: Option Int -> Option Double -> Option FontSize+    f optionPoints optionUnits =+      case (fmap FontSizePoints optionPoints, fmap FontSizeUnits optionUnits) of+        (Unset, units) -> units+        (points, _) -> points++    pointsParser :: Parser (Option Int)+    pointsParser =+      option'+        auto+        ( short 'p' <>+          long "font-size-points" <>+          metavar "POINTS" <>+          help+            "Font size in POINTS. Defaults to \"12\" if not specified. \+            \If you specify both --font-size-points and --font-size-units, \+            \--font-size-points will take priority.  --font-size-points \+            \should be similar to font sizes you may be \+            \familiar with from other applications."+        )++    unitsParser :: Parser (Option Double)+    unitsParser =+      option'+        auto+        ( short 'u' <>+          long "font-size-units" <>+          metavar "UNITS" <>+          help+            "Font size in device units/pixels. Example: \"20.5\", \+            \\"30\".  If not specified, the default from \+            \--font-size-points is used."+        )++showScrollbarParser :: Parser (Option ShowScrollbar)+showScrollbarParser =+  option'+    (maybeTextReader showScrollbarFromString)+    ( short 'l' <>+      long "show-scrollbar" <>+      metavar "SHOW_SCROLLBAR" <>+      help+        "Whether or not to show a scrollbar in the terminal. \+        \Defaults to \"if-needed\".  Possible values = \"never\": \+        \never show the scrollbar, \"always\": always show the \+        \scrollbar, \"if-needed\": only show the scrollbar if \+        \enough text on the screen"+    )++scrollbackLenParser :: Parser (Option Integer)+scrollbackLenParser =+  option'+    auto+    ( short 'b' <>+      long "scrollback-length" <>+      metavar "SCROLLBACK_LENGTH" <>+      help+        "Number of lines to keep in the scrollback buffer in the \+        \terminal.  Defaults to 10000 lines.  Examples: \"200\", \+        \\"3000\""+    )++confirmExitParser :: Parser (Option Bool)+confirmExitParser =+  optionFlag+    True+    False+    'x'+    'C'+    "confirm-exit"+    "Ask for confirmation when closing terminals or Termonad itself. \+    \Defaults to asking for confirmation if not specified."+    "Do not ask for confirmation when closing terminals or Termonad \+    \itself. Defaults to asking for confirmation if not specified."++wordCharExceptionsParser :: Parser (Option Text)+wordCharExceptionsParser =+  strOption'+    ( short 'w' <>+      long "word-char-exceptions" <>+      metavar "EXCEPTIONS" <>+      help+        "The characters in this list will be counted as part of a word \+        \when double-clicking to select text in the terminal. Defaults \+        \to \"-#%&+,./=?@\\_~:\""+    )++showMenuParser :: Parser (Option Bool)+showMenuParser =+  optionFlag+    True+    False+    'm'+    'u'+    "show-menu"+    "Show the menu bar.  Defaults to showing the menu bar when not \+    \specified."+    "Do not show the menu bar.  Defaults to showing the menu bar when \+    \not specified."++showTabBarParser :: Parser (Option ShowTabBar)+showTabBarParser =+  option'+    (maybeTextReader showTabBarFromString)+    ( short 'l' <>+      long "show-tab-bar" <>+      metavar "SHOW_TAB_BAR" <>+      help+        "Whether or not to show the tab bar in the terminal. \+        \Defaults to \"if-needed\".  Possible values = \"never\": \+        \never show the tab bar, \"always\": always show the \+        \tab bar, \"if-needed\": only show the tab bar if \+        \multiple tabs are open."+    )++cursorBlinkModeParser :: Parser (Option CursorBlinkMode)+cursorBlinkModeParser =+  option'+    (maybeTextReader cursorBlinkModeFromString)+    ( short 'n' <>+      long "cursor-blink" <>+      metavar "BLINK_MODE" <>+      help+        "How to handle cursor blink.  Defaults to \"on\". Possible \+        \values = \"system\": follow system settings, \"on\": cursor \+        \blinks, \"off\": no cursor blink."+    )++boldIsBrightParser :: Parser (Option Bool)+boldIsBrightParser =+  optionFlag+    True+    False+    'd'+    'r'+    "bold-is-bright"+    "Force bold text to use bright colors.  Defaults to not forcing \+    \bold text to use bright colors."+    "Do not force bold text to use bright colors.  Defaults to not forcing \+    \bold text to use bright colors."++enableSixelParser :: Parser (Option Bool)+enableSixelParser =+  optionFlag+    True+    False+    's'+    'i'+    "sixel"+    "Enable SIXEL support.  Note that you need to build Termonad with \+    \a VTE with SIXEL support for this to work.  Defaults to not \+    \enabling SIXEL."+    "Disable SIXEL support.  Defaults to disabling SIXEL support."++allowBoldParser :: Parser (Option Bool)+allowBoldParser =+  optionFlag+    True+    False+    'a'+    'o'+    "allow-bold"+    "Allow Termonad to show bold text.  Defaults to enabled."+    "Disable Termonad from showing text as bold.  Defaults to \+    \allow showing text as bold."++extraCliArgsParser :: Parser ExtraCliArgs+extraCliArgsParser = pure ExtraCliArgs++cliArgsParser :: Parser CliArgs+cliArgsParser =+  CliArgs <$> cliConfigOptionsParser <*> extraCliArgsParser++cliArgsParserInfo :: ParserInfo CliArgs+cliArgsParserInfo =+  info+    (cliArgsParser <**> helper)+    ( fullDesc <>+      progDesc "A VTE-based terminal emulator configurable in Haskell"+    )++-- | Parse and return CliArguments.+parseCliArgs :: IO CliArgs+parseCliArgs = execParser cliArgsParserInfo++-- | Overwrite the arguments in 'ConfigOptions' that have been 'Set' in+-- 'CliArgs'.+--+-- >>> import Termonad.Types (defaultConfigOptions)+-- >>> let cliConfOpts = defaultCliConfigOptions { cliConfScrollbackLen = Set 50 }+-- >>> let cliArgs = defaultCliArgs { cliConfigOptions = cliConfOpts }+-- >>> let overwrittenConfOpts = defaultConfigOptions { scrollbackLen = 50 }+-- >>> applyCliArgs cliArgs defaultConfigOptions == overwrittenConfOpts+-- True+applyCliArgs :: CliArgs -> ConfigOptions -> ConfigOptions+applyCliArgs cliArgs confOpts =+  let oldFontConf = fontConfig confOpts+      newFontConfig =+        oldFontConf+          { fontFamily =+              fromOption+                (fontFamily oldFontConf)+                (cliConfFontFamily cliConfOpts)+          , fontSize =+              fromOption+                (fontSize oldFontConf)+                (cliConfFontSize cliConfOpts)+          }+  in+  confOpts+    { fontConfig = newFontConfig+    , showScrollbar = fromOpt showScrollbar cliConfShowScrollbar+    , scrollbackLen = fromOpt scrollbackLen cliConfScrollbackLen+    , confirmExit = fromOpt confirmExit cliConfConfirmExit+    , wordCharExceptions = fromOpt wordCharExceptions cliConfWordCharExceptions+    , showMenu = fromOpt showMenu cliConfShowMenu+    , showTabBar = fromOpt showTabBar cliConfShowTabBar+    , cursorBlinkMode = fromOpt cursorBlinkMode cliConfCursorBlinkMode+    , boldIsBright = fromOpt boldIsBright cliConfBoldIsBright+    , enableSixel = fromOpt enableSixel cliConfEnableSixel+    , allowBold = fromOpt allowBold cliConfAllowBold+    }+  where+    fromOpt+      :: forall a. (ConfigOptions -> a) -> (CliConfigOptions -> Option a) -> a+    fromOpt getConfVal getCliVal =+      fromOption+        (getConfVal confOpts)+        (getCliVal cliConfOpts)++    fromOption :: forall b. b -> Option b -> b+    fromOption defVal = \case+      Set a -> a+      Unset -> defVal++    cliConfOpts :: CliConfigOptions+    cliConfOpts = cliConfigOptions cliArgs

@@ -21,10 +21,12 @@ -- --  main :: IO () --  main = 'start' $ 'defaultTMConfig'---    { 'showScrollbar' = 'ShowScrollbarNever'---    , 'confirmExit' = False---    , 'showMenu' = False---    , 'cursorBlinkMode' = 'CursorBlinkModeOff'+--    { 'options' = 'defaultConfigOptions'+--      { 'showScrollbar' = 'ShowScrollbarNever'+--      , 'confirmExit' = False+--      , 'showMenu' = False+--      , 'cursorBlinkMode' = 'CursorBlinkModeOff'+--      } --    } -- @ --@@ -59,5 +61,5 @@  import GI.Vte (CursorBlinkMode(..)) -import Termonad.PreferencesFile (tmConfigFromPreferencesFile)+import Termonad.Preferences (tmConfigFromPreferencesFile) import Termonad.Types

@@ -87,7 +87,7 @@     -- $setup   ) where -import Termonad.Prelude hiding ((\\), index)+import Termonad.Prelude  import Control.Lens ((%~), makeLensesFor) import Data.Colour@@ -124,9 +124,6 @@   , terminalSetColorHighlight   , terminalSetColorHighlightForeground   )-import Text.Printf (printf)-import Text.Show (showString)- import Termonad.Lenses (lensCreateTermHook, lensHooks) import Termonad.Types   ( Option(Unset)@@ -134,6 +131,7 @@   , TMState   , whenSet   )+import Text.Printf (printf)  -- $setup -- >>> import Data.Colour.Names (green, red)@@ -552,7 +550,7 @@     coef x = fromIntegral x / 5 -- | A matrix of a 6 x 6 x 6 color cube. Default value for 'ColourCubePalette'. ----- >>> putStrLn $ pack $ showColourCube defaultColourCube+-- >>> putStrLn $ showColourCube defaultColourCube -- [ [ #000000ff, #00005fff, #000087ff, #0000afff, #0000d7ff, #0000ffff --   , #005f00ff, #005f5fff, #005f87ff, #005fafff, #005fd7ff, #005fffff --   , #008700ff, #00875fff, #008787ff, #0087afff, #0087d7ff, #0087ffff@@ -660,6 +658,12 @@      showCol :: AlphaColour Double -> String -> String     showCol col str = sRGB32show col <> str++    -- A version of head that gives a better error message.+    headEx :: forall b. [b] -> b+    headEx = \case+      [] -> error "showColourCube: error in headEx, passed empty list, this is likely a logic error"+      (h : _) -> h  -- | A List of a grey scale.  Default value for 'FullPalette'. --

@@ -17,14 +17,16 @@  import Termonad.Prelude -import Control.Monad.Fail (MonadFail, fail) import Data.GI.Base (ManagedPtr, withManagedPtr)+import Data.Text (unpack) import GHC.Stack (HasCallStack) import GI.Gdk   ( GObject   , castTo   )-import GI.Gio (ApplicationFlags)+import GI.GdkPixbuf (Pixbuf, pixbufNewFromStream)+import GI.Gio (ApplicationFlags, Cancellable)+import GI.Gio.Objects.MemoryInputStream (memoryInputStreamNewFromData) import GI.Gtk (Application, IsWidget, Widget(Widget), applicationNew, builderGetObject, toWidget) import qualified GI.Gtk as Gtk import GI.Vte@@ -33,22 +35,18 @@   , terminalSetEnableSixel #endif   )-+import System.Exit (die)  objFromBuildUnsafe ::      GObject o => Gtk.Builder -> Text -> (ManagedPtr o -> o) -> IO o objFromBuildUnsafe builder name constructor = do   maybePlainObj <- builderGetObject builder name   case maybePlainObj of-    Nothing -> error $ "Couldn't get " <> unpack name <> " from builder!"+    Nothing -> error $ unpack $ "Couldn't get " <> name <> " from builder!"     Just plainObj -> do       maybeNewObj <- castTo constructor plainObj       case maybeNewObj of-        Nothing ->-          error $-            "Got " <>-            unpack name <>-            " from builder, but couldn't convert to object!"+        Nothing -> error $ unpack $ "Got " <> name <> " from builder, but couldn't convert to object!"         Just obj -> pure obj  -- | Unsafely creates a new 'Application'.  This calls 'fail' if it cannot@@ -93,3 +91,15 @@   terminalSetEnableSixel t b #endif   pure ()++-- | Load an image in a 'ByteString' into a 'Pixbuf'.+--+-- Supports all image types that 'pixbufNewFromStream' supports.+imgToPixbuf :: ByteString -> IO Pixbuf+imgToPixbuf imgByteString = do+  inputStream <- memoryInputStreamNewFromData imgByteString Nothing+  maybePixbuf <- pixbufNewFromStream inputStream (Nothing :: Maybe Cancellable)+  case maybePixbuf of+    Nothing ->+      die "imgToPixbuf: Unexpected error when trying to convert an image to a Pixbuf"+    Just pixbuf -> pure pixbuf

@@ -0,0 +1,25 @@+-- | Module    : Termonad.IdMap+-- Description : A Map that keeps track of the ID of values+-- Copyright   : (c) Dennis Gosnell, 2023+-- License     : BSD3+-- Stability   : experimental+-- Portability : POSIX+--+-- An 'IdMap' is a combination between an 'IntMap' and a 'Set'.+--+-- An 'IdMap' allows adding an arbitrary number of things to be tracked.  It+-- returns an 'IdMapKey' whenever a new item is added to the set.  This+-- 'IdMapKey' can then be used to lookup items already in the set.++module Termonad.IdMap+  ( IdMapKey+  , IdMap+  , emptyIdMap+  , singletonIdMap+  , insertIdMap+  , lookupIdMap+  , keysIdMap+  , deleteIdMap+  ) where++import Termonad.IdMap.Internal

@@ -0,0 +1,165 @@+-- | Module    : Termonad.IdMap+-- Description : A Map that keeps track of the ID of values+-- Copyright   : (c) Dennis Gosnell, 2023+-- License     : BSD3+-- Stability   : experimental+-- Portability : POSIX++module Termonad.IdMap.Internal where++import Termonad.Prelude++import Control.Lens (FoldableWithIndex, ifoldMap, Index, IxValue, Traversal', Ixed (ix))+import qualified Data.Foldable as Foldable+import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as IntMap++newtype IdMapKey = IdMapKey { unIdMapKey :: Int }+  deriving stock (Eq, Show)++data IdMap a = IdMap+  { idMap :: !(IntMap a)+  , nextId :: !Int+  }+  deriving stock Show++-- | 'IdMap's are equal if they contain the same elements at the same keys.+--+-- >>> let (helloKey, idmapA) = insertIdMap "hello" emptyIdMap+-- >>> let (_, idmapB) = singletonIdMap "hello"+-- >>> idmapA == idmapB+-- True+--+-- Note that if you delete and reinsert a value, it will get a different key,+-- so will no longer be equal.+--+-- >>> let (_, idmapA') = insertIdMap "hello" $ deleteIdMap helloKey idmapA+-- >>> idmapA' == idmapB+-- False+--+-- However, 'IdMap's don't check the 'nextId' field when determining equality.+--+-- >>> let (byeKey, idmapA'') = insertIdMap "bye" idmapA+-- >>> let idmapA''' = deleteIdMap byeKey idmapA''+-- >>> idmapA''' == idmapB+-- True+instance Eq a => Eq (IdMap a) where+  (IdMap idMapA _) == (IdMap idMapB _) = idMapA == idMapB++instance Functor IdMap where+  fmap f IdMap{idMap, nextId} = IdMap { idMap = fmap f idMap, nextId }++instance Foldable IdMap where+  foldMap f m = Foldable.foldMap f $ idMap m++instance FoldableWithIndex Int IdMap where+  ifoldMap f m = ifoldMap f $ idMap m++instance Traversable IdMap where+  traverse f IdMap{idMap, nextId} =+    fmap (\m -> IdMap { idMap = m, nextId }) (traverse f idMap)++type instance Index (IdMap a) = IdMapKey+type instance IxValue (IdMap a) = a++instance Ixed (IdMap a) where+  ix :: IdMapKey -> Traversal' (IdMap a) a+  ix (IdMapKey i) f IdMap{idMap, nextId} =+    case IntMap.lookup i idMap of+      Just v -> fmap update (f v) -- f v <&> \v' -> IntMap.insert k v' m+      Nothing -> pure IdMap{idMap, nextId}+    where+      update :: a -> IdMap a+      update v' =+        IdMap+          { idMap = IntMap.adjust (const v') i idMap+          , nextId+          }++initialId :: Int+initialId = 0++-- | Get the next available ID.+--+-- >>> succId 3+-- 4+succId :: Int -> Int+succId i = i + 1++-- | An initial 'IdMap' with no values.+--+-- >>> emptyIdMap+-- IdMap {idMap = fromList [], nextId = 0}+emptyIdMap :: IdMap a+emptyIdMap = IdMap { idMap = mempty, nextId = 0 }++-- | Insert a value into an 'IdMap'.  Returns the key for the newly inserted+-- item.+--+-- >>> let (key, idmap) = insertIdMap "hello" emptyIdMap+-- >>> (key, idmap)+-- (IdMapKey {unIdMapKey = 0},IdMap {idMap = fromList [(0,"hello")], nextId = 1})+--+-- >>> insertIdMap "zoom" idmap+-- (IdMapKey {unIdMapKey = 1},IdMap {idMap = fromList [(0,"hello"),(1,"zoom")], nextId = 2})+insertIdMap :: a -> IdMap a -> (IdMapKey, IdMap a)+insertIdMap a IdMap {idMap, nextId} =+  let newMap = IntMap.insert nextId a idMap+      newNextId = nextId + 1+  in (IdMapKey nextId, IdMap { idMap = newMap, nextId = newNextId })++-- | Create an 'IdMap' with a single value.+--+-- >>> singletonIdMap "hello"+-- (IdMapKey {unIdMapKey = 0},IdMap {idMap = fromList [(0,"hello")], nextId = 1})+--+-- prop> \a -> insertIdMap a emptyIdMap == singletonIdMap a+singletonIdMap :: a -> (IdMapKey, IdMap a)+singletonIdMap a = insertIdMap a emptyIdMap++-- | Lookup the given key in an 'IdMap'.+--+-- >>> let (key, idmap) = insertIdMap "hello" emptyIdMap+-- >>> lookupIdMap key idmap+-- Just "hello"+--+-- Trying to lookup keys that don't exist returns 'Nothing':+--+-- >>> let idmap' = deleteIdMap key idmap+-- >>> lookupIdMap key idmap'+-- Nothing+lookupIdMap :: IdMapKey -> IdMap a -> Maybe a+lookupIdMap (IdMapKey k) IdMap {idMap} = IntMap.lookup k idMap++-- | List all keys in an 'IdMap'.+--+-- >>> let (_, idmap) = singletonIdMap "hello"+-- >>> let (_, idmap') = insertIdMap "bye" idmap+-- >>> keysIdMap idmap'+-- [IdMapKey {unIdMapKey = 0},IdMapKey {unIdMapKey = 1}]+--+-- Returns the empty list when passed an empty 'IdMap':+--+-- >>> keysIdMap emptyIdMap+-- []+keysIdMap :: IdMap a -> [IdMapKey]+keysIdMap IdMap {idMap} = fmap IdMapKey $ IntMap.keys idMap++-- | Delete a key and its value from the map. When the key is not a member of+-- the map, the original map is returned.+--+-- >>> let (key, idmap) = singletonIdMap "hello"+-- >>> let (_, idmap') = insertIdMap "bye" idmap+-- >>> deleteIdMap key idmap'+-- IdMap {idMap = fromList [(1,"bye")], nextId = 2}+--+-- Deleting a key that does not exist just returns the old map:+--+-- >>> deleteIdMap key idmap'+-- IdMap {idMap = fromList [(1,"bye")], nextId = 2}+deleteIdMap :: IdMapKey -> IdMap a -> IdMap a+deleteIdMap (IdMapKey k) IdMap {idMap, nextId} =+  IdMap+    { idMap = IntMap.delete k idMap+    , nextId+    }

@@ -4,6 +4,10 @@ import Termonad.Prelude  import Control.Lens (imap)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Set (Set)+import qualified Data.Set as Set import GI.Gdk   ( EventKey   , pattern KEY_0@@ -27,7 +31,7 @@   )  import Termonad.Term (altNumSwitchTerm)-import Termonad.Types (TMState)+import Termonad.Types (TMState, TMWindowId)   showKeys :: EventKey -> IO Bool@@ -41,28 +45,29 @@   keycode <- getEventKeyHardwareKeycode eventKey    putStrLn "key press event:"-  putStrLn $ "  type = " <> tshow eventType-  putStrLn $ "  str = " <> tshow maybeString-  putStrLn $ "  mods = " <> tshow modifiers-  putStrLn $ "  isMod = " <> tshow isMod-  putStrLn $ "  len = " <> tshow len-  putStrLn $ "  keyval = " <> tshow keyval-  putStrLn $ "  keycode = " <> tshow keycode+  putStrLn $ "  type = " <> show eventType+  putStrLn $ "  str = " <> show maybeString+  putStrLn $ "  mods = " <> show modifiers+  putStrLn $ "  isMod = " <> show isMod+  putStrLn $ "  len = " <> show len+  putStrLn $ "  keyval = " <> show keyval+  putStrLn $ "  keycode = " <> show keycode   putStrLn ""    pure True  data Key = Key-  { keyVal :: Word32-  , keyMods :: Set ModifierType+  { keyVal :: !Word32+  , keyMods :: !(Set ModifierType)   } deriving (Eq, Ord, Show)  toKey :: Word32 -> Set ModifierType -> Key toKey = Key -keyMap :: Map Key (TMState -> IO Bool)+keyMap :: Map Key (TMState -> TMWindowId -> IO Bool) keyMap =-  let numKeys =+  let numKeys :: [Word32]+      numKeys =         [ KEY_1         , KEY_2         , KEY_3@@ -74,6 +79,7 @@         , KEY_9         , KEY_0         ]+      altNumKeys :: [(Key, TMState -> TMWindowId -> IO Bool)]       altNumKeys =         imap           (\i k ->@@ -81,14 +87,15 @@           )           numKeys   in-  mapFromList altNumKeys+  Map.fromList altNumKeys -stopProp :: (TMState -> IO a) -> TMState -> IO Bool-stopProp callback terState = callback terState $> True+stopProp :: (TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool+stopProp callback terState tmWinId = callback terState tmWinId $> True  removeStrangeModifiers :: Key -> Key removeStrangeModifiers Key{keyVal, keyMods} =-  let reservedModifiers =+  let reservedModifiers :: Set ModifierType+      reservedModifiers =         [ ModifierTypeModifierReserved13Mask         , ModifierTypeModifierReserved14Mask         , ModifierTypeModifierReserved15Mask@@ -104,17 +111,17 @@         , ModifierTypeModifierReserved25Mask         , ModifierTypeModifierReserved29Mask         ]-  in Key keyVal (difference keyMods reservedModifiers)+  in Key keyVal (Set.difference keyMods reservedModifiers)  -handleKeyPress :: TMState -> EventKey -> IO Bool-handleKeyPress terState eventKey = do+handleKeyPress :: TMState -> TMWindowId -> EventKey -> IO Bool+handleKeyPress terState tmWindowId eventKey = do   -- void $ showKeys eventKey   keyval <- getEventKeyKeyval eventKey   modifiers <- getEventKeyState eventKey-  let oldKey = toKey keyval (setFromList modifiers)+  let oldKey = toKey keyval (Set.fromList modifiers)       newKey = removeStrangeModifiers oldKey-      maybeAction = lookup newKey keyMap+      maybeAction = Map.lookup newKey keyMap   case maybeAction of-    Just action -> action terState+    Just action -> action terState tmWindowId     Nothing -> pure False

@@ -29,12 +29,17 @@  )  $(makeLensesFor+    [ ("tmWindowAppWin", "lensTMWindowAppWin")+    , ("tmWindowNotebook", "lensTMWindowNotebook")+    ]+    ''TMWindow+ )++$(makeLensesFor     [ ("tmStateApp", "lensTMStateApp")-    , ("tmStateAppWin", "lensTMStateAppWin")-    , ("tmStateNotebook", "lensTMStateNotebook")     , ("tmStateFontDesc", "lensTMStateFontDesc")     , ("tmStateConfig", "lensTMStateConfig")-    , ("tmStateUserReqExit", "lensTMStateUserReqExit")+    , ("tmStateWindows", "lensTMStateWindows")     ]     ''TMState'  )

@@ -0,0 +1,315 @@+{-# LANGUAGE CPP #-}++-- | Description : Controls the Preferences dialog and setting app preferences+-- Copyright     : (c) Dennis Gosnell, 2023+-- License       : BSD3+-- Stability     : experimental+-- Portability   : POSIX+--+-- This module controls the Preferences dialog, which lets you set Termonad+-- preferences at run-time.+--+-- It also exports helpful functions from "Termonad.Preferences.File".++module Termonad.Preferences+  ( module Termonad.Preferences.File+  , showPreferencesDialog+  ) where++import Termonad.Prelude++import Control.Lens ((^.), over, set, view)+import qualified Data.List as List+import qualified Data.Text as Text+import GI.Gtk+  ( CheckButton(CheckButton)+  , ComboBoxText(ComboBoxText)+  , Dialog(Dialog)+  , Entry(Entry)+  , FontButton(FontButton)+  , Label(Label)+  , PolicyType(PolicyTypeAutomatic)+  , ResponseType(ResponseTypeAccept)+  , SpinButton(SpinButton)+  , adjustmentNew+  , applicationGetActiveWindow+  , applicationWindowSetShowMenubar+  , builderNewFromString+  , comboBoxGetActiveId+  , comboBoxSetActiveId+  , comboBoxTextAppend+  , dialogRun+  , entryBufferGetText+  , entryBufferSetText+  , fontChooserSetFontDesc+  , fontChooserGetFontDesc+  , getEntryBuffer+  , scrolledWindowSetPolicy+  , spinButtonGetValueAsInt+  , spinButtonSetAdjustment+  , spinButtonSetValue+  , toggleButtonGetActive+  , toggleButtonSetActive+  , widgetDestroy+  , widgetSetVisible+  , windowSetTransientFor+  )+import GI.Vte+  ( CursorBlinkMode(..)+  , terminalSetBoldIsBright+  , terminalSetCursorBlinkMode+  , terminalSetFont+  , terminalSetScrollbackLines+  , terminalSetWordCharExceptions+  , terminalSetAllowBold+  )+import System.Environment (getExecutablePath)+import System.FilePath (takeFileName)+import Termonad.Gtk (objFromBuildUnsafe, terminalSetEnableSixelIfExists)+import Termonad.Lenses+  ( lensBoldIsBright+  , lensEnableSixel+  , lensAllowBold+  , lensConfirmExit+  , lensCursorBlinkMode+  , lensFontConfig+  , lensOptions+  , lensShowMenu+  , lensShowScrollbar+  , lensShowTabBar+  , lensScrollbackLen+  , lensTMNotebookTabTermContainer+  , lensTMNotebookTabTerm+  , lensTMStateApp+  , lensTMStateConfig+  , lensTMStateFontDesc+  , lensTerm+  , lensWordCharExceptions+  )+import Termonad.Preferences.File (saveToPreferencesFile, tmConfigFromPreferencesFile)+import Termonad.Term+  ( setShowTabs+  , showScrollbarToPolicy+  )+import Termonad.Types+  ( ConfigOptions(..)+  , ShowScrollbar(..)+  , ShowTabBar(..)+  , TMNotebookTab+  , TMState+  , TMWindowId+  , fontConfigFromFontDescription+  , getTMWindowFromTMState'+  , tmNotebook+  , tmNotebookTabs+  , tmStateWindows+  , tmWindowAppWin+  , tmWindowNotebook+  )+import Termonad.XML (preferencesText)+import Termonad.IdMap (keysIdMap)++-- | Fill a combo box with ids and labels+--+-- The ids are stored in the combobox as 'Text', so their type should be an+-- instance of the 'Show' type class.+comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()+comboBoxFill comboBox = mapM_ go+  where+    go :: (a, Text) -> IO ()+    go (value, textId) =+      comboBoxTextAppend comboBox (Just $ tshow value) textId++-- | Set the current active item in a combobox given an input id.+comboBoxSetActive :: Show a => ComboBoxText -> a -> IO ()+comboBoxSetActive cb item = void $ comboBoxSetActiveId cb (Just $ tshow item)++-- | Get the current active item in a combobox+--+-- The list of values to be searched in the combobox must be given as a+-- parameter. These values are converted to Text then compared to the current+-- id.+comboBoxGetActive+  :: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)+comboBoxGetActive cb values = findEnumFromMaybeId <$> comboBoxGetActiveId cb+  where+    findEnumFromMaybeId :: Maybe Text -> Maybe a+    findEnumFromMaybeId maybeId = maybeId >>= findEnumFromId++    findEnumFromId :: Text -> Maybe a+    findEnumFromId label = List.find (\x -> tshow x == label) values++applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()+applyNewPreferencesToTab mvarTMState tab = do+  tmState <- readMVar mvarTMState+  let fontDesc = tmState ^. lensTMStateFontDesc+      term = tab ^. lensTMNotebookTabTerm . lensTerm+      scrolledWin = tab ^. lensTMNotebookTabTermContainer+      options = tmState ^. lensTMStateConfig . lensOptions+  terminalSetFont term (Just fontDesc)+  terminalSetCursorBlinkMode term (cursorBlinkMode options)+  terminalSetWordCharExceptions term (wordCharExceptions options)+  terminalSetScrollbackLines term (fromIntegral (scrollbackLen options))+  terminalSetBoldIsBright term (boldIsBright options)+  terminalSetEnableSixelIfExists term (enableSixel options)+  terminalSetAllowBold term (allowBold options)++  let vScrollbarPolicy = showScrollbarToPolicy (options ^. lensShowScrollbar)+  scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy++applyNewPreferencesToWindow :: TMState -> TMWindowId -> IO ()+applyNewPreferencesToWindow mvarTMState tmWinId = do+  tmState <- readMVar mvarTMState+  tmWin <- getTMWindowFromTMState' tmState tmWinId+  let appWin = tmWindowAppWin tmWin+      config = tmState ^. lensTMStateConfig+      notebook = tmWindowNotebook tmWin+      tabFocusList = tmNotebookTabs notebook+      showMenu = config  ^. lensOptions . lensShowMenu+  applicationWindowSetShowMenubar appWin showMenu+  setShowTabs config (tmNotebook notebook)+  -- Sets the remaining preferences to each tab+  foldMap (applyNewPreferencesToTab mvarTMState) tabFocusList++-- | Takes a 'TMState', and looks at the 'TMConfig' within.+-- Take all the configuration options from the 'TMConfig' and apply them to the+-- current 'Application', 'Window's, and 'Term's.+--+-- This function is meant to be used after a big update to the 'TMConfig' within a+-- 'TMState'.+applyNewPreferences :: TMState -> IO ()+applyNewPreferences mvarTMState = do+  tmState <- readMVar mvarTMState+  let windows = tmStateWindows tmState+  foldMap (applyNewPreferencesToWindow mvarTMState) (keysIdMap windows)++-- | Show the preferences dialog.+--+-- When the user clicks on the Ok button, it copies the new settings to TMState.+-- Then apply them to the current terminals.+showPreferencesDialog :: TMState -> IO ()+showPreferencesDialog mvarTMState = do+  -- Get app out of mvar+  tmState <- readMVar mvarTMState+  let app = tmState ^. lensTMStateApp++  -- Create the preference dialog and get some widgets+  preferencesBuilder <-+    builderNewFromString preferencesText $ fromIntegral (Text.length preferencesText)+  preferencesDialog <-+    objFromBuildUnsafe preferencesBuilder "preferences" Dialog+  confirmExitCheckButton <-+    objFromBuildUnsafe preferencesBuilder "confirmExit" CheckButton+  showMenuCheckButton <-+    objFromBuildUnsafe preferencesBuilder "showMenu" CheckButton+  boldIsBrightCheckButton <-+    objFromBuildUnsafe preferencesBuilder "boldIsBright" CheckButton+  enableSixelCheckButton <-+    objFromBuildUnsafe preferencesBuilder "enableSixel" CheckButton+  allowBoldCheckButton <-+    objFromBuildUnsafe preferencesBuilder "allowBold" CheckButton+  wordCharExceptionsEntryBuffer <-+    objFromBuildUnsafe preferencesBuilder "wordCharExceptions" Entry >>=+      getEntryBuffer+  fontButton <- objFromBuildUnsafe preferencesBuilder "font" FontButton+  showScrollbarComboBoxText <-+    objFromBuildUnsafe preferencesBuilder "showScrollbar" ComboBoxText+  comboBoxFill+    showScrollbarComboBoxText+    [ (ShowScrollbarNever, "Never")+    , (ShowScrollbarAlways, "Always")+    , (ShowScrollbarIfNeeded, "If needed")+    ]+  showTabBarComboBoxText <-+    objFromBuildUnsafe preferencesBuilder "showTabBar" ComboBoxText+  comboBoxFill+    showTabBarComboBoxText+    [ (ShowTabBarNever, "Never")+    , (ShowTabBarAlways, "Always")+    , (ShowTabBarIfNeeded, "If needed")+    ]+  cursorBlinkModeComboBoxText <-+    objFromBuildUnsafe preferencesBuilder "cursorBlinkMode" ComboBoxText+  comboBoxFill+    cursorBlinkModeComboBoxText+    [ (CursorBlinkModeSystem, "System")+    , (CursorBlinkModeOn, "On")+    , (CursorBlinkModeOff, "Off")+    ]+  scrollbackLenSpinButton <-+    objFromBuildUnsafe preferencesBuilder "scrollbackLen" SpinButton+  adjustmentNew 0 0 (fromIntegral (maxBound :: Int)) 1 10 0 >>=+    spinButtonSetAdjustment scrollbackLenSpinButton+  warningLabel <- objFromBuildUnsafe preferencesBuilder "warning" Label++  -- We show the warning label only if the user has launched termonad with a+  -- termonad.hs file+  executablePath <- getExecutablePath+  let hasTermonadHs = takeFileName executablePath == "termonad-linux-x86_64"+  widgetSetVisible warningLabel hasTermonadHs++  -- Make the dialog modal+  maybeWin <- applicationGetActiveWindow app+  windowSetTransientFor preferencesDialog maybeWin++  -- Init with current state+  fontChooserSetFontDesc fontButton (tmState ^. lensTMStateFontDesc)+  let options = tmState ^. lensTMStateConfig . lensOptions+  comboBoxSetActive showScrollbarComboBoxText $ showScrollbar options+  comboBoxSetActive showTabBarComboBoxText $ showTabBar options+  comboBoxSetActive cursorBlinkModeComboBoxText $ cursorBlinkMode options+  spinButtonSetValue scrollbackLenSpinButton (fromIntegral $ scrollbackLen options)+  toggleButtonSetActive confirmExitCheckButton $ confirmExit options+  toggleButtonSetActive showMenuCheckButton $ showMenu options+  toggleButtonSetActive boldIsBrightCheckButton $ boldIsBright options+  toggleButtonSetActive enableSixelCheckButton $ enableSixel options+  toggleButtonSetActive allowBoldCheckButton $ allowBold options+  entryBufferSetText wordCharExceptionsEntryBuffer (wordCharExceptions options) (-1)++  -- Run dialog then close+  res <- dialogRun preferencesDialog++  -- When closing the dialog get the new settings+  when (toEnum (fromIntegral res) == ResponseTypeAccept) $ do+    maybeFontDesc <- fontChooserGetFontDesc fontButton+    maybeFontConfig <-+      join <$> mapM fontConfigFromFontDescription maybeFontDesc+    maybeShowScrollbar <-+      comboBoxGetActive showScrollbarComboBoxText [ShowScrollbarNever ..]+    maybeShowTabBar <-+      comboBoxGetActive showTabBarComboBoxText [ShowTabBarNever ..]+    maybeCursorBlinkMode <-+      comboBoxGetActive cursorBlinkModeComboBoxText [CursorBlinkModeSystem ..]+    scrollbackLenVal <-+      fromIntegral <$> spinButtonGetValueAsInt scrollbackLenSpinButton+    confirmExitVal <- toggleButtonGetActive confirmExitCheckButton+    showMenuVal <- toggleButtonGetActive showMenuCheckButton+    boldIsBrightVal <- toggleButtonGetActive boldIsBrightCheckButton+    enableSixelVal <- toggleButtonGetActive enableSixelCheckButton+    allowBoldVal <- toggleButtonGetActive allowBoldCheckButton+    wordCharExceptionsVal <- entryBufferGetText wordCharExceptionsEntryBuffer++    -- Apply the changes to mvarTMState+    modifyMVar_ mvarTMState $ pure+      . over lensTMStateFontDesc (`fromMaybe` maybeFontDesc)+      . over (lensTMStateConfig . lensOptions)+        ( set lensConfirmExit confirmExitVal+        . set lensShowMenu showMenuVal+        . set lensBoldIsBright boldIsBrightVal+        . set lensEnableSixel enableSixelVal+        . set lensAllowBold allowBoldVal+        . set lensWordCharExceptions wordCharExceptionsVal+        . over lensFontConfig (`fromMaybe` maybeFontConfig)+        . set lensScrollbackLen scrollbackLenVal+        . over lensShowScrollbar (`fromMaybe` maybeShowScrollbar)+        . over lensShowTabBar (`fromMaybe` maybeShowTabBar)+        . over lensCursorBlinkMode (`fromMaybe` maybeCursorBlinkMode)+        )++    -- Save the changes to the preferences files+    withMVar mvarTMState $ saveToPreferencesFile . view lensTMStateConfig++    -- Update the app with new settings+    applyNewPreferences mvarTMState++  widgetDestroy preferencesDialog

@@ -0,0 +1,209 @@+{-# LANGUAGE CPP #-}++-- | Description : Read and write to the Preferences file+-- Copyright     : (c) Dennis Gosnell, 2023+-- License       : BSD3+-- Stability     : experimental+-- Portability   : POSIX+--+-- This module contains functions for reading and writing to the preferences file.+--+-- The preferences file is generally stored in+-- @~/.config/termonad/termonad.yaml@.  It stores run-time preferences that+-- have been set through the Preferences dialog.  Preferences are loaded on+-- app startup, but only if the @termonad.hs@ configuration file doesn't exist.++module Termonad.Preferences.File where++import Termonad.Prelude++import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE, withExceptT)+import Data.Aeson (Result(..), fromJSON)+#if MIN_VERSION_aeson(2, 0, 0)+import qualified Data.Aeson.KeyMap as KeyMap+#endif+import qualified Data.ByteString as ByteString+import qualified Data.HashMap.Strict as HashMap+import Data.Text (pack)+import Data.Yaml (ParseException, ToJSON (toJSON), decodeFileEither, encode, prettyPrintParseException)+import Data.Yaml.Aeson (Value(..))+import System.Directory+  ( XdgDirectory(XdgConfig)+  , createDirectoryIfMissing+  , doesFileExist+  , getXdgDirectory+  )+import System.FilePath ((</>))+import Termonad.Types+  ( ConfigOptions+  , TMConfig(TMConfig, hooks, options)+  , defaultConfigHooks+  , defaultConfigOptions+  )++-- $setup+--+-- >>> import Data.Aeson(object, (.=))++-- | Get the path to the preferences file @~\/.config\/termonad\/termonad.yaml@.+getPreferencesFile :: IO FilePath+getPreferencesFile = do+  -- Get the termonad config directory+  confDir <- getXdgDirectory XdgConfig "termonad"+  createDirectoryIfMissing True confDir+  pure $ confDir </> "termonad.yaml"++-- | Read the configuration for the preferences file+-- @~\/.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+  -- If there is no preferences file we create it with the default values+  exists <- doesFileExist confFile+  unless exists $ writePreferencesFile confFile defaultConfigOptions+  -- Read the configuration file+  eitherOptions <- readFileWithDefaults confFile+  options <-+    case eitherOptions of+      Left err -> do+        hPutStrLn stderr $ "Error parsing file " <> pack confFile <> ": " <> err+        pure defaultConfigOptions+      Right options -> pure options+  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 ["hello" .= Number 2]+-- >>> let obj2 = object ["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 object1 = object ["hello" .= Number 1, "bye" .= Number 100]+-- >>> let object2 = object ["hello" .= Number 2, "goat" .= String "chicken"]+-- >>> mergeObjVals object1 object2+-- 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 optsFromFileKeyMap, Object optsDefaultKeyMap) ->+      let+#if MIN_VERSION_aeson(2, 0, 0)+          hashMapFromKeyMap = KeyMap.toHashMap+          keyMapFromHashMap = KeyMap.fromHashMap+#else+          hashMapFromKeyMap = id+          keyMapFromHashMap = id+#endif+          optsFromFileHashMap = hashMapFromKeyMap optsFromFileKeyMap+          optsDefaultHashMap = hashMapFromKeyMap optsDefaultKeyMap+          optsResultHashMap = HashMap.unionWith mergeObjVals+                                optsFromFileHashMap+                                optsDefaultHashMap+          optsResultKeyMap = keyMapFromHashMap optsResultHashMap+      in Object optsResultKeyMap+    -- 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+  let yaml = encode options+      yamlWithComment =+        "# DO NOT EDIT THIS FILE BY HAND!\n" <>+        "#\n" <>+        "# This file is generated automatically by the Preferences dialog\n" <>+        "# in Termonad.  Please open the Preferences dialog if you wish to\n" <>+        "# modify this file.\n" <>+        "#\n" <>+        "# The settings in this file will be ignored if you have a\n" <>+        "# termonad.hs file in this same directory.\n\n" <>+        yaml+  ByteString.writeFile confFile yamlWithComment++-- | Save the configuration to the preferences file+-- @~\/.config\/termonad\/termonad.yaml@+saveToPreferencesFile :: TMConfig -> IO ()+saveToPreferencesFile TMConfig { options = options } = do+  confFile <- getPreferencesFile+  writePreferencesFile confFile options+

@@ -1,195 +0,0 @@-{-# LANGUAGE CPP #-}--module Termonad.PreferencesFile where--import Termonad.Prelude--import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE, withExceptT)-import Data.Aeson (Result(..), fromJSON)-#if MIN_VERSION_aeson(2, 0, 0)-import qualified Data.Aeson.KeyMap as KeyMap-#endif-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-  , doesFileExist-  , getXdgDirectory-  )--import Termonad.Types-  ( ConfigOptions-  , TMConfig(TMConfig, hooks, options)-  , defaultConfigHooks-  , defaultConfigOptions-  )---- $setup------ >>> import Data.Aeson(object, (.=))---- | Get the path to the preferences file @~\/.config\/termonad\/termonad.yaml@.-getPreferencesFile :: IO FilePath-getPreferencesFile = do-  -- Get the termonad config directory-  confDir <- getXdgDirectory XdgConfig "termonad"-  createDirectoryIfMissing True confDir-  pure $ confDir </> "termonad.yaml"---- | Read the configuration for the preferences file--- @~\/.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-  -- If there is no preferences file we create it with the default values-  exists <- doesFileExist confFile-  unless exists $ writePreferencesFile confFile defaultConfigOptions-  -- Read the configuration file-  eitherOptions <- readFileWithDefaults confFile-  options <--    case eitherOptions of-      Left err -> do-        hPutStrLn stderr $ "Error parsing file " <> pack confFile <> ": " <> err-        pure defaultConfigOptions-      Right options -> pure options-  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 ["hello" .= Number 2]--- >>> let obj2 = object ["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 object1 = object ["hello" .= Number 1, "bye" .= Number 100]--- >>> let object2 = object ["hello" .= Number 2, "goat" .= String "chicken"]--- >>> mergeObjVals object1 object2--- 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 optsFromFileKeyMap, Object optsDefaultKeyMap) ->-      let-#if MIN_VERSION_aeson(2, 0, 0)-          hashMapFromKeyMap = KeyMap.toHashMap-          keyMapFromHashMap = KeyMap.fromHashMap-#else-          hashMapFromKeyMap = id-          keyMapFromHashMap = id-#endif-          optsFromFileHashMap = hashMapFromKeyMap optsFromFileKeyMap-          optsDefaultHashMap = hashMapFromKeyMap optsDefaultKeyMap-          optsResultHashMap = HashMap.unionWith mergeObjVals-                                optsFromFileHashMap-                                optsDefaultHashMap-          optsResultKeyMap = keyMapFromHashMap optsResultHashMap-      in Object optsResultKeyMap-    -- 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-  let yaml = encode options-      yamlWithComment =-        "# DO NOT EDIT THIS FILE BY HAND!\n" <>-        "#\n" <>-        "# This file is generated automatically by the Preferences dialog\n" <>-        "# in Termonad.  Please open the Preferences dialog if you wish to\n" <>-        "# modify this file.\n" <>-        "#\n" <>-        "# The settings in this file will be ignored if you have a\n" <>-        "# termonad.hs file in this same directory.\n\n" <>-        yaml-  writeFile confFile yamlWithComment---- | Save the configuration to the preferences file--- @~\/.config\/termonad\/termonad.yaml@-saveToPreferencesFile :: TMConfig -> IO ()-saveToPreferencesFile TMConfig { options = options } = do-  confFile <- getPreferencesFile-  writePreferencesFile confFile options

@@ -1,17 +1,42 @@++-- | This is a basic prelude-like module that adds a bunch of common datatypes+-- and functions to the 'Prelude'.+ module Termonad.Prelude   ( module X   , hPutStrLn   , whenJust+  , stderr+  , tshow   ) where +import Control.Concurrent.MVar as X (MVar, modifyMVar, modifyMVar_, newMVar, readMVar, withMVar)+import Control.Exception as X (IOException, try) import Control.Lens as X ((&))+import Control.Monad as X (join, unless, void, when, (<=<))+import Control.Monad.IO.Class as X+import Control.Monad.Trans.Class as X (lift) import Control.Monad.Trans.Maybe as X (MaybeT(MaybeT), runMaybeT)-import ClassyPrelude as X+import Data.ByteString as X (ByteString)+import Data.Function as X (on)+import Data.Functor as X (($>))+import Data.Int as X (Int32)+import Data.Maybe as X (catMaybes, fromMaybe) import Data.Proxy as X+import Data.String as X (IsString)+import Data.Text as X (Text)+import Data.Text (pack) import qualified Data.Text.IO as TextIO+import Data.Word as X (Word8, Word32)+import GHC.Generics as X (Generic)+import Prelude as X+import System.IO (Handle, stderr)  whenJust :: Monoid m => Maybe a -> (a -> m) -> m whenJust = flip foldMap  hPutStrLn :: MonadIO m => Handle -> Text -> m () hPutStrLn hndl = liftIO . TextIO.hPutStrLn hndl++tshow :: Show a => a -> Text+tshow = pack . show

@@ -0,0 +1,149 @@++-- | Description : Functions for starting up Termonad.+-- Copyright     : (c) Dennis Gosnell, 2023+-- License       : BSD3+-- Stability     : experimental+-- Portability   : POSIX+--+-- This module contains functions for starting up Termonad.++module Termonad.Startup where++import Termonad.Prelude++import Config.Dyre (wrapMain, newParams)+import Control.Lens (over)+import System.IO.Error (doesNotExistErrorType, ioeGetErrorType, ioeGetFileName, tryIOError)+import Termonad.App (start)+import Termonad.Cli (parseCliArgs, applyCliArgs)+import Termonad.Lenses (lensOptions)+import Termonad.Types (TMConfig)+++-- | Run Termonad with the given 'TMConfig'.+--+-- Do not perform any of the recompilation operations that the 'defaultMain'+-- function does.+--+-- This function __does__ parse command line arguments, and then calls 'Termonad.App.start'.+startWithCliArgs :: TMConfig -> IO ()+startWithCliArgs tmConfig = do+  cliArgs <- parseCliArgs+  start (over lensOptions (applyCliArgs cliArgs) tmConfig)++-- | Run Termonad with the given 'TMConfig'.+--+-- This function will check if there is a @~\/.config\/termonad\/termonad.hs@ file+-- and a @~\/.cache\/termonad\/termonad-linux-x86_64@ binary.  Termonad will+-- perform different actions based on whether or not these two files exist.+--+-- Here are the four different possible actions based on the existence of these+-- two files.+--+-- - @~\/.config\/termonad\/termonad.hs@ exists, @~\/.cache\/termonad\/termonad-linux-x86_64@ exists+--+--     The timestamps of these two files are checked.  If the+--     @~\/.config\/termonad\/termonad.hs@ file has been modified after the+--     @~\/.cache\/termonad\/termonad-linux-x86_64@ binary, then Termonad will use+--     GHC to recompile the @~\/.config\/termonad\/termonad.hs@ file, producing a+--     new binary at @~\/.cache\/termonad\/termonad-linux-x86_64@.  This new binary+--     will be re-executed.  The 'TMConfig' passed to this 'defaultMain' will be+--     effectively thrown away, however all command line options will be passed+--     on to this new Termonad process.+--+--     If GHC fails to recompile the @~\/.config\/termonad\/termonad.hs@ file, then+--     Termonad will just execute 'startWithCliArgs' with the 'TMConfig' passed in.+--+--     If the @~\/.cache\/termonad\/termonad-linux-x86_64@ binary has been modified+--     after the @~\/.config\/termonad\/termonad.hs@ file, then Termonad will+--     re-exec the @~\/.cache\/termonad\/termonad-linux-x86_64@ binary.  The+--     'TMConfig' passed to this 'defaultMain' will be effectively thrown away,+--     however all command line options will be passed on to this new Termonad+--     process.+--+-- - @~\/.config\/termonad\/termonad.hs@ exists, @~\/.cache\/termonad\/termonad-linux-x86_64@ does not exist+--+--     Termonad will use GHC to recompile the @~\/.config\/termonad\/termonad.hs@+--     file, producing a new binary at @~\/.cache\/termonad\/termonad-linux-x86_64@.+--     This new binary will be re-executed.  The 'TMConfig' passed to this+--     'defaultMain' will be effectively thrown away, however all command line+--     options will be passed on to this new Termonad process.+--+--     If GHC fails to recompile the @~\/.config\/termonad\/termonad.hs@ file, then+--     Termonad will just execute 'startWithCliArgs' with the 'TMConfig' passed in.+--+-- - @~\/.config\/termonad\/termonad.hs@ does not exist, @~\/.cache\/termonad\/termonad-linux-x86_64@ exists+--+--     Termonad will ignore the @~\/.cache\/termonad\/termonad-linux-x86_64@ binary+--     and just run 'startWithCliArgs' with the 'TMConfig' passed to this function.+--+-- - @~\/.config\/termonad\/termonad.hs@ does not exist, @~\/.cache\/termonad\/termonad-linux-x86_64@ does not exist+--+--     Termonad will run 'startWithCliArgs' with the 'TMConfig' passed to this function.+--+-- Other notes:+--+-- 1. That the locations of @~\/.config\/termonad\/termonad.hs@ and+--    @~\/.cache\/termonad\/termonad-linux-x86_64@ may differ depending on your+--    system.+--+-- 2. In your own @~\/.config\/termonad\/termonad.hs@ file, you can use either+--    'defaultMain' or 'startWithCliArgs'.  As long as you always+--    execute the system-wide @termonad@ binary (instead of the binary produced+--    as @~\/.cache\/termonad\/termonad-linux-x86_64@), the effect should be+--    similar.+--+-- 3. If you directly run the cached termonad binary (e.g.+--    @~\/.cache\/termonad\/termonad-linux-x86_64@) instead of the+--    system-installed Termonad binary (e.g. @\/usr\/bin\/termonad@), the Termonad+--    /will/ recompile the the configuration file+--    @~\/.config\/termonad\/termonad.hs@ according to the above logic (while+--    possibly overwriting the executable file for the binary you're currently+--    running), but it /will not/ re-exec into the newly built @termonad@ binary.+--+-- 4. When running the system-wide @termonad@ binary, the initial 'TMConfig'+--    that gets passed into this function comes from+--    'Termonad.PreferencesFile.tmConfigFromPreferencesFile'.  As stated above,+--    this initial 'TMConfig' gets ignored if users have a+--    @~\/.config\/termonad\/termonad.hs@ file that gets recompiled and re-execed.+--+--    End users generally call 'defaultMain' in their+--    @~\/.config\/termonad\/termonad.hs@ file.+--+--    'defaultMain' interally calls 'startWithCliArgs', which parses CLI arguments+--    and combines them with the passed-in 'TMConfig'.  'startWithCliArgs' then+--    internally calls 'Termonad.App.start'.+--+--    If you don't want the re-compiling and re-exec functionality, you can directly+--    use 'startWithCliArgs'.  If you also don't want the CLI argument parsing+--    functionality, you can directly use 'Termonad.App.start'.+defaultMain :: TMConfig -> IO ()+defaultMain tmConfig = do+  let params = newParams "termonad" realMainFunc collectErrs+  eitherRes <- tryIOError $ wrapMain params (tmConfig, "")+  case eitherRes of+    Left ioErr+      | ioeGetErrorType ioErr == doesNotExistErrorType && ioeGetFileName ioErr == Just "ghc" -> do+          putStrLn $+            "Could not find ghc on your PATH.  Ignoring your termonad.hs " <>+            "configuration file and running termonad with default settings."+          startWithCliArgs tmConfig+      | otherwise -> do+          putStrLn "IO error occurred when trying to run termonad:"+          print ioErr+          putStrLn "Don't know how to recover.  Exiting."+    Right _ -> pure ()+  where+    -- The real main function+    realMainFunc :: (TMConfig, String) -> IO ()+    realMainFunc (cfg, errs) =+      case errs of+        "" -> startWithCliArgs cfg+        _ -> do+          putStrLn $ "Errors from dyre when recompiling Termonad:" <> errs+          putStrLn "Continuing with Termonad without re-execing into recompiled binary..."+          startWithCliArgs cfg++    -- A function that can easily collect errors from dyre+    collectErrs :: (TMConfig, String) -> String -> (TMConfig, String)+    collectErrs (cfg, oldErrs) newErr = (cfg, oldErrs <> "\n" <> newErr)

@@ -4,9 +4,13 @@  import Termonad.Prelude -import Control.Lens ((^.), (.~), set, to)+import Control.Lens ((^.), ix, set)+import Data.Coerce (coerce) import Data.Colour.SRGB (Colour, RGB(RGB), toSRGB) import Data.FocusList (appendFL, deleteFL, getFocusItemFL)+import Data.GI.Base (toManagedPtr)+import Data.Text (pack)+import qualified Data.Text as Text import GI.Gdk   ( Event (Event)   , EventButton@@ -109,7 +113,7 @@   ) import System.Directory (getSymbolicLinkTarget) import System.Environment (lookupEnv)-+import System.FilePath ((</>)) import Termonad.Gtk (terminalSetEnableSixelIfExists) import Termonad.Lenses   ( lensConfirmExit@@ -122,9 +126,9 @@   , lensTMNotebookTabs   , lensTMStateApp   , lensTMStateConfig-  , lensTMStateNotebook-  , lensTerm+  , lensTerm, lensTMStateWindows, lensTMWindowNotebook   )+import Termonad.Pcre (pcre2Multiline) import Termonad.Types   ( ConfigHooks(createTermHook)   , ConfigOptions(scrollbackLen, wordCharExceptions, cursorBlinkMode, boldIsBright, enableSixel, allowBold)@@ -134,57 +138,64 @@   , TMNotebook   , TMNotebookTab   , TMState-  , TMState'(TMState, tmStateAppWin, tmStateConfig, tmStateFontDesc, tmStateNotebook)+  , TMState'(TMState, tmStateConfig, tmStateFontDesc)   , TMTerm+  , TMWindowId   , assertInvariantTMState   , createTMNotebookTab+  , getNotebookFromTMState+  , getTMNotebookFromTMState+  , getTMNotebookFromTMState'+  , getTMWindowFromTMState+  , getTMWindowFromWins   , newTMTerm   , pid   , tmNotebook   , tmNotebookTabTerm   , tmNotebookTabTermContainer   , tmNotebookTabs+  , tmStateWindows+  , tmWindowAppWin+  , tmWindowNotebook   )-import Data.Coerce (coerce)-import Data.GI.Base (toManagedPtr)-import Termonad.Pcre (pcre2Multiline) -focusTerm :: Int -> TMState -> IO ()-focusTerm i mvarTMState = do-  note <- tmNotebook . tmStateNotebook <$> readMVar mvarTMState+focusTerm :: Int -> TMState -> TMWindowId -> IO ()+focusTerm i mvarTMState tmWinId = do+  note <- getNotebookFromTMState mvarTMState tmWinId   notebookSetCurrentPage note (fromIntegral i) -altNumSwitchTerm :: Int -> TMState -> IO ()+altNumSwitchTerm :: Int -> TMState -> TMWindowId -> IO () altNumSwitchTerm = focusTerm -termNextPage :: TMState -> IO ()-termNextPage mvarTMState = do-  note <- tmNotebook . tmStateNotebook <$> readMVar mvarTMState+-- | Change focus to the next tab.+termNextPage :: TMState -> TMWindowId -> IO ()+termNextPage mvarTMState tmWinId = do+  note <- getNotebookFromTMState mvarTMState tmWinId   notebookNextPage note -termPrevPage :: TMState -> IO ()-termPrevPage mvarTMState = do-  note <- tmNotebook . tmStateNotebook <$> readMVar mvarTMState+-- | Change focus to the previous tab.+termPrevPage :: TMState -> TMWindowId -> IO ()+termPrevPage mvarTMState tmWinId = do+  note <- getNotebookFromTMState mvarTMState tmWinId   notebookPrevPage note -termExitFocused :: TMState -> IO ()-termExitFocused mvarTMState = do-  tmState <- readMVar mvarTMState-  let maybeTab =-        tmState ^. lensTMStateNotebook . lensTMNotebookTabs . to getFocusItemFL+termExitFocused :: TMState -> TMWindowId -> IO ()+termExitFocused mvarTMState tmWinId = do+  note <- getTMNotebookFromTMState mvarTMState tmWinId+  let maybeTab = getFocusItemFL $ tmNotebookTabs note   case maybeTab of     Nothing -> pure ()-    Just tab -> termClose tab mvarTMState+    Just tab -> termClose tab mvarTMState tmWinId -termClose :: TMNotebookTab -> TMState -> IO ()-termClose tab mvarTMState = do+termClose :: TMNotebookTab -> TMState -> TMWindowId -> IO ()+termClose tab mvarTMState tmWindowId = do   tmState <- readMVar mvarTMState   let confirm = tmState ^. lensTMStateConfig . lensOptions . lensConfirmExit       close = if confirm then termExitWithConfirmation else termExit-  close tab mvarTMState+  close tab mvarTMState tmWindowId -termExitWithConfirmation :: TMNotebookTab -> TMState -> IO ()-termExitWithConfirmation tab mvarTMState = do+termExitWithConfirmation :: TMNotebookTab -> TMState -> TMWindowId -> IO ()+termExitWithConfirmation tab mvarTMState tmWinId = do   tmState <- readMVar mvarTMState   let app = tmState ^. lensTMStateApp   win <- applicationGetActiveWindow app@@ -208,30 +219,34 @@   res <- dialogRun dialog   widgetDestroy dialog   case toEnum (fromIntegral res) of-    ResponseTypeYes -> termExit tab mvarTMState+    ResponseTypeYes -> termExit tab mvarTMState tmWinId     _ -> pure () -termExit :: TMNotebookTab -> TMState -> IO ()-termExit tab mvarTMState = do+termExit :: TMNotebookTab -> TMState -> TMWindowId -> IO ()+termExit tab mvarTMState tmWinId = do   detachTabAction <-     modifyMVar mvarTMState $ \tmState -> do-      let notebook = tmStateNotebook tmState+      tmNote <- getTMNotebookFromTMState' tmState tmWinId+      let detachTabAction :: IO ()           detachTabAction =             notebookDetachTab-              (tmNotebook notebook)+              (tmNotebook tmNote)               (tmNotebookTabTermContainer tab)-      let newTabs = deleteFL tab (tmNotebookTabs notebook)-      let newTMState =-            set (lensTMStateNotebook . lensTMNotebookTabs) newTabs tmState+          newTabs = deleteFL tab (tmNotebookTabs tmNote)+          newTMState =+            set+              (lensTMStateWindows . ix tmWinId . lensTMWindowNotebook . lensTMNotebookTabs)+              newTabs+              tmState       pure (newTMState, detachTabAction)   detachTabAction-  relabelTabs mvarTMState+  tmWin <- getTMWindowFromTMState mvarTMState tmWinId+  relabelTabs (tmWindowNotebook tmWin) -relabelTabs :: TMState -> IO ()-relabelTabs mvarTMState = do-  TMState{tmStateNotebook} <- readMVar mvarTMState-  let notebook = tmNotebook tmStateNotebook-      tabFocusList = tmNotebookTabs tmStateNotebook+relabelTabs :: TMNotebook -> IO ()+relabelTabs tmNote = do+  let notebook = tmNotebook tmNote+      tabFocusList = tmNotebookTabs tmNote   foldMap (go notebook) tabFocusList   where     go :: Notebook -> TMNotebookTab -> IO ()@@ -411,12 +426,13 @@ -- | Add a page to the notebook and switch to it. addPage   :: TMState+  -> TMWindowId   -> TMNotebookTab   -> Box   -- ^ The GTK Object holding the label we want to show for the tab of the   -- newly created page of the notebook.   -> IO ()-addPage mvarTMState notebookTab tabLabelBox = do+addPage mvarTMState tmWinId notebookTab tabLabelBox = do   -- Append a new notebook page and update the TMState to reflect this.   (note, pageIndex) <- modifyMVar mvarTMState appendNotebookPage @@ -425,8 +441,8 @@   where     appendNotebookPage :: TMState' -> IO (TMState', (Notebook, Int32))     appendNotebookPage tmState = do-      let notebook = tmStateNotebook tmState-          note = tmNotebook notebook+      notebook <- getTMNotebookFromTMState' tmState tmWinId+      let note = tmNotebook notebook           tabs = tmNotebookTabs notebook           scrolledWin = tmNotebookTabTermContainer notebookTab       pageIndex <- notebookAppendPage note scrolledWin (Just tabLabelBox)@@ -434,7 +450,10 @@       setShowTabs (tmState ^. lensTMStateConfig) note       let newTabs = appendFL tabs notebookTab           newTMState =-            tmState & lensTMStateNotebook . lensTMNotebookTabs .~ newTabs+            set+              (lensTMStateWindows . ix tmWinId . lensTMWindowNotebook . lensTMNotebookTabs)+              newTabs+              tmState       pure (newTMState, (note, pageIndex))  -- | Set the keyboard focus on a vte terminal@@ -445,17 +464,23 @@  -- | Create a new 'TMTerm', setting it up and adding it to the GTKNotebook. createTerm-  :: (TMState -> EventKey -> IO Bool)+  :: (TMState -> TMWindowId -> EventKey -> IO Bool)   -- ^ Funtion for handling key presses on the terminal.   -> TMState+  -> TMWindowId   -> IO TMTerm-createTerm handleKeyPress mvarTMState = do+createTerm handleKeyPress mvarTMState tmWinId = do   -- Check preconditions   assertInvariantTMState mvarTMState    -- Read needed data in TMVar-  TMState{tmStateAppWin, tmStateFontDesc, tmStateConfig, tmStateNotebook=currNote} <-+  -- TMState{tmStateAppWin, tmStateFontDesc, tmStateConfig, tmStateNotebook=currNote} <-+  --   readMVar mvarTMState+  TMState{tmStateFontDesc, tmStateConfig, tmStateWindows} <-     readMVar mvarTMState+  tmWin <- getTMWindowFromWins tmStateWindows tmWinId+  let appWin = tmWindowAppWin tmWin+      currNote = tmWindowNotebook tmWin    -- Create a new terminal and launch a shell in it   vteTerm <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig)@@ -474,7 +499,7 @@   let notebookTab = createTMNotebookTab tabLabel scrolledWin tmTerm    -- Add the new notebooktab to the notebook.-  addPage mvarTMState notebookTab tabLabelBox+  addPage mvarTMState tmWinId notebookTab tabLabelBox    -- Setup the initial label for the notebook tab.  This needs to happen   -- after we add the new page to the notebook, so that the page can get labelled@@ -482,15 +507,13 @@   relabelTab (tmNotebook currNote) tabLabel scrolledWin vteTerm    -- Connect callbacks-  void $ onButtonClicked tabCloseButton $ termClose notebookTab mvarTMState+  void $ onButtonClicked tabCloseButton $ termClose notebookTab mvarTMState tmWinId   void $ onTerminalWindowTitleChanged vteTerm $ do-    TMState{tmStateNotebook} <- readMVar mvarTMState-    let notebook = tmNotebook tmStateNotebook-    relabelTab notebook tabLabel scrolledWin vteTerm-  void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState-  void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState-  void $ onWidgetButtonPressEvent vteTerm $ handleMousePress tmStateAppWin vteTerm-  void $ onTerminalChildExited vteTerm $ \_ -> termExit notebookTab mvarTMState+    relabelTab (tmNotebook currNote) tabLabel scrolledWin vteTerm+  void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState tmWinId+  void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState tmWinId+  void $ onWidgetButtonPressEvent vteTerm $ handleMousePress appWin vteTerm+  void $ onTerminalChildExited vteTerm $ \_ -> termExit notebookTab mvarTMState tmWinId    -- Underline URLs so that the user can see they are right-clickable.   --@@ -506,11 +529,11 @@         "(?:http(s)?:\\/\\/)[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+"   -- We must set the pcre2Multiline option, otherwise VTE prints a warning.   let pcreFlags = fromIntegral pcre2Multiline-  regex <- regexNewForMatch regexPat (fromIntegral $ length regexPat) pcreFlags+  regex <- regexNewForMatch regexPat (fromIntegral $ Text.length regexPat) pcreFlags   void $ terminalMatchAddRegex vteTerm regex 0    -- Put the keyboard focus on the term-  setFocusOn tmStateAppWin vteTerm+  setFocusOn appWin vteTerm    -- Make sure the state is still right   assertInvariantTMState mvarTMState

@@ -4,8 +4,9 @@  import Termonad.Prelude -import Control.Monad.Fail (fail)-import Data.FocusList (FocusList, emptyFL, singletonFL, getFocusItemFL, lengthFL)+import Control.Lens (ifoldMap)+import Data.FocusList (FocusList, emptyFL, getFocusItemFL, lengthFL)+import Data.Foldable (toList) import Data.Unique (Unique, hashUnique, newUnique) import Data.Yaml   ( FromJSON(parseJSON)@@ -25,12 +26,11 @@   , notebookGetNthPage   , notebookGetNPages   )-import GI.Pango (FontDescription)+import GI.Pango (FontDescription, fontDescriptionGetSize, fontDescriptionGetSizeIsAbsolute, pattern SCALE, fontDescriptionGetFamily, fontDescriptionNew, fontDescriptionSetFamily, fontDescriptionSetSize, fontDescriptionSetAbsoluteSize) import GI.Vte (Terminal, CursorBlinkMode(..))-import Text.Pretty.Simple (pPrint)-import Text.Show (ShowS, showParen, showString)- import Termonad.Gtk (widgetEq)+import Termonad.IdMap (IdMap, IdMapKey, singletonIdMap, lookupIdMap)+import Text.Pretty.Simple (pPrint)  -- | A wrapper around a VTE 'Terminal'.  This also stores the process ID of the -- process running on this terminal, as well as a 'Unique' that can be used for@@ -107,12 +107,71 @@       showsPrec (d + 1) tmNotebookTabs .       showString "}" +getNotebookFromTMState :: TMState -> TMWindowId -> IO Notebook+getNotebookFromTMState mvarTMState tmWinId = do+  tmNote <- getTMNotebookFromTMState mvarTMState tmWinId+  pure $ tmNotebook tmNote++getNotebookFromTMState' :: TMState' -> TMWindowId -> IO Notebook+getNotebookFromTMState' tmState tmWinId = do+  tmNote <- getTMNotebookFromTMState' tmState tmWinId+  pure $ tmNotebook tmNote++getTMNotebookFromTMState :: TMState -> TMWindowId -> IO TMNotebook+getTMNotebookFromTMState mvarTMState tmWinId = do+  tmWin <- getTMWindowFromTMState mvarTMState tmWinId+  pure $ tmWindowNotebook tmWin++getTMNotebookFromTMState' :: TMState' -> TMWindowId -> IO TMNotebook+getTMNotebookFromTMState' tmState tmWinId = do+  tmWin <- getTMWindowFromTMState' tmState tmWinId+  pure $ tmWindowNotebook tmWin++data TMWindow = TMWindow+  { tmWindowAppWin :: !ApplicationWindow+  , tmWindowNotebook :: !TMNotebook+  }++instance Show TMWindow where+  showsPrec :: Int -> TMWindow -> ShowS+  showsPrec d TMWindow{..} =+    showParen (d > 10) $+      showString "TMWindow {" .+      showString "tmWindowAppWin = " .+      showString "(GI.GTK.ApplicationWindow)" .+      showString ", " .+      showString "tmWindowNotebook = " .+      showsPrec (d + 1) tmWindowNotebook .+      showString "}"++type TMWindowId = IdMapKey++-- | Get a given 'TMWindow' from a set of 'TMWindow's given a 'TMWindowId'.+--+-- This throws an error if the 'TMWindowId' can't be found within the 'IdMap'.+getTMWindowFromWins :: IdMap TMWindow -> TMWindowId -> IO TMWindow+getTMWindowFromWins tmWins tmWinId =+  case lookupIdMap tmWinId tmWins of+    Nothing -> error $ "getTMWindowFromWins: trying to get id " <> show tmWinId <> " from wins, but doesn't exist: " <> show tmWins+    Just tmWin -> pure tmWin++-- | Get a given 'TMWindow' froma a 'TMState' given a 'TMWindowId'.+--+-- This throws an error if the 'TMWindowId' can't be found within the 'TMState'.+getTMWindowFromTMState :: TMState -> TMWindowId -> IO TMWindow+getTMWindowFromTMState mvarTMState tmWinId = do+  TMState{tmStateWindows} <- readMVar mvarTMState+  getTMWindowFromWins tmStateWindows tmWinId++getTMWindowFromTMState' :: TMState' -> TMWindowId -> IO TMWindow+getTMWindowFromTMState' tmState tmWinId =+  getTMWindowFromWins (tmStateWindows tmState) tmWinId+ data TMState' = TMState   { tmStateApp :: !Application-  , tmStateAppWin :: !ApplicationWindow-  , tmStateNotebook :: !TMNotebook-  , tmStateFontDesc :: !FontDescription   , tmStateConfig :: !TMConfig+  , tmStateFontDesc :: !FontDescription+  , tmStateWindows :: !(IdMap TMWindow)   }  instance Show TMState' where@@ -123,17 +182,14 @@       showString "tmStateApp = " .       showString "(GI.GTK.Application)" .       showString ", " .-      showString "tmStateAppWin = " .-      showString "(GI.GTK.ApplicationWindow)" .-      showString ", " .-      showString "tmStateNotebook = " .-      showsPrec (d + 1) tmStateNotebook .+      showString "tmStateConfig = " .+      showsPrec (d + 1) tmStateConfig .       showString ", " .       showString "tmStateFontDesc = " .       showString "(GI.Pango.FontDescription)" .       showString ", " .-      showString "tmStateConfig = " .-      showsPrec (d + 1) tmStateConfig .+      showString "tmStateWindows = " .+      showsPrec (d + 1) tmStateWindows .       showString "}"  type TMState = MVar TMState'@@ -157,14 +213,14 @@ newTMTerm :: Terminal -> Int -> IO TMTerm newTMTerm trm pd = createTMTerm trm pd <$> newUnique -getFocusedTermFromState :: TMState -> IO (Maybe Terminal)-getFocusedTermFromState mvarTMState =+getFocusedTermFromState :: TMState -> TMWindowId -> IO (Maybe Terminal)+getFocusedTermFromState mvarTMState tmWinId =   withMVar mvarTMState go   where     go :: TMState' -> IO (Maybe Terminal)     go tmState = do-      let maybeNotebookTab =-            getFocusItemFL $ tmNotebookTabs $ tmStateNotebook tmState+      tmNote <- getTMNotebookFromTMState' tmState tmWinId+      let maybeNotebookTab = getFocusItemFL $ tmNotebookTabs tmNote       pure $ fmap (term . tmNotebookTabTerm) maybeNotebookTab  createTMNotebookTab :: Label -> ScrolledWindow -> TMTerm -> TMNotebookTab@@ -195,50 +251,27 @@             Nothing -> pure acc             Just notePage' -> unfoldHelper (index32 + 1) (acc ++ [notePage']) -newTMState :: TMConfig -> Application -> ApplicationWindow -> TMNotebook -> FontDescription -> IO TMState-newTMState tmConfig app appWin note fontDesc =-  newMVar $-    TMState-      { tmStateApp = app-      , tmStateAppWin = appWin-      , tmStateNotebook = note-      , tmStateFontDesc = fontDesc-      , tmStateConfig = tmConfig-      }--newEmptyTMState :: TMConfig -> Application -> ApplicationWindow -> Notebook -> FontDescription -> IO TMState-newEmptyTMState tmConfig app appWin note fontDesc =-  newMVar $-    TMState-      { tmStateApp = app-      , tmStateAppWin = appWin-      , tmStateNotebook = createEmptyTMNotebook note-      , tmStateFontDesc = fontDesc-      , tmStateConfig = tmConfig-      }--newTMStateSingleTerm ::-     TMConfig-  -> Application-  -> ApplicationWindow-  -> Notebook-  -> Label-  -> ScrolledWindow-  -> Terminal-  -> Int-  -> FontDescription-  -> IO TMState-newTMStateSingleTerm tmConfig app appWin note label scrollWin trm pd fontDesc = do-  tmTerm <- newTMTerm trm pd-  let tmNoteTab = createTMNotebookTab label scrollWin tmTerm-      tabs = singletonFL tmNoteTab-      tmNote = createTMNotebook note tabs-  newTMState tmConfig app appWin tmNote fontDesc+createTMWindow :: ApplicationWindow -> TMNotebook -> TMWindow+createTMWindow appwin notebook =+  TMWindow+    { tmWindowAppWin = appwin+    , tmWindowNotebook = notebook+    } -traceShowMTMState :: TMState -> IO ()-traceShowMTMState mvarTMState = do-  tmState <- readMVar mvarTMState-  print tmState+newEmptyTMState :: TMConfig -> Application -> ApplicationWindow -> Notebook -> FontDescription -> IO (TMState, TMWindowId)+newEmptyTMState tmConfig app appWin note fontDesc = do+  let tmnote = createEmptyTMNotebook note+      tmwin = createTMWindow appWin tmnote+      (tmwinId, tmwins) = singletonIdMap tmwin+  tmState <-+    newMVar $+      TMState+        { tmStateApp = app+        , tmStateConfig = tmConfig+        , tmStateFontDesc = fontDesc+        , tmStateWindows = tmwins+        }+  pure (tmState, tmwinId)  ------------ -- Config --@@ -299,6 +332,42 @@   let newUnits = oldUnits + fromIntegral i   in FontSizeUnits $ if newUnits < 1 then oldUnits else newUnits +fontSizeFromFontDescription :: FontDescription -> IO FontSize+fontSizeFromFontDescription fontDesc = do+  currSize <- fontDescriptionGetSize fontDesc+  currAbsolute <- fontDescriptionGetSizeIsAbsolute fontDesc+  pure $+    if currAbsolute+    then FontSizeUnits $ fromIntegral currSize / fromIntegral SCALE+    else+      let fontRatio :: Double = fromIntegral currSize / fromIntegral SCALE+      in FontSizePoints $ round fontRatio++-- | Create a 'FontDescription' from a 'FontSize' and font family.+createFontDesc+  :: FontSize+  -> Text+  -- ^ font family+  -> IO FontDescription+createFontDesc fontSz fontFam = do+  fontDesc <- fontDescriptionNew+  fontDescriptionSetFamily fontDesc fontFam+  setFontDescSize fontDesc fontSz+  pure fontDesc++-- | Set the size of a 'FontDescription' from a 'FontSize'.+setFontDescSize :: FontDescription -> FontSize -> IO ()+setFontDescSize fontDesc (FontSizePoints points) =+  fontDescriptionSetSize fontDesc $ fromIntegral (points * fromIntegral SCALE)+setFontDescSize fontDesc (FontSizeUnits units) =+  fontDescriptionSetAbsoluteSize fontDesc $ units * fromIntegral SCALE++-- | Create a 'FontDescription' from the 'fontSize' and 'fontFamily' inside a 'TMConfig'.+createFontDescFromConfig :: TMConfig -> IO FontDescription+createFontDescFromConfig tmConfig = do+  let fontConf = fontConfig (options tmConfig)+  createFontDesc (fontSize fontConf) (fontFamily fontConf)+ -- | Settings for the font to be used in Termonad. data FontConfig = FontConfig   { fontFamily :: !Text@@ -318,6 +387,12 @@     , fontSize = defaultFontSize     } +fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)+fontConfigFromFontDescription fontDescription = do+  fontSize <- fontSizeFromFontDescription fontDescription+  maybeFontFamily <- fontDescriptionGetFamily fontDescription+  return $ (`FontConfig` fontSize) <$> maybeFontFamily+ -- | This data type represents an option that can either be 'Set' or 'Unset'. -- -- This data type is used in situations where leaving an option unset results@@ -327,7 +402,8 @@ -- supplied by the 'ColourConfig' @ConfigExtension@.  By default, -- 'cursorFgColour' and 'cursorBgColour' are both 'Unset'.  However, when -- 'cursorBgColour' is 'Set', 'cursorFgColour' defaults to the color of the text--- underneath.  There is no way to represent this by setting 'cursorFgColour'.+-- underneath.  There is no way to represent this by explicitly setting+-- 'cursorFgColour'. data Option a = Unset | Set !a   deriving (Show, Read, Eq, Ord, Functor, Foldable) @@ -354,6 +430,19 @@                           -- lines on the terminal to show all at once.   deriving (Enum, Eq, Generic, FromJSON, Show, ToJSON) +showScrollbarToString :: ShowScrollbar -> Text+showScrollbarToString = \case+  ShowScrollbarNever -> "never"+  ShowScrollbarAlways -> "always"+  ShowScrollbarIfNeeded -> "if-needed"++showScrollbarFromString :: Text -> Maybe ShowScrollbar+showScrollbarFromString = \case+  "never" -> Just ShowScrollbarNever+  "always" -> Just ShowScrollbarAlways+  "if-needed" -> Just ShowScrollbarIfNeeded+  _ -> Nothing+ -- | Whether or not to show the tab bar for switching tabs. data ShowTabBar   = ShowTabBarNever -- ^ Never show the tab bar, even if there are multiple tabs@@ -362,6 +451,19 @@   | ShowTabBarIfNeeded  -- ^ Only show the tab bar if you have multiple tabs open.   deriving (Enum, Eq, Generic, FromJSON, Show, ToJSON) +showTabBarToString :: ShowTabBar -> Text+showTabBarToString = \case+  ShowTabBarNever -> "never"+  ShowTabBarAlways -> "always"+  ShowTabBarIfNeeded -> "if-needed"++showTabBarFromString :: Text -> Maybe ShowTabBar+showTabBarFromString = \case+  "never" -> Just ShowTabBarNever+  "always" -> Just ShowTabBarAlways+  "if-needed" -> Just ShowTabBarIfNeeded+  _ -> Nothing+ -- | Configuration options for Termonad. -- -- See 'defaultConfigOptions' for the default values.@@ -424,6 +526,20 @@     -- doesn't look good when bold.   } deriving (Eq, Generic, FromJSON, Show, ToJSON) +cursorBlinkModeToString :: CursorBlinkMode -> Text+cursorBlinkModeToString = \case+  CursorBlinkModeSystem -> "system"+  CursorBlinkModeOn -> "on"+  CursorBlinkModeOff -> "off"+  AnotherCursorBlinkMode _ -> "other"++cursorBlinkModeFromString :: Text -> Maybe CursorBlinkMode+cursorBlinkModeFromString = \case+  "system" -> Just CursorBlinkModeSystem+  "on" -> Just CursorBlinkModeOn+  "off" -> Just CursorBlinkModeOff+  _ -> Nothing+ instance FromJSON CursorBlinkMode where   parseJSON = withText "CursorBlinkMode" $ \c -> do     case (c :: Text) of@@ -543,32 +659,36 @@                                 -- the actual GTK 'Notebook' and the 'FocusList'.   deriving (Show) -data TMStateInvariantErr+-- | An invariant error on a given 'TMWindow'.+data TMWinInvariantErr   = FocusNotSame FocusNotSameErr Int   | TabsDoNotMatch TabsDoNotMatch   deriving Show --- | Gather up the invariants for 'TMState' and return them as a list.------ If no invariants have been violated, then this function should return an--- empty list.-invariantTMState' :: TMState' -> IO [TMStateInvariantErr]-invariantTMState' tmState =+-- | An invariant error on a whole 'TMState'.+data TMStateInvariantErr+  = TMWinInvariantErr Int TMWinInvariantErr+    -- ^ An invariant error with a given 'TMWindow'.  The 'Int' indicates+    -- which window it is as an index into 'tmStateWindows'.+  deriving Show++invariantTMWindow :: TMWindow -> IO [TMWinInvariantErr]+invariantTMWindow tmWin =   runInvariants     [ invariantFocusSame     , invariantTMTabLength     , invariantTabsAllMatch     ]   where-    runInvariants :: [IO (Maybe TMStateInvariantErr)] -> IO [TMStateInvariantErr]+    runInvariants :: [IO (Maybe TMWinInvariantErr)] -> IO [TMWinInvariantErr]     runInvariants = fmap catMaybes . sequence -    invariantFocusSame :: IO (Maybe TMStateInvariantErr)+    invariantFocusSame :: IO (Maybe TMWinInvariantErr)     invariantFocusSame = do-      let tmNote = tmNotebook $ tmStateNotebook tmState+      let tmNote = tmNotebook $ tmWindowNotebook tmWin       index32 <- notebookGetCurrentPage tmNote       maybeWidgetFromNote <- notebookGetNthPage tmNote index32-      let focusList = tmNotebookTabs $ tmStateNotebook tmState+      let focusList = tmNotebookTabs $ tmWindowNotebook tmWin           maybeScrollWinFromFL =             tmNotebookTabTermContainer <$> getFocusItemFL focusList           idx = fromIntegral index32@@ -591,12 +711,12 @@                 Just $                   FocusNotSame NotebookTabWidgetDiffersFromFocusListFocus idx -    invariantTMTabLength :: IO (Maybe TMStateInvariantErr)+    invariantTMTabLength :: IO (Maybe TMWinInvariantErr)     invariantTMTabLength = do-      let tmNote = tmNotebook $ tmStateNotebook tmState+      let tmNote = tmNotebook $ tmWindowNotebook tmWin       noteLength32 <- notebookGetNPages tmNote       let noteLength = fromIntegral noteLength32-          focusListLength = lengthFL $ tmNotebookTabs $ tmStateNotebook tmState+          focusListLength = lengthFL $ tmNotebookTabs $ tmWindowNotebook tmWin           lengthEqual = focusListLength == noteLength       if lengthEqual         then pure Nothing@@ -606,10 +726,10 @@                  TabLengthsDifferent noteLength focusListLength      -- Turns a FocusList and Notebook into two lists of widgets and compares each widget for equality-    invariantTabsAllMatch :: IO (Maybe TMStateInvariantErr)+    invariantTabsAllMatch :: IO (Maybe TMWinInvariantErr)     invariantTabsAllMatch = do-      let tmNote = tmNotebook $ tmStateNotebook tmState-          focusList = tmNotebookTabs $ tmStateNotebook tmState+      let tmNote = tmNotebook $ tmWindowNotebook tmWin+          focusList = tmNotebookTabs $ tmWindowNotebook tmWin           flList = tmNotebookTabTermContainer <$> toList focusList       noteList <- notebookToList tmNote       tabsMatch noteList flList@@ -619,16 +739,30 @@            . (IsWidget a, IsWidget b)           => [a]           -> [b]-          -> IO (Maybe TMStateInvariantErr)+          -> IO (Maybe TMWinInvariantErr)         tabsMatch xs ys = foldr go (pure Nothing) (zip3 xs ys [0..])           where-            go :: (a, b, Int) -> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr)+            go :: (a, b, Int) -> IO (Maybe TMWinInvariantErr) -> IO (Maybe TMWinInvariantErr)             go (x, y, i) acc = do               isEq <- widgetEq x y               if isEq                 then acc                 else pure . Just $ TabsDoNotMatch (TabAtIndexDifferent i) +-- | Gather up the invariants for 'TMState' and return them as a list.+--+-- If no invariants have been violated, then this function should return an+-- empty list.+invariantTMState' :: TMState' -> IO [TMStateInvariantErr]+invariantTMState' tmState = do+  let tmWindows = tmStateWindows tmState+  ifoldMap go tmWindows+  where+    go :: Int -> TMWindow -> IO [TMStateInvariantErr]+    go idx tmWin = do+      tmWinErrs <- invariantTMWindow tmWin+      pure $ fmap (TMWinInvariantErr idx) tmWinErrs+ -- | Check the invariants for 'TMState', and call 'fail' if we find that they -- have been violated. assertInvariantTMState :: TMState -> IO ()@@ -650,3 +784,8 @@ pPrintTMState mvarTMState = do   tmState <- readMVar mvarTMState   pPrint tmState++traceShowMTMState :: TMState -> IO ()+traceShowMTMState mvarTMState = do+  tmState <- readMVar mvarTMState+  print tmState

@@ -0,0 +1,386 @@++module Termonad.Window where++import Termonad.Prelude++import Control.Lens ((^.), (^..), set, view, ix)+import Data.FocusList (focusList, moveFromToFL, updateFocusFL)+import Data.Sequence (findIndexR)+import qualified Data.Text as Text+import GI.Gdk (castTo, managedForeignPtr)+import GI.Gio+  ( actionMapAddAction+  , onSimpleActionActivate+  , simpleActionNew+  )+import GI.Gtk+  ( Application+  , ApplicationWindow+  , Notebook+  , PositionType(PositionTypeRight)+  , ResponseType(ResponseTypeNo, ResponseTypeYes)+  , ScrolledWindow(ScrolledWindow)+  , Widget+  , aboutDialogNew+  , applicationSetAccelsForAction+  , containerAdd+  , dialogAddButton+  , dialogGetContentArea+  , dialogNew+  , dialogResponse+  , dialogRun+  , entryGetText+  , entryNew+  , gridAttachNextTo+  , gridNew+  , labelNew+  , onEntryActivate+  , onNotebookPageReordered+  , onNotebookSwitchPage+  , setWidgetMargin+  , widgetDestroy+  , widgetGrabFocus+  , widgetShow+  , windowSetTransientFor+  )+import GI.Pango (FontDescription)+import GI.Vte+  ( catchRegexError+  , regexNewForSearch+  , terminalCopyClipboard+  , terminalPasteClipboard+  , terminalSearchFindNext+  , terminalSearchFindPrevious+  , terminalSearchSetRegex+  , terminalSearchSetWrapAround+  , terminalSetFont+  )+import Termonad.Keys (handleKeyPress)+import Termonad.Lenses+  ( lensTMNotebookTabs+  , lensTMNotebookTabTerm+  , lensTMStateFontDesc+  , lensTerm+  , lensTMStateWindows+  , lensTMWindowNotebook+  )+import Termonad.Term+  ( createTerm+  , relabelTabs+  , termNextPage+  , termPrevPage+  , termExitFocused+  )+import Termonad.Types+  ( FontSize+  , TMNotebookTab+  , TMState+  , TMWindowId+  , fontSizeFromFontDescription+  , getFocusedTermFromState+  , getTMNotebookFromTMState+  , getTMNotebookFromTMState'+  , getTMWindowFromTMState+  , setFontDescSize+  , tmNotebookTabTermContainer+  , tmNotebookTabs+  , tmWindowAppWin+  )++modifyFontSizeForAllTerms :: (FontSize -> FontSize) -> TMState -> TMWindowId -> IO ()+modifyFontSizeForAllTerms modFontSizeFunc mvarTMState tmWinId = do+  tmState <- readMVar mvarTMState+  let fontDesc = tmState ^. lensTMStateFontDesc+  adjustFontDescSize modFontSizeFunc fontDesc+  let terms =+        tmState ^..+          lensTMStateWindows .+          ix tmWinId .+          lensTMWindowNotebook .+          lensTMNotebookTabs .+          traverse .+          lensTMNotebookTabTerm .+          lensTerm+  foldMap (\vteTerm -> terminalSetFont vteTerm (Just fontDesc)) terms+  where+    adjustFontDescSize :: (FontSize -> FontSize) -> FontDescription -> IO ()+    adjustFontDescSize f fontDesc = do+      currFontSz <- fontSizeFromFontDescription fontDesc+      let newFontSz = f currFontSz+      setFontDescSize fontDesc newFontSz++-- | This is the callback for when a page in a 'Notebook' has been reordered+-- (normally caused by a drag-and-drop event).+notebookPageReorderedCallback+  :: TMState+  -> TMWindowId+  -> Widget+  -- ^ The child widget that is in the Notebook page.+  -> Word32+  -- ^ The new index of the Notebook page.+  -> IO ()+notebookPageReorderedCallback mvarTMState tmWinId childWidg pageNum = do+  maybeScrollWin <- castTo ScrolledWindow childWidg+  case maybeScrollWin of+    Nothing ->+      fail $+        "In setupTermonad, in callback for onNotebookPageReordered, " <>+        "child widget is not a ScrolledWindow.\n" <>+        "Don't know how to continue.\n"+    Just scrollWin -> do+      tmNote <- getTMNotebookFromTMState mvarTMState tmWinId+      let fl = view lensTMNotebookTabs tmNote+      let maybeOldPosition =+            findIndexR (compareScrolledWinAndTab scrollWin) (focusList fl)+      case maybeOldPosition of+        Nothing ->+          fail $+            "In setupTermonad, in callback for onNotebookPageReordered, " <>+            "the ScrolledWindow is not already in the FocusList.\n" <>+            "Don't know how to continue.\n"+        Just oldPos -> do+          updateFLTabPos mvarTMState tmWinId oldPos (fromIntegral pageNum)+          tmNote' <- getTMNotebookFromTMState mvarTMState tmWinId+          relabelTabs tmNote'+  where+    compareScrolledWinAndTab :: ScrolledWindow -> TMNotebookTab -> Bool+    compareScrolledWinAndTab scrollWin flTab =+      let ScrolledWindow managedPtrFLTab = tmNotebookTabTermContainer flTab+          foreignPtrFLTab = managedForeignPtr managedPtrFLTab+          ScrolledWindow managedPtrScrollWin = scrollWin+          foreignPtrScrollWin = managedForeignPtr managedPtrScrollWin+      in foreignPtrFLTab == foreignPtrScrollWin++-- | Move a 'TMNotebookTab' from one position to another.+--+-- If the current position index is out of bounds, or the new index is out of+-- bounds, then nothing will be done.+--+-- Note that this function doesn't change anything about the 'tmNotebook'.+-- This function is meant to be used as a call-back for when a 'Notebook's+-- tab-order has been changed.+updateFLTabPos+  :: TMState+  -> TMWindowId+  -> Int+  -- ^ Current position index.+  -> Int+  -- ^ New position index.+  -> IO ()+updateFLTabPos mvarTMState tmWinId oldPos newPos =+  modifyMVar_ mvarTMState $ \tmState -> do+    note <- getTMNotebookFromTMState' tmState tmWinId+    let tabs = tmNotebookTabs note+        maybeNewTabs = moveFromToFL oldPos newPos tabs+    case maybeNewTabs of+      Nothing -> do+        putStrLn $+          "in updateFLTabPos, Strange error: couldn't move tabs.\n" <>+          "old pos: " <> show oldPos <> "\n" <>+          "new pos: " <> show newPos <> "\n" <>+          "tabs: " <> show tabs <> "\n" <>+          "maybeNewTabs: " <> show maybeNewTabs <> "\n" <>+          "tmState: " <> show tmState+        pure tmState+      Just newTabs ->+        pure $+          set+            (lensTMStateWindows . ix tmWinId . lensTMWindowNotebook . lensTMNotebookTabs)+            newTabs+            tmState++showAboutDialog :: ApplicationWindow -> IO ()+showAboutDialog win = do+  aboutDialog <- aboutDialogNew+  windowSetTransientFor aboutDialog (Just win)+  void $ dialogRun aboutDialog+  widgetDestroy aboutDialog++showFindDialog :: ApplicationWindow -> IO (Maybe Text)+showFindDialog win = do+  dialog <- dialogNew+  box <- dialogGetContentArea dialog+  grid <- gridNew++  searchForLabel <- labelNew (Just "Search for regex:")+  containerAdd grid searchForLabel+  widgetShow searchForLabel+  setWidgetMargin searchForLabel 10++  searchEntry <- entryNew+  gridAttachNextTo grid searchEntry (Just searchForLabel) PositionTypeRight 1 1+  widgetShow searchEntry+  setWidgetMargin searchEntry 10+  -- setWidgetMarginBottom searchEntry 20+  void $+    onEntryActivate searchEntry $+      dialogResponse dialog (fromIntegral (fromEnum ResponseTypeYes))++  void $+    dialogAddButton+      dialog+      "Close"+      (fromIntegral (fromEnum ResponseTypeNo))+  void $+    dialogAddButton+      dialog+      "Find"+      (fromIntegral (fromEnum ResponseTypeYes))++  containerAdd box grid+  widgetShow grid+  windowSetTransientFor dialog (Just win)+  res <- dialogRun dialog++  searchString <- entryGetText searchEntry+  let maybeSearchString =+        case toEnum (fromIntegral res) of+          ResponseTypeYes -> Just searchString+          _ -> Nothing++  widgetDestroy dialog++  pure maybeSearchString++doFind :: TMState -> TMWindowId -> IO ()+doFind mvarTMState tmWinId = do+  tmWin <- getTMWindowFromTMState mvarTMState tmWinId+  let win = tmWindowAppWin tmWin+  maybeSearchString <- showFindDialog win+  -- putStrLn $ "trying to find: " <> tshow maybeSearchString+  maybeTerminal <- getFocusedTermFromState mvarTMState tmWinId+  case (maybeSearchString, maybeTerminal) of+    (Just searchString, Just terminal) -> do+      -- TODO: Figure out how to import the correct pcre flags.+      --+      -- If you don't pass the pcre2Multiline flag, VTE gives+      -- the following warning:+      --+      -- (termonad-linux-x86_64:18792): Vte-WARNING **:+      -- 21:56:31.193: (vtegtk.cc:2269):void+      -- vte_terminal_search_set_regex(VteTerminal*,+      -- VteRegex*, guint32): runtime check failed:+      -- (regex == nullptr ||+      -- _vte_regex_get_compile_flags(regex) & PCRE2_MULTILINE)+      --+      -- However, if you do add the pcre2Multiline flag,+      -- the terminalSearchSetRegex appears to just completely+      -- not work.+      let pcreFlags = 0+      let newRegex =+            regexNewForSearch+              searchString+              (fromIntegral $ Text.length searchString)+              pcreFlags+      eitherRegex <-+        catchRegexError+          (fmap Right newRegex)+          (\_ errMsg -> pure (Left errMsg))+      case eitherRegex of+        Left errMsg -> do+          let msg = "error when creating regex: " <> errMsg+          hPutStrLn stderr msg+        Right regex -> do+          terminalSearchSetRegex terminal (Just regex) pcreFlags+          terminalSearchSetWrapAround terminal True+          _matchFound <- terminalSearchFindPrevious terminal+          -- TODO: Setup an actual logging framework to show these+          -- kinds of log messages.  Also make a similar change in+          -- findAbove and findBelow.+          -- putStrLn $ "was match found: " <> tshow matchFound+          pure ()+    _ -> pure ()++findAbove :: TMState -> TMWindowId -> IO ()+findAbove mvarTMState tmWinId = do+  maybeTerminal <- getFocusedTermFromState mvarTMState tmWinId+  case maybeTerminal of+    Nothing -> pure ()+    Just terminal -> do+      _matchFound <- terminalSearchFindPrevious terminal+      -- putStrLn $ "was match found: " <> tshow matchFound+      pure ()++findBelow :: TMState -> TMWindowId -> IO ()+findBelow mvarTMState tmWinId = do+  maybeTerminal <- getFocusedTermFromState mvarTMState tmWinId+  case maybeTerminal of+    Nothing -> pure ()+    Just terminal -> do+      _matchFound <- terminalSearchFindNext terminal+      -- putStrLn $ "was match found: " <> tshow matchFound+      pure ()++setupWindowCallbacks :: TMState -> Application -> ApplicationWindow -> Notebook -> TMWindowId -> IO ()+setupWindowCallbacks mvarTMState app win note tmWinId = do++  void $ onNotebookSwitchPage note $ \_ pageNum -> do+    modifyMVar_ mvarTMState $ \tmState -> do+      tmNote <- getTMNotebookFromTMState' tmState tmWinId+      let tabs = tmNotebookTabs tmNote+          maybeNewTabs = updateFocusFL (fromIntegral pageNum) tabs+      case maybeNewTabs of+        Nothing -> pure tmState+        Just (tab, newTabs) -> do+          widgetGrabFocus $ tab ^. lensTMNotebookTabTerm . lensTerm+          pure $+            set+              (lensTMStateWindows . ix tmWinId . lensTMWindowNotebook . lensTMNotebookTabs)+              newTabs+              tmState++  void $ onNotebookPageReordered note $ \childWidg pageNum ->+    notebookPageReorderedCallback mvarTMState tmWinId childWidg pageNum++  newTabAction <- simpleActionNew "newtab" Nothing+  void $ onSimpleActionActivate newTabAction $ \_ ->+    void $ createTerm handleKeyPress mvarTMState tmWinId+  actionMapAddAction win newTabAction+  applicationSetAccelsForAction app "win.newtab" ["<Shift><Ctrl>T"]++  nextPageAction <- simpleActionNew "nextpage" Nothing+  void $ onSimpleActionActivate nextPageAction $ \_ ->+    termNextPage mvarTMState tmWinId+  actionMapAddAction win nextPageAction+  applicationSetAccelsForAction app "win.nextpage" ["<Ctrl>Page_Down"]++  prevPageAction <- simpleActionNew "prevpage" Nothing+  void $ onSimpleActionActivate prevPageAction $ \_ ->+    termPrevPage mvarTMState tmWinId+  actionMapAddAction win prevPageAction+  applicationSetAccelsForAction app "win.prevpage" ["<Ctrl>Page_Up"]++  closeTabAction <- simpleActionNew "closetab" Nothing+  void $ onSimpleActionActivate closeTabAction $ \_ ->+    termExitFocused mvarTMState tmWinId+  actionMapAddAction win closeTabAction+  applicationSetAccelsForAction app "win.closetab" ["<Shift><Ctrl>W"]++  copyAction <- simpleActionNew "copy" Nothing+  void $ onSimpleActionActivate copyAction $ \_ -> do+    maybeTerm <- getFocusedTermFromState mvarTMState tmWinId+    maybe (pure ()) terminalCopyClipboard maybeTerm+  actionMapAddAction win copyAction+  applicationSetAccelsForAction app "win.copy" ["<Shift><Ctrl>C"]++  pasteAction <- simpleActionNew "paste" Nothing+  void $ onSimpleActionActivate pasteAction $ \_ -> do+    maybeTerm <- getFocusedTermFromState mvarTMState tmWinId+    maybe (pure ()) terminalPasteClipboard maybeTerm+  actionMapAddAction win pasteAction+  applicationSetAccelsForAction app "win.paste" ["<Shift><Ctrl>V"]++  findAction <- simpleActionNew "find" Nothing+  void $ onSimpleActionActivate findAction $ \_ -> doFind mvarTMState tmWinId+  actionMapAddAction win findAction+  applicationSetAccelsForAction app "win.find" ["<Shift><Ctrl>F"]++  findAboveAction <- simpleActionNew "findabove" Nothing+  void $ onSimpleActionActivate findAboveAction $ \_ -> findAbove mvarTMState tmWinId+  actionMapAddAction win findAboveAction+  applicationSetAccelsForAction app "win.findabove" ["<Shift><Ctrl>P"]++  findBelowAction <- simpleActionNew "findbelow" Nothing+  void $ onSimpleActionActivate findBelowAction $ \_ -> findBelow mvarTMState tmWinId+  actionMapAddAction win findBelowAction+  applicationSetAccelsForAction app "win.findbelow" ["<Shift><Ctrl>I"]

@@ -7,6 +7,8 @@  import Data.Default (def) import Data.FileEmbed (embedFile)+import Data.Text.Encoding (decodeUtf8)+import qualified Data.Text.Lazy as LText import Text.XML (renderText) import Text.XML.QQ (Document, xmlRaw) @@ -23,7 +25,7 @@     <interface>       <!-- interface-requires gtk+ 3.8 -->       <object id="appWin" class="GtkApplicationWindow">-        <property name="title" translatable="yes">Example Application</property>+        <property name="title" translatable="yes">Termonad</property>         <property name="default-width">600</property>         <property name="default-height">400</property>         <child>@@ -42,7 +44,7 @@    |]  interfaceText :: Text-interfaceText = toStrict $ renderText def interfaceDoc+interfaceText = LText.toStrict $ renderText def interfaceDoc  menuDoc :: Document menuDoc =@@ -54,15 +56,24 @@         <submenu>           <attribute name="label" translatable="yes">File</attribute>           <section>+            <!-- TODO: Uncomment this when adding functionality for creating new+                 windows+            -->+            <!--             <item>+              <attribute name="label" translatable="yes">_New Window</attribute>+              <attribute name="action">app.newwin</attribute>+            </item>+            -->+            <item>               <attribute name="label" translatable="yes">New _Tab</attribute>-              <attribute name="action">app.newtab</attribute>+              <attribute name="action">win.newtab</attribute>             </item>           </section>           <section>             <item>               <attribute name="label" translatable="yes">_Close Tab</attribute>-              <attribute name="action">app.closetab</attribute>+              <attribute name="action">win.closetab</attribute>             </item>             <item>               <attribute name="label" translatable="yes">_Quit</attribute>@@ -74,11 +85,11 @@           <attribute name="label" translatable="yes">Edit</attribute>           <item>             <attribute name="label" translatable="yes">_Copy</attribute>-            <attribute name="action">app.copy</attribute>+            <attribute name="action">win.copy</attribute>           </item>           <item>             <attribute name="label" translatable="yes">_Paste</attribute>-            <attribute name="action">app.paste</attribute>+            <attribute name="action">win.paste</attribute>           </item>           <item>             <attribute name="label" translatable="yes">_Preferences</attribute>@@ -100,15 +111,15 @@           <attribute name="label" translatable="yes">Search</attribute>           <item>             <attribute name="label" translatable="yes">_Find...</attribute>-            <attribute name="action">app.find</attribute>+            <attribute name="action">win.find</attribute>           </item>           <item>             <attribute name="label" translatable="yes">Find Above</attribute>-            <attribute name="action">app.findabove</attribute>+            <attribute name="action">win.findabove</attribute>           </item>           <item>             <attribute name="label" translatable="yes">Find Below</attribute>-            <attribute name="action">app.findbelow</attribute>+            <attribute name="action">win.findbelow</attribute>           </item>         </submenu>         <submenu>@@ -123,7 +134,7 @@    |]  menuText :: Text-menuText = toStrict $ renderText def menuDoc+menuText = LText.toStrict $ renderText def menuDoc  aboutDoc :: Document aboutDoc =@@ -201,7 +212,7 @@    |]  aboutText :: Text-aboutText = toStrict $ renderText def aboutDoc+aboutText = LText.toStrict $ renderText def aboutDoc  closeTabDoc :: Document closeTabDoc =@@ -258,7 +269,7 @@    |]  closeTabText :: Text-closeTabText = toStrict $ renderText def closeTabDoc+closeTabText = LText.toStrict $ renderText def closeTabDoc  preferencesText :: Text preferencesText = decodeUtf8 $(embedFile "glade/preferences.glade")

@@ -1,5 +1,5 @@ name:                termonad-version:             4.5.0.0+version:             4.6.0.0 synopsis:            Terminal emulator configurable in Haskell description:   Termonad is a terminal emulator configurable in Haskell.  It is extremely@@ -28,13 +28,13 @@                    , glade/preferences.glade                    , glade/README.md                    , img/termonad.png-                   , .nix-helpers/nixops.nix+                   , img/termonad-lambda.png+                   , .nix-helpers/nixos-vm.nix                    , .nix-helpers/nixpkgs.nix                    , .nix-helpers/overlays.nix                    , .nix-helpers/stack-shell.nix                    , .nix-helpers/termonad-with-packages.nix                    , shell.nix-data-files:          img/termonad-lambda.png custom-setup                    -- Hackage apparently gives an error if you don't specify an                    -- upper bound on your setup-depends. But I don't want to@@ -59,33 +59,37 @@   hs-source-dirs:      src   exposed-modules:     Termonad                      , Termonad.App+                     , Termonad.Cli                      , Termonad.Config                      , Termonad.Config.Colour                      , Termonad.Gtk+                     , Termonad.IdMap+                     , Termonad.IdMap.Internal                      , Termonad.Keys                      , Termonad.Lenses                      , Termonad.Pcre-                     , Termonad.PreferencesFile+                     , Termonad.Preferences+                     , Termonad.Preferences.File                      , Termonad.Prelude+                     , Termonad.Startup                      , Termonad.Term                      , Termonad.Types+                     , Termonad.Window                      , Termonad.XML   other-modules:       Paths_termonad   build-depends:       base >= 4.13 && < 5-                     , adjunctions                      , aeson-                     , classy-prelude+                     , bytestring                      , colour-                     , constraints                      , containers                      , data-default                      , directory >= 1.3.1.0-                     , distributive-                     , dyre+                     , dyre >= 0.9                      , file-embed                      , filepath                      , focuslist                      , gi-gdk+                     , gi-gdkpixbuf                      , gi-gio                      , gi-glib                      , gi-gtk >= 3.0.24@@ -94,9 +98,8 @@                      , haskell-gi-base >= 0.21.2                      , inline-c                      , lens-                     , mono-traversable+                     , optparse-applicative                      , pretty-simple-                     , QuickCheck                      , text                      , transformers                      , unordered-containers@@ -104,7 +107,7 @@                      , xml-html-qq                      , yaml   default-language:    Haskell2010-  ghc-options:         -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+  ghc-options:         -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wunused-packages   default-extensions:  DataKinds                      , DefaultSignatures                      , DeriveAnyClass@@ -167,15 +170,8 @@   main-is:             Test.hs   hs-source-dirs:      test   build-depends:       base-                     , genvalidity-containers-                     , genvalidity-hspec-                     , hedgehog-                     , lens-                     , QuickCheck                      , termonad                      , tasty-                     , tasty-hedgehog-                     , tasty-hspec   default-language:    Haskell2010   ghc-options:         -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -threaded -rtsopts -with-rtsopts=-N   default-extensions:  DataKinds

@@ -292,35 +292,34 @@  Termonad is similar to XMonad. The above steps will install a `termonad` binary somewhere on your system. If you have installed Termonad using `stack`, the-`termonad` binary will be in `~/.local/bin/`. This binary is a version of-Termonad configured with default settings. You can try running it to get an idea-of what Termonad is like:+`termonad` binary will be in `~/.local/bin/`. If you have installed Termonad using+your Linux distro, the `termonad` binary will likely be in `/usr/bin/`. This+binary is a version of Termonad configured with default settings. You can try+running it to get an idea of what Termonad is like:  ```sh-$ ~/.local/bin/termonad+$ /usr/bin/termonad ``` -The following section describes the default key bindings.- If you would like to configure Termonad with your own settings, first you will need to create a Haskell file called `~/.config/termonad/termonad.hs`. A following section gives an example configuration file. -If this configuration file exists, when the `~/.local/bin/termonad` binary+If this configuration file exists, when the `/usr/bin/termonad` binary launches, it will try to use GHC to compile the configuration file. If GHC is able to successfully compile the configuration file, a separate binary will be created called something like `~/.cache/termonad/termonad-linux-x86_64`. This binary file can be thought of as your own personal Termonad, configured with all your own settings. -When you run `~/.local/bin/termonad`, it will re-exec+When you run `/usr/bin/termonad`, it will re-exec `~/.cache/termonad/termonad-linux-x86_64` if it exists.  However, there is one difficulty with this setup. In order for the-`~/.local/bin/termonad` binary to be able to compile your+`/usr/bin/termonad` binary to be able to compile your `~/.config/termonad/termonad.hs` configuration file, Termonad needs to know where GHC is, as well as where all your Haskell packages live. This presents-some difficulties that will be discussed in a following section.+some difficulties that will be discussed in one of the following sections.  ### Default Key Bindings @@ -341,31 +340,40 @@  ### Configuring Termonad -Termonad has two different ways to be configured.+Termonad has three different ways to be configured. -The first way is to use the built-in Preferences editor.  You can find this in-the `Preferences` menu under `Edit` in the menubar.+1.  Pass arguments on the command line.  For instance, run+    `termonad --no-show-menu` to never show the `File` menubar. -When opening Termonad for the first time, it will create a preferences file at-`~/.config/termonad/termonad.yaml`.  When you change a setting in the-Preferences editor, Termonad will update the setting in the preferences file.+    Arguments passed on the command line will normally override other+    configuration methods. -When running Termonad, it will load settings from the preferences file.-Do not edit the preferences file by hand, because it will be overwritten when-updating settings in the Preferences editor.+2.  Use the built-in Preferences editor.  You can find this in+    the `Preferences` menu under `Edit` in the menubar. -This method is perfect for users who only want to make small changes to the-Termonad settings, like the default font size.+    When opening Termonad for the first time, it will create a preferences file+    at `~/.config/termonad/termonad.yaml`.  When you change a setting in the+    Preferences editor, Termonad will update the setting in the preferences+    file. -The second way to configure Termonad is to use a Haskell-based settings file,-called `~/.config/termonad/termonad.hs` by default.  This method allows you to-make large, sweeping changes to Termonad.  This method is recommended for power-users.+    When running Termonad, it will load settings from the preferences file. Do+    not edit the preferences file by hand, because it will be overwritten when+    updating settings in the Preferences editor. +    This method is perfect for users who only want to make small changes to the+    Termonad settings, like the default font size.++3.  Use a Haskell-based settings file, called `~/.config/termonad/termonad.hs` by default.+    This method allows you to make large, sweeping changes to Termonad.  This+    method is recommended for power users.++    The rest of this section explains the `~/.config/termonad/termonad.hs` file.+ **WARNING: If you have a `~/.config/termonad/termonad.hs` file, then all settings from `~/.config/termonad/termonad.yaml` will be ignored.  If you want to set *ANY* settings in `~/.config/termonad/termonad.hs`, then you must-set *ALL* settings in `~/.config/termonad/termonad.hs`.**+set *ALL* settings in `~/.config/termonad/termonad.hs`.  However, as stated above,+CLI arguments will override settings in `~/.config/termonad/termonad.hs` by default.**  The following is an example Termonad configuration file. You should save this to `~/.config/termonad/termonad.hs`. You can find more information on the available@@ -378,11 +386,11 @@  module Main where -import Termonad.App (defaultMain)-import Termonad.Config+import Termonad   ( FontConfig, FontSize(FontSizePoints), Option(Set)   , ShowScrollbar(ShowScrollbarAlways), defaultConfigOptions, defaultFontConfig-  , defaultTMConfig, fontConfig, fontFamily, fontSize, options, showScrollbar+  , defaultMain, defaultTMConfig, fontConfig, fontFamily, fontSize, options+  , showScrollbar   ) import Termonad.Config.Colour   ( AlphaColour, ColourConfig, addColourExtension, createColour@@ -439,9 +447,9 @@  ### Compiling Local Settings -If you launch Termonad by calling `~/.local/bin/termonad`, it will try to+If you launch Termonad by calling `/usr/bin/termonad`, it will try to compile the `~/.config/termonad/termonad.hs` file if it exists.  The problem is-that `~/.local/bin/termonad` needs to be able to see GHC and the required+that `/usr/bin/termonad` needs to be able to see GHC and the required Haskell libraries to be able to compile `~/.config/termonad/termonad.hs`.  There are a couple solutions to this problem, listed in the sections below.@@ -452,9 +460,10 @@  #### Running with `stack` -If you originally compiled Termonad with `stack`, you can use `stack` to-execute Termonad.  First, you must change to the directory with the Termonad-source code.  From there, you can run `stack exec`:+If you originally compiled Termonad with `stack` and installed it to+`~/.local/bin/termonad`, you can use `stack` to execute Termonad.  First, you+must change to the directory with the Termonad source code.  From there, you+can run `stack exec`:  ```sh $ cd termonad/  # change to the termonad source code directory