Support multiple bibliography files with natbib and biblatex output.
This commit is contained in:
parent
63d5e0c5f9
commit
43fee5e7f7
3 changed files with 5 additions and 4 deletions
|
@ -566,7 +566,7 @@ data WriterOptions = WriterOptions
|
||||||
, writerSourceDirectory :: FilePath -- ^ Directory path of 1st source file
|
, writerSourceDirectory :: FilePath -- ^ Directory path of 1st source file
|
||||||
, writerUserDataDir :: Maybe FilePath -- ^ Path of user data directory
|
, writerUserDataDir :: Maybe FilePath -- ^ Path of user data directory
|
||||||
, writerCiteMethod :: CiteMethod -- ^ How to print cites
|
, writerCiteMethod :: CiteMethod -- ^ How to print cites
|
||||||
, writerBiblioFile :: String -- ^ Biblio file to use for citations
|
, writerBiblioFiles :: [FilePath] -- ^ Biblio files to use for citations
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
-- | Default writer options.
|
-- | Default writer options.
|
||||||
|
@ -594,7 +594,7 @@ defaultWriterOptions =
|
||||||
, writerSourceDirectory = "."
|
, writerSourceDirectory = "."
|
||||||
, writerUserDataDir = Nothing
|
, writerUserDataDir = Nothing
|
||||||
, writerCiteMethod = Citeproc
|
, writerCiteMethod = Citeproc
|
||||||
, writerBiblioFile = ""
|
, writerBiblioFiles = []
|
||||||
}
|
}
|
||||||
|
|
||||||
--
|
--
|
||||||
|
|
|
@ -36,6 +36,7 @@ import Data.List ( (\\), isSuffixOf, isPrefixOf, intersperse, intercalate )
|
||||||
import Data.Char ( toLower )
|
import Data.Char ( toLower )
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Text.PrettyPrint.HughesPJ hiding ( Str )
|
import Text.PrettyPrint.HughesPJ hiding ( Str )
|
||||||
|
import System.FilePath (dropExtension)
|
||||||
|
|
||||||
data WriterState =
|
data WriterState =
|
||||||
WriterState { stInNote :: Bool -- @True@ if we're in a note
|
WriterState { stInNote :: Bool -- @True@ if we're in a note
|
||||||
|
@ -76,7 +77,7 @@ pandocToLaTeX options (Pandoc (Meta title authors date) blocks) = do
|
||||||
body <- blockListToLaTeX blocks
|
body <- blockListToLaTeX blocks
|
||||||
let main = render body
|
let main = render body
|
||||||
st <- get
|
st <- get
|
||||||
let biblio = takeWhile ((/=) '.') $ writerBiblioFile options
|
let biblio = intercalate "," $ map dropExtension $ writerBiblioFiles options
|
||||||
citecontext = case writerCiteMethod options of
|
citecontext = case writerCiteMethod options of
|
||||||
Natbib -> [ ("biblio", biblio)
|
Natbib -> [ ("biblio", biblio)
|
||||||
, ("natbib", "yes")
|
, ("natbib", "yes")
|
||||||
|
|
|
@ -739,7 +739,7 @@ main = do
|
||||||
writerIncremental = incremental,
|
writerIncremental = incremental,
|
||||||
writerXeTeX = xetex,
|
writerXeTeX = xetex,
|
||||||
writerCiteMethod = citeMethod,
|
writerCiteMethod = citeMethod,
|
||||||
writerBiblioFile = head reffiles,
|
writerBiblioFiles = reffiles,
|
||||||
writerIgnoreNotes = False,
|
writerIgnoreNotes = False,
|
||||||
writerNumberSections = numberSections,
|
writerNumberSections = numberSections,
|
||||||
writerSectionDivs = sectionDivs,
|
writerSectionDivs = sectionDivs,
|
||||||
|
|
Loading…
Reference in a new issue