summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-22 05:57:17 +0300
committerdefanor <defanor@uberspace.net>2017-12-22 05:57:17 +0300
commit8c4f75fe2d30578a2e7073e760c94c98200cba45 (patch)
tree065beb327fae1d707a95e03bcba0b3be33ec37ed
parent8b97635c41c998e6190f89c9883b2dcac5d8df09 (diff)
Partially delegate line wrapping to Emacs
Not for tables or lists, but for regular text lines. Using visual-line-mode for that by default.
-rw-r--r--Pancake.hs25
-rw-r--r--Pancake/Rendering.hs40
-rw-r--r--pancake.14
-rw-r--r--pancake.el5
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)