@@ -35,7 +35,7 @@ module Text.Pandoc.Readers.Man where
35import Control.Monad.Except (throwError)
35import Control.Monad.Except (throwError)
36import Data.Default (Default)
36import Data.Default (Default)
37import Data.Map (insert)
37import Data.Map (insert)
38−import Data.Maybe (isJust, maybeToList)
38+import Data.Maybe (isJust, fromMaybe)
39import Data.List (intersperse, intercalate)
39import Data.List (intersperse, intercalate)
40import qualified Data.Text as T
40import qualified Data.Text as T
@@ -109,9 +109,13 @@ parseMacro = do
109 macroName <- many1 (letter <|> oneOf ['\\', '"'])
109 macroName <- many1 (letter <|> oneOf ['\\', '"'])
110 args <- parseArgs
110 args <- parseArgs
111 let joinedArgs = concat $ intersperse " " args
111 let joinedArgs = concat $ intersperse " " args
112+ ManState { rState = rst } <- getState
113+ let toTextF transf = if inCodeBlock rst then [Code nullAttr joinedArgs] else transf [Str joinedArgs]
114+ let toText = return . Plain . toTextF
112− let toBold = return $ Plain [Strong [Str joinedArgs]]
115+ let toBold = toText (\s -> [Strong s])
116+ let toItalic = toText (\s -> [Emph s])
113− let toBoldItalic = return $ Plain [Strong [Emph [Str joinedArgs]]]
117+ let toBoldItalic = toText (\s -> [Strong [Emph s]])
114− let toItalic = return $ Plain [Emph [Str joinedArgs]]
118+
115 case macroName of
119 case macroName of
116 "\\\"" -> return Null -- comment
120 "\\\"" -> return Null -- comment
117 "TH" -> macroTitle (if null args then "" else head args) -- man-title
121 "TH" -> macroTitle (if null args then "" else head args) -- man-title
@@ -120,14 +124,14 @@ parseMacro = do
120 "nf" -> macroCodeBlock True >> return Null
124 "nf" -> macroCodeBlock True >> return Null
121 "fi" -> macroCodeBlock False >> return Null
125 "fi" -> macroCodeBlock False >> return Null
122 "B" -> toBold
126 "B" -> toBold
123− "BR" -> return $ linkToMan joinedArgs
127+ "BR" -> return $ macroBR joinedArgs (inCodeBlock rst)
124 "BI" -> toBoldItalic
128 "BI" -> toBoldItalic
125 "IB" -> toBoldItalic
129 "IB" -> toBoldItalic
126 "I" -> toItalic
130 "I" -> toItalic
127 "IR" -> toItalic
131 "IR" -> toItalic
128 "RI" -> toItalic
132 "RI" -> toItalic
129 "SH" -> return $ Header 2 nullAttr [Str joinedArgs]
133 "SH" -> return $ Header 2 nullAttr [Str joinedArgs]
130− "sp" -> return $ Plain [LineBreak]
134+ "sp" -> return $ if inCodeBlock rst then Null else Plain [LineBreak]
131 _ -> unkownMacro macroName
135 _ -> unkownMacro macroName
@@ -148,10 +152,14 @@ parseMacro = do
148 macroCodeBlock :: PandocMonad m => Bool -> ManParser m ()
152 macroCodeBlock :: PandocMonad m => Bool -> ManParser m ()
149 macroCodeBlock insideCB = modifyRoffState (\rst -> rst{inCodeBlock = insideCB}) >> return ()
153 macroCodeBlock insideCB = modifyRoffState (\rst -> rst{inCodeBlock = insideCB}) >> return ()
155+ macroBR :: String -> Bool -> Block
156+ macroBR txt inCode | inCode = Plain [Code nullAttr txt]
157+ | otherwise = fromMaybe (Plain [Strong [Str txt]]) (linkToMan txt)
151− linkToMan :: String -> Block
159+ linkToMan :: String -> Maybe Block
152 linkToMan txt = case runParser linkParser () "" txt of
160 linkToMan txt = case runParser linkParser () "" txt of
153− Right lnk -> Plain [lnk]
161+ Right lnk -> Just $ Plain [lnk]
154− Left _ -> Plain [Emph [Str txt]]
162+ Left _ -> Nothing
156 linkParser :: Parsec String () Inline
164 linkParser :: Parsec String () Inline
157 linkParser = do
165 linkParser = do
@@ -199,8 +207,8 @@ parseMacro = do
200roffInline :: RoffState -> String -> [Inline]
208roffInline :: RoffState -> String -> [Inline]
201roffInline rst str
209roffInline rst str
202− | null str = []
210+ | null str && (not $ inCodeBlock rst) = []
203− | inCodeBlock rst = [Code nullAttr str, LineBreak]
211+ | inCodeBlock rst = [Code nullAttr str]
204 | otherwise = case fontKind rst of
212 | otherwise = case fontKind rst of
205 Regular -> [Str str]
213 Regular -> [Str str]
206 Italic -> [Emph [Str str]]
214 Italic -> [Emph [Str str]]
@@ -245,19 +253,51 @@ parseLine = do
246 >> return Nothing
254 >> return Nothing
256+finds :: (a -> Bool) -> [a] -> ([a], [a])
257+finds predic els = let matched = finds' els
258+ in (matched, drop (length matched) els) where
260+ finds' (e:es) | predic e = e : finds' es
263+-- | return (matched, notmatched, others)
264+findsBoth :: (a -> Bool) -> [a] -> ([a], [a], [a])
265+findsBoth predic els =
266+ let (matched, els') = finds predic els
267+ (notmatched, els'') = finds (not . predic) els'
268+ in (matched, notmatched, els'')
248createParas :: [Block] -> [Block]
270createParas :: [Block] -> [Block]
249createParas bs = inner bs [] where
271createParas bs = inner bs [] where
250 inner :: [Block] -> [Inline] -> [Block]
272 inner :: [Block] -> [Inline] -> [Block]
251− inner [] inls = maybeToList $ inlinesToPara inls
273+ inner [] inls = plainInlinesToPara inls
252− inner (Plain einls : oth) inls = inner oth (inls ++ einls)
274+ inner (Plain einls : oth) inls = inner oth (inls ++ joinCode einls)
253− inner (block : oth) inls = case inlinesToPara inls of
275+ inner (block : oth) inls = (plainInlinesToPara inls ++ [block]) ++ inner oth []
254− Just par -> par : block : inner oth []
276+
255− Nothing -> block : inner oth []
277+ joinCode :: [Inline] -> [Inline]
257− inlinesToPara :: [Inline] -> Maybe Block
279+ let (codes, notcodes) = finds isCode inls
258− inlinesToPara [] = Nothing
280+ codeStr (Code _ s) = s
282+ joined = Code nullAttr (concat $ codeStr <$> codes)
285+ else joined : notcodes
287+ plainInlinesToPara :: [Inline] -> [Block]
288+ plainInlinesToPara [] = []
289+ plainInlinesToPara inls =
290+ let (cds, ncds, oth) = findsBoth isCode inls
291+ codeToStr (Code _ s) = s
295+ else [CodeBlock nullAttr (intercalate "\n" $ codeToStr <$> cds)]
259− inlinesToPara inls = Just $ Para (intersperse (Str " ") inls)
296+ paras = [Para (intersperse (Str " ") ncds)]
260−
297+ in cbs ++ paras ++ plainInlinesToPara oth
299+ isCode (Code _ _) = True
262parseMan :: PandocMonad m => ManParser m Pandoc
302parseMan :: PandocMonad m => ManParser m Pandoc
263parseMan = do
303parseMan = do