Improve DTC writing.

diff --git a/Language/TCT/Write/DTC.hs b/Language/TCT/Write/DTC.hs
index 8e64f6be73df0e1b1572bed8c6b7dbd7167b3776..1e6c92c2c8ea608005c0a28f2106f387ecdf09bc 100644 (file)
--- a/Language/TCT/Write/DTC.hs
+++ b/Language/TCT/Write/DTC.hs
@@ -6,7 +6,7 @@
 module Language.TCT.Write.DTC where
 
 import Control.Applicative (Applicative(..))
-import Control.Monad (Monad(..), forM_, mapM)
+import Control.Monad (Monad(..), forM_, mapM, when)
 import Data.Bool
 import Data.Eq (Eq(..))
 import Data.Foldable (Foldable(..))
@@ -50,10 +50,11 @@ dbg m x = trac (m <> ": " <> show x) x
 
 dtc :: Trees (Cell Key) (Cell Token) -> DTC
 dtc tct = do
+       let lang = "fr"
        D.xmlModel        "./schema/dtc.rnc"
-       D.xmlStylesheet   "./xsl/document.html5.xsl"
-       D.html5Stylesheet "./xsl/document.html5.xsl"
-       D.atomStylesheet  "./xsl/document.atom.xsl"
+       D.xmlStylesheet   $ "./xsl/document.html5."<>lang<>".xsl"
+       D.html5Stylesheet $ "./xsl/document.html5."<>lang<>".xsl"
+       D.atomStylesheet  $ "./xsl/document.atom."<>lang<>".xsl"
        D.document $
                forM_ tct $ d_TreeCell []
 
@@ -61,8 +62,16 @@ d_TreeCell :: [Key] -> Tree (Cell Key) (Cell Token) -> DTC
 d_TreeCell path (TreeN (unCell -> key@KeySection{}) ts) =
        case Seq.viewl ts of
         Tree0 (Cell _posTitle _ (TokenPlain title)) :< _ ->
-               D.section ! DA.name (attrValue title) $
-                       d_content
+               case Text.splitOn "\n" title of
+                t0:t1 ->
+                       D.section ! DA.name (attrValue t0) $ do
+                               let st = Text.intercalate "\n" t1
+                               when (not (Text.null st)) $
+                                       D.name $ B.toMarkup st
+                               d_content
+                [] ->
+                       D.section ! DA.name (attrValue title) $
+                               d_content
         Tree0 (Cell _posTitle _ title) :< _ ->
                D.section $ do
                        D.name $ d_Token (key:path) title

diff --git a/Text/Blaze/Utils.hs b/Text/Blaze/Utils.hs
index 922330ecc4aae327031fb411dfba166ef0d14c02..a3e0fa2a54ad38298e4699926bdbfb34d9bef450 100644 (file)
--- a/Text/Blaze/Utils.hs
+++ b/Text/Blaze/Utils.hs
@@ -2,10 +2,12 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Text.Blaze.Utils where
 
+-- import Data.Ord (Ord(..))
 import Blaze.ByteString.Builder (Builder)
 import Control.Monad (return)
 import Data.Bool
 import Data.Eq (Eq(..))
+import Data.Foldable (Foldable(..))
 import Data.Function ((.), ($))
 import Data.Functor ((<$>))
 import Data.Int (Int)
@@ -14,19 +16,20 @@ import Data.Monoid (Monoid(..))
 import Data.Semigroup (Semigroup(..))
 import Data.String (IsString(..))
 import Data.Text (Text)
+import Prelude (Num(..))
 import System.IO (IO)
 import Text.Blaze as B
-import Text.Blaze.Internal as B
+import Text.Blaze.Internal as B hiding (null)
 import Text.Show (Show(..))
-import qualified Data.List as List
 import qualified Blaze.ByteString.Builder as BS
 import qualified Blaze.ByteString.Builder.Html.Utf8 as BS
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
+import qualified Data.List as List
 import qualified Data.Text as Text
+import qualified Data.Text.Encoding as BS
 import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Renderer.Utf8 as BS
-import qualified Data.Text.Encoding as BS
 
 -- | 'Attribute' in 'Maybe'.
 infixl 1 !??
@@ -64,12 +67,24 @@ prettyMarkupBuilder indentTag = go IndentTagPreserve "\n" mempty
        where
        inc :: Builder
        inc = "  "
-       go :: IndentTag -> Builder -> Builder -> MarkupM b -> Builder
+       bs_Attrs i ind t_tag attrs =
+               case List.reverse attrs of
+                [] -> mempty
+                [a] -> a
+                a0:as ->
+                       let ind_key = BS.fromText $ Text.replicate (Text.length t_tag + 1) " " in
+                       let ind_attr =
+                               case i of
+                                IndentTagChildren -> ind<>ind_key
+                                IndentTagPreserve -> mempty
+                                IndentTagText -> mempty in
+                       a0 <> foldMap (ind_attr <>) as
+       go :: IndentTag -> Builder -> [Builder] -> MarkupM b -> Builder
        go i ind attrs (Parent tag open close content) =
                let i' = indentTag (getText tag) in
                (if i==IndentTagChildren then ind else mempty)
                 <> BS.copyByteString (getUtf8ByteString open)
-                <> attrs
+                <> bs_Attrs i ind (getText tag) attrs
                 <> BS.fromChar '>'
                 <> (if i==IndentTagChildren && i'==IndentTagText then ind<>inc else mempty)
                 <> go i' (if i'/=IndentTagPreserve then ind<>inc else ind) mempty content
@@ -77,10 +92,11 @@ prettyMarkupBuilder indentTag = go IndentTagPreserve "\n" mempty
                 <> BS.copyByteString (getUtf8ByteString close)
        go i ind attrs (CustomParent tag content) =
                let i' = indentTag (t_ChoiceString tag) in
+               let t_tag = t_ChoiceString tag in
                (if i==IndentTagChildren then ind else mempty)
                 <> BS.fromChar '<'
-                <> bs_ChoiceString tag
-                <> attrs
+                <> BS.fromText t_tag
+                <> bs_Attrs i ind t_tag attrs
                 <> BS.fromChar '>'
                 <> (if i==IndentTagChildren && i'==IndentTagText then ind<>inc else mempty)
                 <> go i' (if i'/=IndentTagPreserve then ind<>inc else ind) mempty content
@@ -88,29 +104,32 @@ prettyMarkupBuilder indentTag = go IndentTagPreserve "\n" mempty
                 <> BS.fromByteString "</"
                 <> bs_ChoiceString tag
                 <> BS.fromChar '>'
-       go i ind attrs (Leaf _tag begin end _) =
+       go i ind attrs (Leaf tag begin end _) =
                (if i==IndentTagChildren then ind else mempty)
                 <> BS.copyByteString (getUtf8ByteString begin)
-                <> attrs
+                <> bs_Attrs i ind (getText tag) attrs
                 <> BS.copyByteString (getUtf8ByteString end)
        go i ind attrs (CustomLeaf tag close _) =
+               let t_tag = t_ChoiceString tag in
                (if i==IndentTagChildren then ind else mempty)
                 <> BS.fromChar '<'
-                <> bs_ChoiceString tag
-                <> attrs
+                <> BS.fromText t_tag
+                <> bs_Attrs i ind t_tag attrs
                 <> (if close then BS.fromByteString "/>" else BS.fromChar '>')
        go i ind attrs (AddAttribute _ key value m) =
-               go i ind (BS.copyByteString (getUtf8ByteString key)
+               go i ind
+                (  BS.copyByteString (getUtf8ByteString key)
                 <> bs_ChoiceString value
                 <> BS.fromChar '"'
-                <> attrs) m
+                : attrs ) m
        go i ind attrs (AddCustomAttribute key value m) =
-               go i ind (BS.fromChar ' '
+               go i ind
+                (  BS.fromChar ' '
                 <> bs_ChoiceString key
                 <> BS.fromByteString "=\""
                 <> bs_ChoiceString value
                 <> BS.fromChar '"'
-                <> attrs) m
+                : attrs ) m
        go i ind _attrs (Content content _) =
                if i/=IndentTagPreserve
                then indentChoiceString ind content
@@ -126,7 +145,7 @@ prettyMarkupBuilder indentTag = go IndentTagPreserve "\n" mempty
        go i ind attrs (Append m1 m2) =
                go i ind attrs m1 <>
                go i ind attrs m2
-       go _ip _ind _ (Empty _) = mempty
+       go _i _ind _attrs (Empty _) = mempty
        {-# NOINLINE go #-}
 
 -- | Render 'Markup' to a lazy UTF-8 encoded 'BSL.ByteString'.

diff --git a/style/tct-html5-source.css b/style/tct-html5-source.css
index f6b7da5490206c994ea72f9f4ed6d1e44016ae76..90d332e4e1956cd3b5cebd930a75b6f0a9107280 100644 (file)
--- a/style/tct-html5-source.css
+++ b/style/tct-html5-source.css
@@ -61,7 +61,7 @@ section {
        text-decoration:line-through;
  }
 .pair-PairBackquote > .pair-content {
-       background:#ddd;
+       background:#eee;
  }
 .pair-PairElem > .pair-open,
 .pair-PairElem > .pair-close {