From b92e0e74ddd15520adbf58529e07b51c76d348b1 Mon Sep 17 00:00:00 2001
From: mbays <mbays@sdf.org>
Date: Mon, 6 Jun 2022 00:00:00 +0000
Subject: [PATCH] add pager titles

---
 Pager.hs  |  6 ++++--
 diohsc.hs | 24 +++++++++++++-----------
 2 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/Pager.hs b/Pager.hs
index 9bf8a33..7fcc4d7 100644
--- a/Pager.hs
+++ b/Pager.hs
@@ -26,8 +26,8 @@ import qualified Data.Text.Lazy.IO      as T
 import           ANSIColour
 import           Prompt
 
-printLinesPaged :: MonadIO m => Int -> Int -> Int -> (String -> m ()) -> [T.Text] -> m ()
-printLinesPaged wrapCol termWidth perpage doCmd
+printLinesPaged :: MonadIO m => Int -> Int -> Int -> (String -> m ()) -> String -> [T.Text] -> m ()
+printLinesPaged wrapCol termWidth perpage doCmd title
     | perpage <= 0 = \_ -> pure ()
     | otherwise = printLinesPaged' perpage Nothing
     where
@@ -55,5 +55,7 @@ printLinesPaged wrapCol termWidth perpage doCmd
                 liftIO (promptLine "> ") >>= \case
                     Just (Just cmd) -> doCmd cmd
                     _               -> pure ()
+                liftIO . putStrLn $ "-+- " <> title <> " -+-"
                 printLinesPaged' 0 Nothing ls
+            Just '\f' -> printLinesPaged' 0 Nothing ls
             _ -> printLinesPaged' perpage Nothing ls
diff --git a/diohsc.hs b/diohsc.hs
index cfb1ac4..c12b7d9 100644
--- a/diohsc.hs
+++ b/diohsc.hs
@@ -703,14 +703,14 @@ handleCommandLine
     matchPatternOn :: (a -> String) -> String -> a -> Bool
     matchPatternOn f patt = matchPattern patt . f
 
-    doPage :: [T.Text] -> ClientM ()
-    doPage ls
+    doPage :: String -> [T.Text] -> ClientM ()
+    doPage title ls
         | interactive = do
             (height,width) <- liftIO getTermSize
             let pageWidth = min maxWrapWidth (width - 4)
             let perPage = height - min 3 (height `div` 4)
             doCmd <- gets doSubCommand
-            printLinesPaged pageWidth width perPage doCmd ls
+            printLinesPaged pageWidth width perPage doCmd title ls
         | otherwise = liftIO $ mapM_ T.putStrLn ls
 
     parseQueueSpec :: [CommandArg] -> Maybe (String, Maybe Int)
@@ -737,9 +737,9 @@ handleCommandLine
     handleCommand _ (c,_) | restrictedMode && notElem c (commands True) =
         printErr "Command disabled in restricted mode"
     handleCommand [] ("help", args) = case args of
-        []                 -> doPage . map (T.pack . expand) $ helpText
-        CommandArg s _ : _ -> doPage . map (T.pack . expand) $ helpOn s
-    handleCommand [] ("commands",_) = doPage $ T.pack . expand <$> commandHelpText
+        []                 -> doPage "help" . map (T.pack . expand) $ helpText
+        CommandArg s _ : _ -> doPage ("help" <> s) . map (T.pack . expand) $ helpOn s
+    handleCommand [] ("commands",_) = doPage "commands" $ T.pack . expand <$> commandHelpText
         where
         commandHelpText = ["Aliases:"] ++ (showAlias <$> aliases) ++
             ["","Commands:"] ++ (('{' :) . (<> "}") <$> commands False)
@@ -751,7 +751,7 @@ handleCommandLine
                 in T.pack $ "'" <> m' <>
                     replicate (max 1 $ 16 - visibleLength (T.pack m')) ' ' <>
                     showUriWithId uriId
-        in doPage $ markLine <$> ms
+        in doPage "marks" $ markLine <$> ms
     handleCommand [] ("inventory",_) = do
         ais <- gets clientActiveIdentities
         let showNumberedUri :: Bool -> T.Text -> (Int,URI) -> T.Text
@@ -768,7 +768,7 @@ handleCommandLine
                 showNumberedUri True s (n, historyUri item) <> " {fetched}"
             showJumpBack :: [T.Text]
             showJumpBack = maybeToList $ ("'' " <>) . showUriFull ansi ais Nothing . historyUri <$> jumpBack
-        doPage . intercalate [""] . filter (not . null) $
+        doPage "inventory" . intercalate [""] . filter (not . null) $
             showJumpBack :
             [ showIteratedQueueItem (T.pack $ qname <> "~") <$> zip [1..] queue
                 | (qname, queue) <- M.toList queues ]
@@ -780,7 +780,7 @@ handleCommandLine
             ]
     handleCommand [] ("log",_) =
         let showLog (n,t) = "$" <> T.pack (show n) <> " " <> colour Yellow t
-        in doPage $ showLog <$> zip [(1::Int)..] (BStack.toList cLog)
+        in doPage "log" $ showLog <$> zip [(1::Int)..] (BStack.toList cLog)
     handleCommand [] ("alias", CommandArg a _ : CommandArg _ str : _) = void . runMaybeT $ do
         c <- either ((>>mzero) . printErr) return $ parseCommand a
         when (c /= a) $ printErr ("Bad alias: " <> a) >> mzero
@@ -977,7 +977,9 @@ handleCommandLine
     actionOfCommand :: (String, [CommandArg]) -> Maybe CommandAction
     actionOfCommand (c,_) | restrictedMode && notElem c (commands True) = Nothing
     actionOfCommand ("show",_) = Just . actionOnRendered ansi $ liftIO . mapM_ T.putStrLn
-    actionOfCommand ("page",_) = Just $ actionOnRendered ansi doPage
+    actionOfCommand ("page",_) = Just $ \item -> do
+        ais <- gets clientActiveIdentities
+        actionOnRendered ansi (doPage . showUriFull ansi ais Nothing $ historyUri item) item
     actionOfCommand ("links",_) = Just $ \item -> do
         ais <- gets clientActiveIdentities
         let cl = childLink =<< historyChild item
@@ -987,7 +989,7 @@ handleCommandLine
                     <> showUriRefFull ansi ais (historyUri item) uri
                     <> if T.null desc then "" else " " <>
                         applyIf ansi (withColourStr Cyan) desc
-        doPage . zipWith linkLine [1..] . extractLinksMimed . historyGeminatedMimedData $ item
+        doPage "links" . zipWith linkLine [1..] . extractLinksMimed . historyGeminatedMimedData $ item
 
     actionOfCommand ("mark", CommandArg mark _ : _) |
         Just n <- readMay mark :: Maybe Int = Just $ \item -> do
-- 
2.11.4.GIT