Skip to content

Commit

Permalink
ODT/opendocument writers: properly handle highlighting styles.
Browse files Browse the repository at this point in the history
These styles were going into an office:styles element in content.xml,
but this is invalid.  Instead they must go in styles.xml. See #9287.

The variable `highlighting-styles` no longer has any effect on
the default opendocument template, and highlighting styles are
not included in opendocument output.
  • Loading branch information
jgm committed Dec 27, 2023
1 parent 3c17869 commit b1a1f04
Show file tree
Hide file tree
Showing 6 changed files with 80 additions and 329 deletions.
3 changes: 0 additions & 3 deletions data/templates/default.opendocument
Expand Up @@ -3,9 +3,6 @@
<office:font-face-decls>
<style:font-face style:name="Courier New" style:font-family-generic="modern" style:font-pitch="fixed" svg:font-family="'Courier New'" />
</office:font-face-decls>
<office:styles>
$highlighting-styles$
</office:styles>
<office:automatic-styles>
$automatic-styles$
</office:automatic-styles>
Expand Down
94 changes: 78 additions & 16 deletions src/Text/Pandoc/Writers/ODT.hs
Expand Up @@ -48,6 +48,8 @@ import Text.Pandoc.XML.Light
import Text.TeXMath
import qualified Text.XML.Light as XL
import Network.URI (parseRelativeReference, URI(uriPath))
import Control.Monad (MonadPlus(mplus))
import Skylighting

newtype ODTState = ODTState { stEntries :: [Entry]
}
Expand Down Expand Up @@ -187,29 +189,56 @@ pandocToODT opts doc@(Pandoc meta _) = do
-- make sure mimetype is first
let mimetypeEntry = toEntry "mimetype" epochtime
$ fromStringLazy "application/vnd.oasis.opendocument.text"
archive'' <- updateStyleWithLang lang
archive'' <- updateStyle opts lang
$ addEntryToArchive mimetypeEntry
$ addEntryToArchive metaEntry archive'
return $ fromArchive archive''

updateStyleWithLang :: PandocMonad m => Maybe Lang -> Archive -> O m Archive
updateStyleWithLang Nothing arch = return arch
updateStyleWithLang (Just lang) arch = do
updateStyle :: forall m . PandocMonad m
=> WriterOptions -> Maybe Lang -> Archive -> O m Archive
updateStyle opts mbLang arch = do
epochtime <- floor `fmap` lift P.getPOSIXTime
entries <- mapM (\e -> if eRelativePath e == "styles.xml"
then case parseXMLElement
(toTextLazy (fromEntry e)) of
Left msg -> throwError $
PandocXMLError "styles.xml" msg
Right d -> return $
toEntry "styles.xml" epochtime
( fromTextLazy
. TL.fromStrict
. ppTopElement
. addLang lang $ d )
else return e) (zEntries arch)
let goEntry :: Entry -> O m Entry
goEntry e
| eRelativePath e == "styles.xml"
= case parseXMLElement (toTextLazy (fromEntry e)) of
Left msg -> throwError $ PandocXMLError "styles.xml" msg
Right d -> return $
toEntry "styles.xml" epochtime
( fromTextLazy
. TL.fromStrict
. showTopElement
. maybe id addLang mbLang
. transformElement (\qn -> qName qn == "styles" &&
qPrefix qn == Just "office" )
(maybe id addHlStyles (writerHighlightStyle opts))
$ d )
| otherwise = pure e
entries <- mapM goEntry (zEntries arch)
return arch{ zEntries = entries }

addHlStyles :: Style -> Element -> Element
addHlStyles sty el =
el{ elContent = filter (not . isHlStyle) (elContent el) ++
styleToOpenDocument sty }
where
isHlStyle (Elem e) = "Tok" `T.isSuffixOf` (qName (elName e))
isHlStyle _ = False

-- top-down search
transformElement :: (QName -> Bool)
-> (Element -> Element)
-> Element
-> Element
transformElement g f el
| g (elName el)
= f el
| otherwise
= el{ elContent = map go (elContent el) }
where
go (Elem e) = Elem (transformElement g f e)
go x = x

-- TODO FIXME avoid this generic traversal!
addLang :: Lang -> Element -> Element
addLang lang = everywhere' (mkT updateLangAttr)
Expand Down Expand Up @@ -304,3 +333,36 @@ documentSettings isTextMode = fromStringLazy $ render Nothing
inTags False "config:config-item" [("config:name", "IsTextMode")
,("config:type", "boolean")] $
text $ if isTextMode then "true" else "false")

styleToOpenDocument :: Style -> [Content]
styleToOpenDocument style = map (Elem . toStyle) alltoktypes
where alltoktypes = enumFromTo KeywordTok NormalTok
styleName x =
case T.break (== ':') x of
(b, a) | T.null a -> QName x Nothing (Just "style")
| otherwise -> QName (T.drop 1 a) Nothing (Just b)
styleAttr (x, y) = Attr (styleName x) y
styleAttrs = map styleAttr
styleElement x attrs cs =
Element (styleName x) (styleAttrs attrs) cs Nothing
toStyle toktype =
styleElement "style"
[("name", tshow toktype), ("family", "text")]
[Elem (styleElement "text-properties"
(tokColor toktype ++ tokBgColor toktype ++
[("fo:font-style", "italic") |
tokFeature tokenItalic toktype ] ++
[("fo:font-weight", "bold") |
tokFeature tokenBold toktype ] ++
[("style:text-underline-style", "solid") |
tokFeature tokenUnderline toktype ])
[])]
tokStyles = tokenStyles style
tokFeature f toktype = maybe False f $ Map.lookup toktype tokStyles
tokColor toktype =
maybe [] (\c -> [("fo:color", T.pack (fromColor c))])
((tokenColor =<< Map.lookup toktype tokStyles)
`mplus` defaultColor style)
tokBgColor toktype =
maybe [] (\c -> [("fo:background-color", T.pack (fromColor c))])
(tokenBackground =<< Map.lookup toktype tokStyles)
27 changes: 2 additions & 25 deletions src/Text/Pandoc/Writers/OpenDocument.hs
Expand Up @@ -15,7 +15,7 @@ Conversion of 'Pandoc' documents to OpenDocument XML.
-}
module Text.Pandoc.Writers.OpenDocument ( writeOpenDocument ) where
import Control.Arrow ((***), (>>>))
import Control.Monad (unless, liftM, MonadPlus(mplus))
import Control.Monad (unless, liftM)
import Control.Monad.State.Strict ( StateT(..), modify, gets, lift )
import Data.Char (chr)
import Data.Foldable (find)
Expand Down Expand Up @@ -44,8 +44,7 @@ import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import Text.Pandoc.XML
import Text.Printf (printf)
import Text.Pandoc.Highlighting (highlight)
import Skylighting
import qualified Data.Map as M
import Skylighting (FormatOptions(..), SourceLine, Token)

-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
Expand Down Expand Up @@ -268,11 +267,9 @@ writeOpenDocument opts (Pandoc meta blocks) = do
[("style:name", "L" <> tshow n)] (vcat l)
let listStyles = map listStyle (stListStyles s)
let automaticStyles = vcat $ reverse $ styles ++ listStyles
let highlightingStyles = maybe mempty styleToOpenDocument (writerHighlightStyle opts)
let context = defField "body" body
. defField "toc" (writerTableOfContents opts)
. defField "toc-depth" (tshow $ writerTOCDepth opts)
. defField "highlighting-styles" highlightingStyles
. defField "automatic-styles" automaticStyles
$ metadata
return $ render colwidth $
Expand Down Expand Up @@ -923,23 +920,3 @@ withLangFromAttr (_,_,kvs) action =
report $ InvalidLang l
action

styleToOpenDocument :: Style -> Doc Text
styleToOpenDocument style = vcat (map toStyle alltoktypes)
where alltoktypes = enumFromTo KeywordTok NormalTok
toStyle toktype = inTags True "style:style" [("style:name", tshow toktype),
("style:family", "text")] $
selfClosingTag "style:text-properties"
(tokColor toktype ++ tokBgColor toktype ++
[("fo:font-style", "italic") |
tokFeature tokenItalic toktype ] ++
[("fo:font-weight", "bold") |
tokFeature tokenBold toktype ] ++
[("style:text-underline-style", "solid") |
tokFeature tokenUnderline toktype ])
tokStyles = tokenStyles style
tokFeature f toktype = maybe False f $ M.lookup toktype tokStyles
tokColor toktype = maybe [] (\c -> [("fo:color", T.pack (fromColor c))])
$ (tokenColor =<< M.lookup toktype tokStyles)
`mplus` defaultColor style
tokBgColor toktype = maybe [] (\c -> [("fo:background-color", T.pack (fromColor c))])
$ (tokenBackground =<< M.lookup toktype tokStyles)
95 changes: 0 additions & 95 deletions test/command/6792.md
Expand Up @@ -21,101 +21,6 @@
<office:font-face-decls>
<style:font-face style:name="Courier New" style:font-family-generic="modern" style:font-pitch="fixed" svg:font-family="'Courier New'" />
</office:font-face-decls>
<office:styles>
<style:style style:name="KeywordTok" style:family="text">
<style:text-properties fo:color="#007020" fo:font-weight="bold" />
</style:style>
<style:style style:name="DataTypeTok" style:family="text">
<style:text-properties fo:color="#902000" />
</style:style>
<style:style style:name="DecValTok" style:family="text">
<style:text-properties fo:color="#40a070" />
</style:style>
<style:style style:name="BaseNTok" style:family="text">
<style:text-properties fo:color="#40a070" />
</style:style>
<style:style style:name="FloatTok" style:family="text">
<style:text-properties fo:color="#40a070" />
</style:style>
<style:style style:name="ConstantTok" style:family="text">
<style:text-properties fo:color="#880000" />
</style:style>
<style:style style:name="CharTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="SpecialCharTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="StringTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="VerbatimStringTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="SpecialStringTok" style:family="text">
<style:text-properties fo:color="#bb6688" />
</style:style>
<style:style style:name="ImportTok" style:family="text">
<style:text-properties fo:color="#008000" fo:font-weight="bold" />
</style:style>
<style:style style:name="CommentTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" />
</style:style>
<style:style style:name="DocumentationTok" style:family="text">
<style:text-properties fo:color="#ba2121" fo:font-style="italic" />
</style:style>
<style:style style:name="AnnotationTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="CommentVarTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="OtherTok" style:family="text">
<style:text-properties fo:color="#007020" />
</style:style>
<style:style style:name="FunctionTok" style:family="text">
<style:text-properties fo:color="#06287e" />
</style:style>
<style:style style:name="VariableTok" style:family="text">
<style:text-properties fo:color="#19177c" />
</style:style>
<style:style style:name="ControlFlowTok" style:family="text">
<style:text-properties fo:color="#007020" fo:font-weight="bold" />
</style:style>
<style:style style:name="OperatorTok" style:family="text">
<style:text-properties fo:color="#666666" />
</style:style>
<style:style style:name="BuiltInTok" style:family="text">
<style:text-properties fo:color="#008000" />
</style:style>
<style:style style:name="ExtensionTok" style:family="text">
<style:text-properties />
</style:style>
<style:style style:name="PreprocessorTok" style:family="text">
<style:text-properties fo:color="#bc7a00" />
</style:style>
<style:style style:name="AttributeTok" style:family="text">
<style:text-properties fo:color="#7d9029" />
</style:style>
<style:style style:name="RegionMarkerTok" style:family="text">
<style:text-properties />
</style:style>
<style:style style:name="InformationTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="WarningTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="AlertTok" style:family="text">
<style:text-properties fo:color="#ff0000" fo:font-weight="bold" />
</style:style>
<style:style style:name="ErrorTok" style:family="text">
<style:text-properties fo:color="#ff0000" fo:font-weight="bold" />
</style:style>
<style:style style:name="NormalTok" style:family="text">
<style:text-properties />
</style:style>
</office:styles>
<office:automatic-styles>
<style:style style:name="fr2" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" style:wrap="none" /></style:style>
<style:style style:name="fr1" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" /></style:style>
Expand Down
95 changes: 0 additions & 95 deletions test/command/8256.md
Expand Up @@ -15,101 +15,6 @@ Testing.
<office:font-face-decls>
<style:font-face style:name="Courier New" style:font-family-generic="modern" style:font-pitch="fixed" svg:font-family="'Courier New'" />
</office:font-face-decls>
<office:styles>
<style:style style:name="KeywordTok" style:family="text">
<style:text-properties fo:color="#007020" fo:font-weight="bold" />
</style:style>
<style:style style:name="DataTypeTok" style:family="text">
<style:text-properties fo:color="#902000" />
</style:style>
<style:style style:name="DecValTok" style:family="text">
<style:text-properties fo:color="#40a070" />
</style:style>
<style:style style:name="BaseNTok" style:family="text">
<style:text-properties fo:color="#40a070" />
</style:style>
<style:style style:name="FloatTok" style:family="text">
<style:text-properties fo:color="#40a070" />
</style:style>
<style:style style:name="ConstantTok" style:family="text">
<style:text-properties fo:color="#880000" />
</style:style>
<style:style style:name="CharTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="SpecialCharTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="StringTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="VerbatimStringTok" style:family="text">
<style:text-properties fo:color="#4070a0" />
</style:style>
<style:style style:name="SpecialStringTok" style:family="text">
<style:text-properties fo:color="#bb6688" />
</style:style>
<style:style style:name="ImportTok" style:family="text">
<style:text-properties fo:color="#008000" fo:font-weight="bold" />
</style:style>
<style:style style:name="CommentTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" />
</style:style>
<style:style style:name="DocumentationTok" style:family="text">
<style:text-properties fo:color="#ba2121" fo:font-style="italic" />
</style:style>
<style:style style:name="AnnotationTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="CommentVarTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="OtherTok" style:family="text">
<style:text-properties fo:color="#007020" />
</style:style>
<style:style style:name="FunctionTok" style:family="text">
<style:text-properties fo:color="#06287e" />
</style:style>
<style:style style:name="VariableTok" style:family="text">
<style:text-properties fo:color="#19177c" />
</style:style>
<style:style style:name="ControlFlowTok" style:family="text">
<style:text-properties fo:color="#007020" fo:font-weight="bold" />
</style:style>
<style:style style:name="OperatorTok" style:family="text">
<style:text-properties fo:color="#666666" />
</style:style>
<style:style style:name="BuiltInTok" style:family="text">
<style:text-properties fo:color="#008000" />
</style:style>
<style:style style:name="ExtensionTok" style:family="text">
<style:text-properties />
</style:style>
<style:style style:name="PreprocessorTok" style:family="text">
<style:text-properties fo:color="#bc7a00" />
</style:style>
<style:style style:name="AttributeTok" style:family="text">
<style:text-properties fo:color="#7d9029" />
</style:style>
<style:style style:name="RegionMarkerTok" style:family="text">
<style:text-properties />
</style:style>
<style:style style:name="InformationTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="WarningTok" style:family="text">
<style:text-properties fo:color="#60a0b0" fo:font-style="italic" fo:font-weight="bold" />
</style:style>
<style:style style:name="AlertTok" style:family="text">
<style:text-properties fo:color="#ff0000" fo:font-weight="bold" />
</style:style>
<style:style style:name="ErrorTok" style:family="text">
<style:text-properties fo:color="#ff0000" fo:font-weight="bold" />
</style:style>
<style:style style:name="NormalTok" style:family="text">
<style:text-properties />
</style:style>
</office:styles>
<office:automatic-styles>
<style:style style:name="T1" style:family="text"><style:text-properties fo:font-style="italic" style:font-style-asian="italic" style:font-style-complex="italic" /></style:style>
<style:style style:name="fr2" style:family="graphic" style:parent-style-name="Formula"><style:graphic-properties style:vertical-pos="middle" style:vertical-rel="text" style:horizontal-pos="center" style:horizontal-rel="paragraph-content" style:wrap="none" /></style:style>
Expand Down

0 comments on commit b1a1f04

Please sign in to comment.