Added --id-prefix option.

This adds a prefix to all automatically generated HTML identifiers,
which helps prevent duplicate identifiers when you're generating
a fragment (say a blog post).

Added writerIdentifierPrefix to WriterOptions.

Resolves Issue #41.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1650 788f1e2b-df1e-0410-8736-df70ead52e1b

3 files changed, 26 insertions, 10 deletions

diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 6ca693b77..0e8eff217 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -990,6 +990,7 @@ data WriterOptions = WriterOptions
   , writerWrapText         :: Bool   -- ^ Wrap text to line length
   , writerLiterateHaskell  :: Bool   -- ^ Write as literate haskell
   , writerEmailObfuscation :: ObfuscationMethod -- ^ How to obfuscate emails
+  , writerIdentifierPrefix :: String -- ^ Prefix for section & note ids in HTML
   } deriving Show
 
 -- | Default writer options.
@@ -1012,6 +1013,7 @@ defaultWriterOptions =
                 , writerWrapText         = True
                 , writerLiterateHaskell  = False
                 , writerEmailObfuscation = JavascriptObfuscation
+                , writerIdentifierPrefix = ""
                 }
 
 --
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index fc60a063a..5c764a635 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -144,13 +144,17 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
          then head' +++ body thebody
          else thebody
 
+-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix
+prefixedId :: WriterOptions -> String -> HtmlAttr
+prefixedId opts s = identifier $ writerIdentifierPrefix opts ++ s
+
 -- | Construct table of contents from list of elements.
 tableOfContents :: WriterOptions -> [Element] -> State WriterState Html
 tableOfContents _ [] = return noHtml
 tableOfContents opts sects = do
   let opts'        = opts { writerIgnoreNotes = True }
   contents  <- mapM (elementToListItem opts') sects
-  return $ thediv ! [identifier "TOC"] $ unordList $ catMaybes contents
+  return $ thediv ! [prefixedId opts' "TOC"] $ unordList $ catMaybes contents
 
 -- | Converts an Element to a list item for a table of contents,
 -- retrieving the appropriate identifier from state.
@@ -162,7 +166,7 @@ elementToListItem opts (Sec _ id' headerText subsecs) = do
   let subList = if null subHeads
                    then noHtml
                    else unordList subHeads
-  return $ Just $ (anchor ! [href ("#" ++ id')] $ txt) +++ subList
+  return $ Just $ (anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ id')] $ txt) +++ subList
 
 -- | Convert an Element to Html.
 elementToHtml :: WriterOptions -> Element -> State WriterState Html
@@ -173,7 +177,7 @@ elementToHtml opts (Sec level id' title' elements) = do
   return $ if writerS5 opts || (writerStrictMarkdown opts && not (writerTableOfContents opts))
               -- S5 gets confused by the extra divs around sections
               then toHtmlFromList (header' : innerContents)
-              else thediv ! [identifier id'] << (header' : innerContents)
+              else thediv ! [prefixedId opts id'] << (header' : innerContents)
 
 -- | Convert list of Note blocks to a footnote <div>.
 -- Assumes notes are sorted.
@@ -258,7 +262,7 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
                     -- browsers ignore leading newlines in pre blocks
                     let (leadingBreaks, rawCode') = span (=='\n') rawCode
                         attrs = [theclass (unwords classes') | not (null classes')] ++
-                                [identifier id' | not (null id')] ++
+                                [prefixedId opts id' | not (null id')] ++
                                 map (\(x,y) -> strAttr x y) keyvals
                     in  return $ pre ! attrs $ thecode <<
                                  (replicate (length leadingBreaks) br +++
@@ -282,7 +286,7 @@ blockToHtml opts (BlockQuote blocks) =
 blockToHtml opts (Header level lst) = do 
   contents <- inlineListToHtml opts lst
   let contents'  = if writerTableOfContents opts
-                      then anchor ! [href "#TOC"] $ contents
+                      then anchor ! [href $ "#" ++ writerIdentifierPrefix opts ++ "TOC"] $ contents
                       else contents
   return $ case level of
               1 -> h1 contents'
@@ -465,9 +469,9 @@ inlineToHtml opts inline =
                         htmlContents <- blockListToNote opts ref contents 
                         -- push contents onto front of notes
                         put $ st {stNotes = (htmlContents:notes)} 
-                        return $ anchor ! [href ("#fn" ++ ref),
+                        return $ anchor ! [href ("#" ++ writerIdentifierPrefix opts ++ "fn" ++ ref),
                                           theclass "footnoteRef",
-                                          identifier ("fnref" ++ ref)] << 
+                                          prefixedId opts ("fnref" ++ ref)] << 
                                           sup << ref
     (Cite _ il)  -> inlineListToHtml opts il
 
@@ -475,7 +479,7 @@ blockListToNote :: WriterOptions -> String -> [Block] -> State WriterState Html
 blockListToNote opts ref blocks =
   -- If last block is Para or Plain, include the backlink at the end of
   -- that block. Otherwise, insert a new Plain block with the backlink.
-  let backlink = [HtmlInline $ " <a href=\"#fnref" ++ ref ++ 
+  let backlink = [HtmlInline $ " <a href=\"#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref ++ 
                  "\" class=\"footnoteBackLink\"" ++
                  " title=\"Jump back to footnote " ++ ref ++ "\">&#8617;</a>"]
       blocks'  = if null blocks
@@ -490,5 +494,5 @@ blockListToNote opts ref blocks =
                                   _           -> otherBlocks ++ [lastBlock,
                                                  Plain backlink]
   in  do contents <- blockListToHtml opts blocks'
-         return $ li ! [identifier ("fn" ++ ref)] $ contents
+         return $ li ! [prefixedId opts ("fn" ++ ref)] $ contents
 
diff --git a/src/pandoc.hs b/src/pandoc.hs
index e24d621bf..c2cc9b75e 100644
--- a/src/pandoc.hs
+++ b/src/pandoc.hs
@@ -153,6 +153,7 @@ data Opt = Opt
     , optSanitizeHTML      :: Bool    -- ^ Sanitize HTML
     , optPlugins           :: [Pandoc -> IO Pandoc] -- ^ Plugins to apply
     , optEmailObfuscation  :: ObfuscationMethod
+    , optIdentifierPrefix  :: String
     , optIndentedCodeClasses :: [String] -- ^ Default classes for indented code blocks
 #ifdef _CITEPROC
     , optBiblioFile        :: String
@@ -190,6 +191,7 @@ defaultOpts = Opt
     , optSanitizeHTML      = False
     , optPlugins           = []
     , optEmailObfuscation  = JavascriptObfuscation
+    , optIdentifierPrefix  = ""
     , optIndentedCodeClasses = []
 #ifdef _CITEPROC
     , optBiblioFile        = []
@@ -314,6 +316,12 @@ options =
                   "none|javascript|references")
                  "" -- "Method for obfuscating email in HTML"
 
+     , Option "" ["id-prefix"]
+                  (ReqArg
+                   (\arg opt -> return opt { optIdentifierPrefix = arg })
+                   "STRING")
+                  "" -- "Prefix to add to automatically generated HTML identifiers"
+
      , Option "" ["indented-code-classes"]
                   (ReqArg
                    (\arg opt -> return opt { optIndentedCodeClasses = words $
@@ -540,6 +548,7 @@ main = do
               , optWrapText          = wrap
               , optSanitizeHTML      = sanitize
               , optEmailObfuscation  = obfuscationMethod
+              , optIdentifierPrefix  = idPrefix
               , optIndentedCodeClasses = codeBlockClasses
 #ifdef _CITEPROC
               , optBiblioFile         = biblioFile
@@ -627,7 +636,8 @@ main = do
                                                                lhsExtension [outputFile],
                                       writerEmailObfuscation = if strict
                                                                   then ReferenceObfuscation
-                                                                  else obfuscationMethod }
+                                                                  else obfuscationMethod,
+                                      writerIdentifierPrefix = idPrefix }
 
   when (isNonTextOutput writerName' && outputFile == "-") $
     do hPutStrLn stderr ("Error:  Cannot write " ++ writerName ++ " output to stdout.\n" ++