From 8c4f75fe2d30578a2e7073e760c94c98200cba45 Mon Sep 17 00:00:00 2001 From: defanor Date: Fri, 22 Dec 2017 05:57:17 +0300 Subject: Partially delegate line wrapping to Emacs Not for tables or lists, but for regular text lines. Using visual-line-mode for that by default. --- Pancake.hs | 25 ++++++++++++++++++++----- Pancake/Rendering.hs | 40 +++++++++++++++++++++++++++------------- pancake.1 | 4 ++++ pancake.el | 5 +++-- 4 files changed, 54 insertions(+), 20 deletions(-) diff --git a/Pancake.hs b/Pancake.hs index 1a74be8..4b2fd7e 100644 --- a/Pancake.hs +++ b/Pancake.hs @@ -78,6 +78,7 @@ data LoopState = LS { history :: Sliding HistoryEntry , rendered :: [RendererOutput] , conf :: Config , embedded :: Bool + , noWrap :: Bool , interrupted :: Bool , unclutterRegexps :: [(Regex, String)] , columns :: Maybe Int @@ -89,7 +90,7 @@ printDoc uri doc = do term <- liftIO setupTermFromEnv st <- get let cols = fromMaybe 80 $ columns st <|> getCapability term termColumns - l = renderDoc cols (conf st) doc + l = renderDoc cols (noWrap st) (conf st) doc textLines = rLines l modify (\s -> s { rendered = l }) if embedded st @@ -192,8 +193,7 @@ lineToBlockNumber :: [(Int, Int)] -> Int -> Int lineToBlockNumber bs n = case filter (\(_, (f, l)) -> f <= n && n < l) (zip [0..] bs) of [] -> 0 - xs -> (\(p, _) -> p) $ - maximumBy (\(_, (l, _)) (_, (l', _)) -> compare l l') xs + xs -> fst $ maximumBy (\(_, (l, _)) (_, (l', _)) -> compare l l') xs -- | Fixed block's number to line number. blockNumberToLine :: [(Int, Int)] -> Int -> Int @@ -390,7 +390,11 @@ eventLoop = do handleAsync other = throw other -- | Command-line options. -data Option = OVersion | OHelp | OEmbedded | OConfig FilePath +data Option = OVersion + | OHelp + | OEmbedded + | ONoWrap + | OConfig FilePath deriving (Show, Eq) -- | Command-line option descriptions for 'getOpt'. @@ -400,6 +404,8 @@ options = [ Option [] ["version"] (NoArg OVersion) , Option [] ["help"] (NoArg OHelp) "show help message and exit" , Option ['e'] ["embedded"] (NoArg OEmbedded) "run in the embedded mode" + , Option ['n'] ["no-wrap"] (NoArg ONoWrap) + "leave line wrapping to UI when appropriate" , Option ['c'] ["config"] (ReqArg OConfig "FILE") "load configuration from a specified file" ] @@ -427,7 +433,16 @@ main = do >>= \st -> command (parseCommand (conf st) (unwords cmd)) _ <- runStateT (updateConfig (findConf opts) >> maybeCommand >> eventLoop) - (LS ([],[]) 0 [] def (OEmbedded `elem` opts) False [] Nothing) + LS { history = ([],[]) + , position = 0 + , rendered = [] + , conf = def + , embedded = OEmbedded `elem` opts + , noWrap = ONoWrap `elem` opts + , interrupted = False + , unclutterRegexps = [] + , columns = Nothing + } pure () run where diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index 06181e3..6be2c74 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -48,6 +48,7 @@ import Control.Monad.State import System.FilePath import Data.Char import Numeric +import Data.Maybe import Pancake.Configuration @@ -91,6 +92,7 @@ data RS = RS { indentationLevel :: Int , lineNumber :: Int , listing :: Maybe Listing , columns :: Int + , noWrap :: Bool , rsConf :: Config } deriving (Show, Eq) @@ -151,6 +153,8 @@ type Renderer a = WriterT [RendererOutput] (State RS) a -- | Runs a 'Renderer'. runRenderer :: Int -- ^ Column count (line width). + -> Bool + -- ^ Leave line wrapping to UI. -> Int -- ^ Link number to start with. -> Int @@ -163,9 +167,17 @@ runRenderer :: Int -- ^ A renderer. -> [RendererOutput] -- ^ Collected links and text lines. -runRenderer cols ls ns ln cnf r = +runRenderer cols llw ls ns ln cnf r = let o = snd $ evalState (runWriterT r) - (RS 0 ls ns ln Nothing cols cnf) + RS { indentationLevel = 0 + , linkCount = ls + , noteCount = ns + , lineNumber = ln + , listing = Nothing + , columns = cols + , noWrap = llw + , rsConf = cnf + } in o ++ concatMap (map RLine . rLines) (rNotes o) -- | Stores a link, increasing the counter. @@ -234,7 +246,9 @@ indented slines = do (Just (Ordered n)) -> Fg Yellow $ fromString $ show n ++ ". " prefixLen = length $ unstyled [prefix] indent = il + prefixLen - fittedLines = fitLines (columns st - indent) slines + fittedLines = if noWrap st && isNothing (listing st) + then slines + else fitLines (columns st - indent) slines pad = (fromString (replicate indent ' ') :) padFirst x = fromString (replicate il ' ') : prefix : x -- The following blocks of the same list item should be indented @@ -396,7 +410,7 @@ readInline (P.Note bs) = do st <- get -- 12 is somewhat arbitrary, but narrowing the rendered notes so -- that "^{note xxx}" could be added without overflow. - let ro = runRenderer (columns st - 12) (linkCount st) (noteCount st) 0 + let ro = runRenderer (columns st - 12) (noWrap st) (linkCount st) (noteCount st) 0 (rsConf st) (renderBlocks bs) cnt <- storeNote ro pure [Superscript . Fg Red . fromString $ "[" ++ show cnt ++ "]"] @@ -432,8 +446,8 @@ renderBlock (P.LineBlock i) = i renderBlock (P.CodeBlock attr s) = do storeAttr attr - mapM_ (fixed . indented . pure) - (map (pure . Fg Green . fromString) $ lines s) + mapM_ (fixed . indented . pure . pure . Fg Green . fromString) + (lines s) renderBlock (P.RawBlock _ s) = indented $ map (pure . fromString) $ lines s renderBlock (P.BlockQuote bs) = withIndent $ renderBlocks bs @@ -476,17 +490,15 @@ 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 -> (fixed (renderBlock P.HorizontalRule) - >> fixed (tableRow ws r))) + mapM_ (\r -> fixed (renderBlock P.HorizontalRule) >> fixed (tableRow ws r)) (withHead rows) fixed $ renderBlock P.HorizontalRule where renderCell :: Int -> [P.Block] -> Renderer [RendererOutput] renderCell w blocks = do st <- get - pure $ runRenderer w (linkCount st) (noteCount st) (lineNumber st) - (rsConf st) $ renderBlocks blocks + pure $ runRenderer w False (linkCount st) (noteCount st) + (lineNumber st) (rsConf st) $ renderBlocks blocks tableCell :: (P.Alignment, Int, [P.Block]) -> Renderer [StyledLine] tableCell (a, w, blocks) = do l <- renderCell w blocks @@ -569,11 +581,13 @@ renderBlocks (b1:bs@(b2:_)) = do -- | Renders a document. renderDoc :: Int -- ^ Number of columns. + -> Bool + -- ^ Leave line wrapping to UI. -> Config -- ^ Configuration. -> P.Pandoc -- ^ Document to render. -> [RendererOutput] -- ^ Rendered document. -renderDoc cols cnf (P.Pandoc _ blocks) = - runRenderer cols 0 0 1 cnf $ renderBlocks blocks +renderDoc cols llw cnf (P.Pandoc _ blocks) = + runRenderer cols llw 0 0 1 cnf $ renderBlocks blocks diff --git a/pancake.1 b/pancake.1 index 764b104..582c2ff 100644 --- a/pancake.1 +++ b/pancake.1 @@ -23,6 +23,10 @@ Print version and exit. Print a help message. .IP "\fB\-e, \-\-embedded\fR" Run in the embedded mode. +.IP "\fB\-n, \-\-no-wrap\fR" +Leave line wrapping to UI when appropriate: still wrap table cells and +lists, but not regular paragraphs and other basic text lines which can +be wrapped properly by a generic UI. .IP "\fB\-c \fIFILE\fB, \-\-config=\fIFILE\fB\fR" Load configuration from a specified file. diff --git a/pancake.el b/pancake.el index 85fcd94..e41a822 100644 --- a/pancake.el +++ b/pancake.el @@ -101,7 +101,7 @@ "A strike-through face." :group 'pancake) -(defcustom pancake-command '("pancake" "--embedded") +(defcustom pancake-command '("pancake" "--embedded" "--no-wrap") "A command that runs pancake, along with its arguments" :type '(list string) :group 'pancake) @@ -508,7 +508,8 @@ it to `pancake-process' as input." "Keymap for `pancake-mode'.") (define-derived-mode pancake-mode nil "Pancake" - "A basic emacs interface to the pancake browser.") + "A basic emacs interface to the pancake browser." + (visual-line-mode)) (provide 'pancake) -- cgit v1.2.3