From b32900a7d426f06ee1bd2f69d8cf7899034f5470 Mon Sep 17 00:00:00 2001 From: defanor Date: Thu, 21 Dec 2017 09:23:21 +0300 Subject: Retain position on redisplay, reload, etc Based on line numbers that are attached to document blocks, not dependent on window/terminal width. Some bits can still be refined/refactored, but here's the initial support. --- Pancake/Command.hs | 8 +++++++ Pancake/Rendering.hs | 59 ++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 54 insertions(+), 13 deletions(-) (limited to 'Pancake') diff --git a/Pancake/Command.hs b/Pancake/Command.hs index 52ace06..1fd7074 100644 --- a/Pancake/Command.hs +++ b/Pancake/Command.hs @@ -61,6 +61,7 @@ data Command = Quit | Shortcut String String | LoadConfig (Maybe FilePath) | SetWidth (Maybe Int) + | SetPos (Maybe Int) | Redisplay deriving (Show, Eq) @@ -153,6 +154,12 @@ setWidth = string "set width" *> (SetWidth <$> optionMaybe (space *> pNat)) <* eof +-- | 'SetPos' command parser. +setPos :: Parser Command +setPos = string "set position" + *> (SetPos <$> optionMaybe (space *> pNat)) + <* eof + -- | 'LoadConfig' command parser. loadConf :: Parser Command loadConf = string "load config" @@ -171,6 +178,7 @@ command c = , saveCurrent "save current" , save "save" , setWidth "set width" + , setPos "set position" , loadConf "load config" , goTo "follow uri" ]) diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index 6c5a873..778d6f7 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -33,6 +33,7 @@ module Pancake.Rendering ( Denotation(..) , rLinks , rLines , rIdentifiers + , rBlocks , rNotes , renderDoc ) where @@ -91,6 +92,7 @@ data RS = RS { indentationLevel :: Int , listing :: Maybe Listing , columns :: Int , rsConf :: Config + , breadcrumbs :: [Int] } deriving (Show, Eq) -- | This is what gets rendered. @@ -98,6 +100,8 @@ data RendererOutput = RLink URI | RNote [RendererOutput] | RLine StyledLine | RIdentifier String Int + | RBlock [Int] Int Int + -- ^ path, start line, end line deriving (Show, Eq) -- | Show a reference. @@ -122,6 +126,12 @@ rIdentifiers [] = [] rIdentifiers (RIdentifier s i:xs) = (s, i) : rIdentifiers xs rIdentifiers (_:xs) = rIdentifiers xs +-- | Extracts block positions. +rBlocks :: [RendererOutput] -> [([Int], Int, Int)] +rBlocks [] = [] +rBlocks (RBlock p s e:xs) = (p, s, e) : rBlocks xs +rBlocks (_:xs) = rBlocks xs + -- | Extracts notes. rNotes :: [RendererOutput] -> [[RendererOutput]] rNotes [] = [] @@ -149,7 +159,7 @@ runRenderer :: Int -- ^ Collected links and text lines. runRenderer cols ls ns ln cnf r = let o = snd $ evalState (runWriterT r) - (RS 0 ls ns ln Nothing cols cnf) + (RS 0 ls ns ln Nothing cols cnf []) in o ++ concatMap (map RLine . rLines) (rNotes o) -- | Stores a link, increasing the counter. @@ -397,20 +407,25 @@ renderBlock :: P.Block -> Renderer () renderBlock (P.Plain i) = indented =<< readInlines i renderBlock (P.Para i) = indented =<< readInlines i renderBlock (P.LineBlock i) = - indented =<< concat <$> mapM (mapM readInline) i + zipWithM_ (\l n -> withBreadcrumb n $ + (pure . concat <$> mapM readInline l) >>= indented) + i [1..] renderBlock (P.CodeBlock attr s) = do storeAttr attr - indented $ map (pure . Fg Green . fromString) $ lines s + zipWithM_ (\l n -> withBreadcrumb n $ indented [l]) + (map (pure . Fg Green . fromString) $ lines s) [1..] renderBlock (P.RawBlock _ s) = indented $ map (pure . fromString) $ lines s renderBlock (P.BlockQuote bs) = withIndent $ renderBlocks bs renderBlock (P.OrderedList _ bs) = do zipWithM_ (\b n -> modify (\s -> s { listing = Just (Ordered n) }) - >> keepIndent (renderBlocks b)) bs [1..] + >> withBreadcrumb n (keepIndent (renderBlocks b))) + bs [1..] modify $ \s -> s { listing = Nothing } renderBlock (P.BulletList bs) = do - mapM_ (\b -> modify (\s -> s { listing = Just Bulleted }) - >> keepIndent (renderBlocks b)) bs + zipWithM_ (\b n -> modify (\s -> s { listing = Just Bulleted }) + >> withBreadcrumb n (keepIndent (renderBlocks b))) + bs [1..] modify $ \s -> s { listing = Nothing } renderBlock (P.DefinitionList dl) = let renderDefinition (term, definition) = do @@ -441,7 +456,9 @@ renderBlock (P.Table caption aligns widths headers rows) = do else fromIntegral l / fromIntegral (sum lens) * 0.7 + 1 / fromIntegral (length lens) * 0.3) lens let withHead = if all null headers then id else (headers :) - mapM_ (\r -> renderBlock P.HorizontalRule >> tableRow ws r) (withHead rows) + zipWithM_ + (\r n -> withBreadcrumb n (renderBlock P.HorizontalRule >> tableRow ws r)) + (withHead rows) [1..] renderBlock P.HorizontalRule where renderCell :: Int -> [P.Block] -> Renderer [RendererOutput] @@ -509,14 +526,30 @@ skipAfter P.Para {} = True skipAfter (P.Div _ bs@(_:_)) = skipAfter $ last bs skipAfter b = isList b +-- | Stores a block position. +withBreadcrumb :: Int -> Renderer a -> Renderer a +withBreadcrumb n r = do + st <- get + let p = n : breadcrumbs st + lineStart = lineNumber st + modify $ \s -> s { breadcrumbs = p } + ret <- r + modify $ \s -> s { breadcrumbs = breadcrumbs st } + st' <- get + tell [RBlock p lineStart (lineNumber st')] + pure ret + -- | Renders block elements with empty lines between some of them. renderBlocks :: [P.Block] -> Renderer () -renderBlocks [] = pure () -renderBlocks [b] = renderBlock b -renderBlocks (b1:bs@(b2:_)) = do - renderBlock b1 - when (skipAfter b1 || skipBefore b2) $ storeLines [[]] - renderBlocks bs +renderBlocks = renderBlocks' 0 + where + renderBlocks' _ [] = pure () + renderBlocks' n [b] = withBreadcrumb n $ renderBlock b + renderBlocks' n (b1:bs@(b2:_)) = do + withBreadcrumb n $ do + renderBlock b1 + when (skipAfter b1 || skipBefore b2) $ storeLines [[]] + renderBlocks' (n + 1) bs -- | Renders a document. renderDoc :: Int -- cgit v1.2.3