diff --git a/.nix-helpers/nixpkgs.nix b/.nix-helpers/nixpkgs.nix --- a/.nix-helpers/nixpkgs.nix +++ b/.nix-helpers/nixpkgs.nix @@ -10,6 +10,9 @@ nixpkgs ? null , # Additional overlays to apply when importing nixpkgs. additionalOverlays ? [] +, # Build all the examples bundled with termonad. Normally this is only used + # in CI for testing that the examples all still compile. + buildExamples ? false }: let @@ -32,18 +35,37 @@ super.haskell.packageOverrides hself hsuper // { termonad = let + filesToIgnore = [ + ".git" + ".nix-helpers" + "result" + ".stack-work" + ".travis.yml" + ]; + src = builtins.filterSource (path: type: with self.stdenv.lib; - ! elem (baseNameOf path) [ ".git" "result" ".stack-work" ".nix-helpers" ] && + ! elem (baseNameOf path) filesToIgnore && ! any (flip hasPrefix (baseNameOf path)) [ "dist" ".ghc" ] ) ./..; + + extraCabal2nixOptions = + self.lib.optionalString buildExamples "-fbuildexamples"; + + termonadDrv = + hself.callCabal2nixWithOptions + "termonad" + src + extraCabal2nixOptions + { + inherit (self.gnome3) gtk3; + libpcre2 = self.pcre2; + vte_291 = self.gnome3.vte; + }; in - hself.callCabal2nix "termonad" src { - inherit (self.gnome3) gtk3; - vte_291 = self.gnome3.vte; - }; + termonadDrv; }; }; diff --git a/.nix-helpers/termonad-with-packages.nix b/.nix-helpers/termonad-with-packages.nix --- a/.nix-helpers/termonad-with-packages.nix +++ b/.nix-helpers/termonad-with-packages.nix @@ -98,12 +98,13 @@ in { extraHaskellPackages ? defaultPackages -, compiler ? null , nixpkgs ? null , additionalOverlays ? [] +, compiler ? null +, buildExamples ? false }@args: -with (import ./nixpkgs.nix { inherit compiler nixpkgs additionalOverlays; }); +with (import ./nixpkgs.nix { inherit compiler nixpkgs additionalOverlays buildExamples; }); let # GHC environment that has termonad available, as well as the packages diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +## 2.0.0.0 + +* Added menu option to search for a regex within the terminal output. + This removes support for versions of VTE-2.91 older than 0.46. + This means that compiling on older versions of Debian and Ubuntu may no + longer work. [#118](https://github.com/cdepillabout/termonad/pull/118) + ## 1.3.0.0 * Change all uses of diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -226,6 +226,9 @@ |------------|--------| | Ctrl Shift t | Open new tab. | | Ctrl Shift w | Close tab. | +| Ctrl Shift f | Open Find dialog for searching for a regex. | +| Ctrl Shift p | Find the regex **above** the current position. | +| Ctrl Shift i | Find the regex **below** the current position. | | Ctrl + | Increase font size. | | Ctrl - | Decrease font size. | | Alt (number key) | Switch to tab `number`. For example, Alt 2 switches to tab 2. | diff --git a/default.nix b/default.nix --- a/default.nix +++ b/default.nix @@ -17,7 +17,11 @@ # # $ nix-env --file default.nix --install -{ compiler ? null, nixpkgs ? null, additionalOverlays ? [] }@args: +{ nixpkgs ? null +, additionalOverlays ? [] +, compiler ? null +, buildExamples ? false +}@args: import .nix-helpers/termonad-with-packages.nix args diff --git a/src/Termonad/App.hs b/src/Termonad/App.hs --- a/src/Termonad/App.hs +++ b/src/Termonad/App.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ForeignFunctionInterface #-} module Termonad.App where @@ -23,6 +24,7 @@ ( Application , ApplicationWindow(ApplicationWindow) , Box(Box) + , PositionType(PositionTypeRight) , ResponseType(ResponseTypeNo, ResponseTypeYes) , ScrolledWindow(ScrolledWindow) , pattern STYLE_PROVIDER_PRIORITY_APPLICATION @@ -40,10 +42,16 @@ , dialogAddButton , dialogGetContentArea , dialogNew + , dialogResponse , dialogRun + , entryGetText + , entryNew + , gridAttachNextTo + , gridNew , labelNew , notebookGetNPages , notebookNew + , onEntryActivate , onNotebookPageRemoved , onNotebookPageReordered , onNotebookSwitchPage @@ -72,8 +80,14 @@ , fontDescriptionSetAbsoluteSize ) import GI.Vte - ( terminalCopyClipboard + ( catchRegexError + , regexNewForSearch + , terminalCopyClipboard , terminalPasteClipboard + , terminalSearchFindNext + , terminalSearchFindPrevious + , terminalSearchSetRegex + , terminalSearchSetWrapAround , terminalSetFont ) @@ -106,6 +120,7 @@ , newEmptyTMState , tmNotebookTabTermContainer , tmNotebookTabs + , tmStateApp , tmStateNotebook ) import Termonad.XML (interfaceText, menuText) @@ -309,11 +324,6 @@ else setShowTabs tmConfig note void $ onNotebookSwitchPage note $ \_ pageNum -> do - maybeRes <- tryTakeMVar mvarTMState - case maybeRes of - Nothing -> pure () - Just val -> do - putMVar mvarTMState val modifyMVar_ mvarTMState $ \tmState -> do let notebook = tmStateNotebook tmState tabs = tmNotebookTabs notebook @@ -393,8 +403,23 @@ actionMapAddAction app reduceFontAction applicationSetAccelsForAction app "app.reducefont" ["minus"] + findAction <- simpleActionNew "find" Nothing + void $ onSimpleActionActivate findAction $ \_ -> doFind mvarTMState + actionMapAddAction app findAction + applicationSetAccelsForAction app "app.find" ["F"] + + findAboveAction <- simpleActionNew "findabove" Nothing + void $ onSimpleActionActivate findAboveAction $ \_ -> findAbove mvarTMState + actionMapAddAction app findAboveAction + applicationSetAccelsForAction app "app.findabove" ["P"] + + findBelowAction <- simpleActionNew "findbelow" Nothing + void $ onSimpleActionActivate findBelowAction $ \_ -> findBelow mvarTMState + actionMapAddAction app findBelowAction + applicationSetAccelsForAction app "app.findbelow" ["I"] + aboutAction <- simpleActionNew "about" Nothing - void $ onSimpleActionActivate aboutAction (const $ showAboutDialog app) + void $ onSimpleActionActivate aboutAction $ \_ -> showAboutDialog app actionMapAddAction app aboutAction when (tmConfig ^. lensOptions . lensShowMenu) $ do @@ -439,6 +464,122 @@ 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 () appStartup :: Application -> IO () appStartup _app = pure () diff --git a/src/Termonad/Pcre.hs b/src/Termonad/Pcre.hs new file mode 100644 --- /dev/null +++ b/src/Termonad/Pcre.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Termonad.Pcre where + +import Foreign.C (CUInt) +import qualified Language.C.Inline as C + +C.verbatim "#define PCRE2_CODE_UNIT_WIDTH 0" +C.include "" + +pcre2Multiline :: CUInt +pcre2Multiline = [C.pure| unsigned int { PCRE2_MULTILINE } |] diff --git a/src/Termonad/Prelude.hs b/src/Termonad/Prelude.hs --- a/src/Termonad/Prelude.hs +++ b/src/Termonad/Prelude.hs @@ -1,11 +1,16 @@ module Termonad.Prelude ( module X + , hPutStrLn , whenJust ) where import Control.Lens as X ((&)) import ClassyPrelude as X import Data.Proxy as X +import qualified Data.Text.IO as TextIO whenJust :: Monoid m => Maybe a -> (a -> m) -> m whenJust = flip foldMap + +hPutStrLn :: MonadIO m => Handle -> Text -> m () +hPutStrLn hndl = liftIO . TextIO.hPutStrLn hndl diff --git a/src/Termonad/Term.hs b/src/Termonad/Term.hs --- a/src/Termonad/Term.hs +++ b/src/Termonad/Term.hs @@ -23,6 +23,7 @@ ) import GI.Gtk ( Align(AlignFill) + , ApplicationWindow , Box , Button , IconSize(IconSizeMenu) @@ -68,7 +69,7 @@ , windowSetFocus , windowSetTransientFor ) -import GI.Pango (EllipsizeMode(EllipsizeModeMiddle)) +import GI.Pango (EllipsizeMode(EllipsizeModeMiddle), FontDescription) import GI.Vte ( PtyFlags(PtyFlagsDefault) , Terminal @@ -106,6 +107,7 @@ , ShowScrollbar(..) , ShowTabBar(..) , TMConfig(hooks, options) + , TMNotebook , TMNotebookTab , TMState , TMState'(TMState, tmStateAppWin, tmStateConfig, tmStateFontDesc, tmStateNotebook) @@ -202,12 +204,36 @@ term' = tmNotebookTab ^. lensTMNotebookTabTerm . lensTerm relabelTab notebook label scrolledWin term' +-- | Compute the text for a 'Label' for a GTK Notebook tab. +-- +-- >>> computeTabLabel 0 (Just "me@machine:~") +-- "1. me@machine:~" +-- +-- >>> computeTabLabel 5 (Just "bash process") +-- "6. bash process" +-- +-- >>> computeTabLabel 2 Nothing +-- "3. shell" +computeTabLabel + :: Int + -- ^ Tab number. 0 is used for the first tab, 1 for the second, etc. + -> Maybe Text + -- ^ A possible title for a tab. If this is 'Nothing', then the string + -- @shell@ will be used. + -> Text +computeTabLabel pageNum maybeTitle = + let title = fromMaybe "shell" maybeTitle + in tshow (pageNum + 1) <> ". " <> title + +-- | Update the given 'Label' for a GTK Notebook tab. +-- +-- The new text for the label is determined by the 'computeTabLabel' function. relabelTab :: Notebook -> Label -> ScrolledWindow -> Terminal -> IO () relabelTab notebook label scrolledWin term' = do - pageNum <- notebookPageNum notebook scrolledWin + tabNum <- notebookPageNum notebook scrolledWin maybeTitle <- terminalGetWindowTitle term' - let title = fromMaybe "shell" maybeTitle - labelSetLabel label $ tshow (pageNum + 1) <> ". " <> title + let labelText = computeTabLabel (fromIntegral tabNum) maybeTitle + labelSetLabel label labelText showScrollbarToPolicy :: ShowScrollbar -> PolicyType showScrollbarToPolicy ShowScrollbarNever = PolicyTypeNever @@ -217,7 +243,8 @@ createScrolledWin :: TMState -> IO ScrolledWindow createScrolledWin mvarTMState = do tmState <- readMVar mvarTMState - let showScrollbarVal = tmState ^. lensTMStateConfig . lensOptions . lensShowScrollbar + let showScrollbarVal = + tmState ^. lensTMStateConfig . lensOptions . lensShowScrollbar vScrollbarPolicy = showScrollbarToPolicy showScrollbarVal scrolledWin <- scrolledWindowNew noAdjustment noAdjustment widgetShow scrolledWin @@ -286,27 +313,47 @@ #endif #endif +-- | Get the current working directory from the shell in the focused tab of a +-- notebook. +-- +-- Returns 'Nothing' if there is no focused tab of the notebook, or the +-- current working directory could not be detected for the shell. +getCWDFromFocusedTab :: TMNotebook -> IO (Maybe Text) +getCWDFromFocusedTab currNote = do + let maybeFocusedTab = getFocusItemFL (tmNotebookTabs currNote) + case maybeFocusedTab of + Nothing -> pure Nothing + Just focusedNotebookTab -> do + let shellPid = pid (tmNotebookTabTerm focusedNotebookTab) + cwdOfPid shellPid -createTerm :: (TMState -> EventKey -> IO Bool) -> TMState -> IO TMTerm -createTerm handleKeyPress mvarTMState = do - assertInvariantTMState mvarTMState - scrolledWin <- createScrolledWin mvarTMState - TMState{tmStateAppWin, tmStateFontDesc, tmStateConfig, tmStateNotebook=currNote} <- - readMVar mvarTMState - let maybeCurrFocusedTabPid = pid . tmNotebookTabTerm <$> getFocusItemFL (tmNotebookTabs currNote) - maybeCurrDir <- maybe (pure Nothing) cwdOfPid maybeCurrFocusedTabPid +-- | Create the VTE 'Terminal', set the fonts and options +createAndInitVteTerm :: FontDescription -> ConfigOptions -> IO Terminal +createAndInitVteTerm tmStateFontDesc curOpts = do vteTerm <- terminalNew terminalSetFont vteTerm (Just tmStateFontDesc) - let curOpts = options tmStateConfig terminalSetWordCharExceptions vteTerm $ wordCharExceptions curOpts terminalSetScrollbackLines vteTerm (fromIntegral (scrollbackLen curOpts)) terminalSetCursorBlinkMode vteTerm (cursorBlinkMode curOpts) widgetShow vteTerm + pure vteTerm + +-- | Starts a shell in a terminal and return a new TMTerm +launchShell + :: Terminal + -- ^ GTK 'Terminal' to spawn the shell in. + -> Maybe Text + -- ^ An optional path to the current working directory to start the + -- shell in. If 'Nothing', use the current working directory of the + -- termonad process. + -> IO Int +launchShell vteTerm maybeCurrDir = do -- Should probably use GI.Vte.Functions.getUserShell, but contrary to its -- documentation it raises an exception rather wrap in Maybe. mShell <- lookupEnv "SHELL" let argv = fromMaybe ["/usr/bin/env", "bash"] (pure <$> mShell) - terminalProcPid <- + -- Launch the shell + shellPid <- terminalSpawnSync vteTerm [PtyFlagsDefault] @@ -316,28 +363,83 @@ ([SpawnFlagsDefault] :: [SpawnFlags]) Nothing noCancellable - tmTerm <- newTMTerm vteTerm (fromIntegral terminalProcPid) - containerAdd scrolledWin vteTerm - (tabLabelBox, tabLabel, tabCloseButton) <- createNotebookTabLabel - let notebookTab = createTMNotebookTab tabLabel scrolledWin tmTerm - void $ - onButtonClicked tabCloseButton $ - termClose notebookTab mvarTMState - mvarReturnAction <- - modifyMVar mvarTMState $ \tmState -> do + pure (fromIntegral shellPid) + +-- | Add a page to the notebook and switch to it. +addPage + :: TMState + -> 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 + -- Append a new notebook page and update the TMState to reflect this. + (note, pageIndex) <- modifyMVar mvarTMState appendNotebookPage + + -- Switch the current Notebook page to the the newly added page. + notebookSetCurrentPage note pageIndex + where + appendNotebookPage :: TMState' -> IO (TMState', (Notebook, Int32)) + appendNotebookPage tmState = do let notebook = tmStateNotebook tmState note = tmNotebook notebook tabs = tmNotebookTabs notebook + scrolledWin = tmNotebookTabTermContainer notebookTab pageIndex <- notebookAppendPage note scrolledWin (Just tabLabelBox) notebookSetTabReorderable note scrolledWin True setShowTabs (tmState ^. lensTMStateConfig) note let newTabs = appendFL tabs notebookTab newTMState = tmState & lensTMStateNotebook . lensTMNotebookTabs .~ newTabs - mvarReturnAction = notebookSetCurrentPage note pageIndex - pure (newTMState, mvarReturnAction) - mvarReturnAction + pure (newTMState, (note, pageIndex)) + +-- | Set the keyboard focus on a vte terminal +setFocusOn :: ApplicationWindow -> Terminal -> IO() +setFocusOn tmStateAppWin vteTerm = do + widgetGrabFocus vteTerm + windowSetFocus tmStateAppWin (Just vteTerm) + +-- | Create a new 'TMTerm', setting it up and adding it to the GTKNotebook. +createTerm + :: (TMState -> EventKey -> IO Bool) + -- ^ Funtion for handling key presses on the terminal. + -> TMState + -> IO TMTerm +createTerm handleKeyPress mvarTMState = do + -- Check preconditions + assertInvariantTMState mvarTMState + + -- Read needed data in TMVar + TMState{tmStateAppWin, tmStateFontDesc, tmStateConfig, tmStateNotebook=currNote} <- + readMVar mvarTMState + + -- Create a new terminal and launch a shell in it + vteTerm <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig) + maybeCurrDir <- getCWDFromFocusedTab currNote + termShellPid <- launchShell vteTerm maybeCurrDir + tmTerm <- newTMTerm vteTerm termShellPid + + -- Create the container add the VTE term in it + scrolledWin <- createScrolledWin mvarTMState + containerAdd scrolledWin vteTerm + + -- Create the GTK widget for the Notebook tab + (tabLabelBox, tabLabel, tabCloseButton) <- createNotebookTabLabel + + -- Create notebook state + let notebookTab = createTMNotebookTab tabLabel scrolledWin tmTerm + + -- Add the new notebooktab to the notebook. + addPage mvarTMState 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 + -- appropriately. relabelTab (tmNotebook currNote) tabLabel scrolledWin vteTerm + + -- Connect callbacks + void $ onButtonClicked tabCloseButton $ termClose notebookTab mvarTMState void $ onTerminalWindowTitleChanged vteTerm $ do TMState{tmStateNotebook} <- readMVar mvarTMState let notebook = tmNotebook tmStateNotebook @@ -345,8 +447,13 @@ void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState void $ onTerminalChildExited vteTerm $ \_ -> termExit notebookTab mvarTMState - widgetGrabFocus vteTerm - windowSetFocus tmStateAppWin (Just vteTerm) + + -- Put the keyboard focus on the term + setFocusOn tmStateAppWin vteTerm + + -- Make sure the state is still right assertInvariantTMState mvarTMState + + -- Run user-defined hooks for modifying the newly-created VTE Terminal. createTermHook (hooks tmStateConfig) mvarTMState vteTerm pure tmTerm diff --git a/src/Termonad/XML.hs b/src/Termonad/XML.hs --- a/src/Termonad/XML.hs +++ b/src/Termonad/XML.hs @@ -91,6 +91,21 @@ + Search + + _Find... + app.find + + + Find Above + app.findabove + + + Find Below + app.findbelow + + + Help _About diff --git a/termonad.cabal b/termonad.cabal --- a/termonad.cabal +++ b/termonad.cabal @@ -1,5 +1,5 @@ name: termonad -version: 1.3.0.0 +version: 2.0.0.0 synopsis: Terminal emulator configurable in Haskell description: Please see . homepage: https://github.com/cdepillabout/termonad @@ -46,6 +46,7 @@ , Termonad.Gtk , Termonad.Keys , Termonad.Lenses + , Termonad.Pcre , Termonad.Prelude , Termonad.Term , Termonad.Types @@ -70,11 +71,13 @@ , gi-pango , gi-vte >= 2.91.19 , haskell-gi-base >= 0.21.2 + , inline-c , lens , mono-traversable , pretty-simple , QuickCheck , singletons + , text , xml-conduit , xml-html-qq default-language: Haskell2010 @@ -112,7 +115,8 @@ other-extensions: TemplateHaskell , UndecidableInstances pkgconfig-depends: gtk+-3.0 - , vte-2.91 + , libpcre2-8 + , vte-2.91 >= 0.46 executable termonad main-is: Main.hs diff --git a/test/readme/README.lhs b/test/readme/README.lhs --- a/test/readme/README.lhs +++ b/test/readme/README.lhs @@ -226,6 +226,9 @@ |------------|--------| | Ctrl Shift t | Open new tab. | | Ctrl Shift w | Close tab. | +| Ctrl Shift f | Open Find dialog for searching for a regex. | +| Ctrl Shift p | Find the regex **above** the current position. | +| Ctrl Shift i | Find the regex **below** the current position. | | Ctrl + | Increase font size. | | Ctrl - | Decrease font size. | | Alt (number key) | Switch to tab `number`. For example, Alt 2 switches to tab 2. |