aboutsummaryrefslogtreecommitdiff
path: root/Text/Pandoc/Shared.hs
diff options
context:
space:
mode:
authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2008-08-03 23:33:40 +0000
committerfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2008-08-03 23:33:40 +0000
commit6ff1e2a976c61268660da4a7cc392bb0a8cd781f (patch)
treeb81fb34f9d2b44359dece736ebb11627f983fae4 /Text/Pandoc/Shared.hs
parented4b00399778204bc589135e005620c40c988258 (diff)
downloadpandoc-6ff1e2a976c61268660da4a7cc392bb0a8cd781f.tar.gz
Improved configuration options and CPP macros.
+ Now all macros that serve as flags start with a single _. + Added message to '-v' output about UTF-8 support. + Made highlighting the default. If the highlighting-kate library is not present, cabal will deselect the option (unless it was explicitly set). + Add UTF8 support to test function in Text.Pandoc.Shared. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1374 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'Text/Pandoc/Shared.hs')
-rw-r--r--Text/Pandoc/Shared.hs9
1 files changed, 8 insertions, 1 deletions
diff --git a/Text/Pandoc/Shared.hs b/Text/Pandoc/Shared.hs
index eb924239d..6ae507cfa 100644
--- a/Text/Pandoc/Shared.hs
+++ b/Text/Pandoc/Shared.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-
Copyright (C) 2006-8 John MacFarlane <jgm@berkeley.edu>
@@ -115,6 +116,12 @@ import Network.URI ( parseURI, URI (..), isAllowedInURI )
import System.FilePath ( (</>), (<.>) )
import System.IO.Error ( catch, ioError, isAlreadyExistsError )
import System.Directory
+import Prelude hiding ( putStrLn )
+#ifdef _UTF8
+import System.IO.UTF8
+#else
+import System.IO
+#endif
--
-- List processing
@@ -612,7 +619,7 @@ readWith parser state input =
testStringWith :: (Show a) => GenParser Char ParserState a
-> String
-> IO ()
-testStringWith parser str = putStrLn $ show $
+testStringWith parser str = putStrLn $ show $
readWith parser defaultParserState str
-- | Parsing options.