Permalink
Browse files

Separated commands and environments in state.

Now there is hexCommands and hexEnvironments.
  • Loading branch information...
jgm committed Mar 12, 2011
1 parent 724b49f commit a31337ce7871b2f82a69e522dc2bc3a13d4755b4
Showing with 21 additions and 13 deletions.
  1. +8 −1 Text/HeX.hs
  2. +1 −0 Text/HeX/Types.hs
  3. +9 −9 test/Docbook.hs
  4. +3 −3 test/test.hs
View
@@ -20,6 +20,7 @@ module Text.HeX ( run
, module Text.Parsec
, module Data.Monoid
, newCommand
+ , newEnvironment
, addParser
, command
, environment
@@ -101,6 +102,7 @@ run parser format contents = do
Fut f -> getState >>= f)
HeXState{ hexParsers = M.empty
, hexCommands = M.empty
+ , hexEnvironments = M.empty
, hexFormat = format
, hexVars = M.empty
, hexTarget = ""
@@ -141,6 +143,11 @@ newCommand modes name x = forM_ modes $ \m ->
updateState $ \s ->
s{ hexCommands = M.insert (m, name) (toCommand x) (hexCommands s) }
+newEnvironment :: ToCommand a => [Mode] -> String -> a -> HeX ()
+newEnvironment modes name x = forM_ modes $ \m ->
+ updateState $ \s ->
+ s{ hexEnvironments = M.insert (m, name) (toCommand x) (hexEnvironments s) }
+
cmdIdentifier :: HeX String
cmdIdentifier = do
a <- many1 letter
@@ -170,7 +177,7 @@ environment mode = do
char '}'
skipBlank
st' <- getState
- let commands = hexCommands st'
+ let commands = hexEnvironments st'
case M.lookup (mode, cmd) commands of
Just p -> do
let parsers = hexParsers st'
View
@@ -44,6 +44,7 @@ newtype MathDoc = MathDoc { unMath :: Doc }
data HeXState = HeXState { hexParsers :: M.Map Mode (HeX Doc)
, hexCommands :: M.Map (Mode, String) (HeX Doc)
+ , hexEnvironments :: M.Map (Mode, String) (HeX Doc)
, hexFormat :: Format
, hexVars :: M.Map String Dynamic
, hexTarget :: String
View
@@ -14,13 +14,13 @@ defaults = do
addParser [Block] $ basicBlock (inTags "para" [] . mconcat)
addParser [Inline] $ basicInline ch
MathML.defaults
- register [Inline] "emph" emph
- register [Inline] "strong" strong
- register [Block] "section" (section 1)
- register [Block] "subsection" (section 2)
- register [Block] "subsubsection" (section 3)
- register [Block] "paragraph" (section 4)
- register [Block] "subparagraph" (section 5)
+ newCommand [Inline] "emph" emph
+ newCommand [Inline] "strong" strong
+ newCommand [Block] "section" (section 1)
+ newCommand [Block] "subsection" (section 2)
+ newCommand [Block] "subsubsection" (section 3)
+ newCommand [Block] "paragraph" (section 4)
+ newCommand [Block] "subparagraph" (section 5)
emph :: InlineDoc -> Doc
emph (InlineDoc arg) = inTags "emphasis" [] arg
@@ -38,13 +38,13 @@ section lev (InlineDoc d) = do
sectionCmd 5 = "subparagraph"
sectionCmd _ = "subsubparagraph"
st <- getState
- let remapCmd n = register [Block] (sectionCmd n) $
+ let remapCmd n = newCommand [Block] (sectionCmd n) $
do guard False
section n mempty
let unRemapCmd n = let old = case M.lookup (Block, sectionCmd n) (hexCommands st) of
Just x -> x
Nothing -> error "Something happened"
- in register [Block] (sectionCmd n) old
+ in newCommand [Block] (sectionCmd n) old
forM_ [1..lev] remapCmd
contents <- many block
forM_ [1..lev] unRemapCmd
View
@@ -12,9 +12,9 @@ import Control.Monad.Trans (liftIO)
main = defaultMain $ do
Standard.defaults
forFormat "docbook" Docbook.defaults
- register [Block,Inline] "silly*" silly
- register [Inline] "lettrine" lettrine
- register [Block] "crazy" crazy
+ newCommand [Block,Inline] "silly*" silly
+ newCommand [Inline] "lettrine" lettrine
+ newEnvironment [Block] "crazy" crazy
-- addParser [Math, Inline] unknown
-- FOR DEBUGGING
-- forFormat "html" $ addParser [Math] unknownChar

0 comments on commit a31337c

Please sign in to comment.