[ODT Parser] Include list's starting value

Previously the starting value of the lists' items has been
hardcoded to 1. In reality ODT's list style definition can
provide a new starting value in one of its attributes.

Writers already handle the modified start value so no need
to change anything in that area.
This commit is contained in:
Hubert Plociniczak 2016-10-05 13:14:05 +02:00
parent cbeb72d06b
commit edc951ee7d
2 changed files with 20 additions and 13 deletions

View file

@ -386,7 +386,7 @@ getListConstructor ListLevelStyle{..} =
LltNumbered -> let listNumberStyle = toListNumberStyle listItemFormat
listNumberDelim = toListNumberDelim listItemPrefix
listItemSuffix
in orderedListWith (1, listNumberStyle, listNumberDelim)
in orderedListWith (listItemStart, listNumberStyle, listNumberDelim)
where
toListNumberStyle LinfNone = DefaultStyle
toListNumberStyle LinfNumber = Decimal

View file

@ -76,8 +76,9 @@ import Control.Applicative hiding ( liftA, liftA2, liftA3 )
import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List ( unfoldr )
import Data.Char ( isDigit )
import Data.Default
import Data.List ( unfoldr )
import Data.Maybe
import qualified Text.XML.Light as XML
@ -390,6 +391,7 @@ data ListLevelStyle = ListLevelStyle { listLevelType :: ListLevelType
, listItemPrefix :: Maybe String
, listItemSuffix :: Maybe String
, listItemFormat :: ListItemNumberFormat
, listItemStart :: Int
}
deriving ( Eq, Ord )
@ -578,25 +580,30 @@ readListLevelStyles namespace elementName levelType =
readListLevelStyle :: ListLevelType -> StyleReader _x (Int, ListLevelStyle)
readListLevelStyle levelType = readAttr NsText "level"
>>?! keepingTheValue
( liftA4 toListLevelStyle
( liftA5 toListLevelStyle
( returnV levelType )
( findAttr' NsStyle "num-prefix" )
( findAttr' NsStyle "num-suffix" )
( getAttr NsStyle "num-format" )
( findAttr' NsText "start-value" )
)
where
toListLevelStyle _ p s LinfNone = ListLevelStyle LltBullet p s LinfNone
toListLevelStyle _ p s f@(LinfString _) = ListLevelStyle LltBullet p s f
toListLevelStyle t p s f = ListLevelStyle t p s f
toListLevelStyle _ p s LinfNone b = ListLevelStyle LltBullet p s LinfNone (startValue b)
toListLevelStyle _ p s f@(LinfString _) b = ListLevelStyle LltBullet p s f (startValue b)
toListLevelStyle t p s f b = ListLevelStyle t p s f (startValue b)
startValue (Just v) = if all isDigit v
then read v
else 1
startValue Nothing = 1
--
chooseMostSpecificListLevelStyle :: S.Set ListLevelStyle -> Maybe ListLevelStyle
chooseMostSpecificListLevelStyle ls | ls == mempty = Nothing
| otherwise = Just ( F.foldr1 select ls )
where
select ( ListLevelStyle t1 p1 s1 f1 )
( ListLevelStyle t2 p2 s2 f2 )
= ListLevelStyle (select' t1 t2) (p1 <|> p2) (s1 <|> s2) (selectLinf f1 f2)
select ( ListLevelStyle t1 p1 s1 f1 b1 )
( ListLevelStyle t2 p2 s2 f2 _ )
= ListLevelStyle (select' t1 t2) (p1 <|> p2) (s1 <|> s2) (selectLinf f1 f2) b1
select' LltNumbered _ = LltNumbered
select' _ LltNumbered = LltNumbered
select' _ _ = LltBullet