From 3d2ff3d0a8d6ee04e771d1261b1367d7a3f4efe3 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Wed, 27 Aug 2008 05:50:26 +0000
Subject: Removed PDF writer from core pandoc, restored markdown2pdf.

+ Added markdown2pdf.
+ Removed Text/Pandoc/PDF.hs.
+ Removed references to PDF writer from Main.hs.
+ Removed references to PDF writer from pandoc.cabal.
+ Added markdown2pdf.1 to list of man pages in Setup.hs.
+ Added markdown2pdf.1.md man page source.
+ Added reference to markdown2pdf(1) in pandoc man page.
+ Added markdown2pdf to WRAPPERS in Makefile.
+ Removed mention of pdf writer from README; added markdown2pdf.
+ Added remarks on markdown2pdf dependencies to README.Debian.
+ Added markdown2pdf to web/index.txt.in.
+ Use markdown2pdf for pdf web demos.
+ Put markdown2pdf back into debian control and rules.
+ Added markdown2pdf to macports Portfile.
+ Added markdown2pdf to freebsd package.


git-svn-id: https://pandoc.googlecode.com/svn/trunk@1415 788f1e2b-df1e-0410-8736-df70ead52e1b
---
 Main.hs                    |   6 +-
 Makefile                   |   6 +-
 README                     |  69 +++++++++++++---------
 README.Debian              |  20 ++-----
 Setup.hs                   |   2 +-
 Text/Pandoc/PDF.hs         | 134 -------------------------------------------
 debian/control             |  12 ++--
 debian/rules               |   2 +-
 freebsd/Makefile.in        |   6 +-
 freebsd/pkg-descr          |   6 +-
 macports/Portfile.in       |   6 +-
 man/man1/markdown2pdf.1.md |  69 ++++++++++++++++++++++
 man/man1/pandoc.1.md       |   3 +-
 markdown2pdf               | 140 +++++++++++++++++++++++++++++++++++++++++++++
 pandoc.cabal               |   3 +-
 web/demos                  |   4 +-
 web/index.txt.in           |   3 +
 17 files changed, 286 insertions(+), 205 deletions(-)
 delete mode 100644 Text/Pandoc/PDF.hs
 create mode 100644 man/man1/markdown2pdf.1.md
 create mode 100755 markdown2pdf

diff --git a/Main.hs b/Main.hs
index 635b2f790..0941d2548 100644
--- a/Main.hs
+++ b/Main.hs
@@ -32,7 +32,6 @@ writers.
 module Main where
 import Text.Pandoc
 import Text.Pandoc.ODT
-import Text.Pandoc.PDF
 import Text.Pandoc.Shared ( joinWithSep, HTMLMathMethod (..) )
 import Text.Pandoc.Highlighting ( languages )
 import System.Environment ( getArgs, getProgName, getEnvironment )
@@ -100,7 +99,6 @@ writers = [("native"       , (writeDoc, ""))
           ,("opendocument" , (writeOpenDocument, defaultOpenDocumentHeader))
           ,("odt"          , (writeOpenDocument, defaultOpenDocumentHeader))
           ,("latex"        , (writeLaTeX, defaultLaTeXHeader))
-          ,("pdf"          , (writeLaTeX, defaultLaTeXHeader))
           ,("context"      , (writeConTeXt, defaultConTeXtHeader))
           ,("texinfo"      , (writeTexinfo, ""))
           ,("man"          , (writeMan, ""))
@@ -111,7 +109,7 @@ writers = [("native"       , (writeDoc, ""))
           ]
 
 isNonTextOutput :: String -> Bool
-isNonTextOutput = (`elem` ["odt", "pdf"])
+isNonTextOutput = (`elem` ["odt"])
 
 -- | Writer for Pandoc native format.
 writeDoc :: WriterOptions -> Pandoc -> String
@@ -433,7 +431,6 @@ defaultWriterName x =
     ".texinfo"  -> "texinfo"
     ".db"       -> "docbook"
     ".odt"      -> "odt"
-    ".pdf"      -> "pdf"
     ['.',y] | y `elem` ['1'..'9'] -> "man"
     _          -> "html"
 
@@ -598,7 +595,6 @@ main = do
 
   let writeOutput = case writerName' of
                           "odt"   -> saveOpenDocumentAsODT outputFile sourceDirRelative
-                          "pdf"   -> saveLaTeXAsPDF outputFile sourceDirRelative
                           _       -> if outputFile == "-"
                                         then putStrLn
                                         else writeFile outputFile . (++ "\n")
diff --git a/Makefile b/Makefile
index 5a453e31b..4b009441c 100644
--- a/Makefile
+++ b/Makefile
@@ -24,7 +24,7 @@ EXECSBASE := $(shell sed -ne 's/^[Ee]xecutable:\{0,1\}[[:space:]]*//p' $(CABAL))
 #-------------------------------------------------------------------------------
 # Install targets
 #-------------------------------------------------------------------------------
-WRAPPERS  := html2markdown hsmarkdown
+WRAPPERS  := html2markdown hsmarkdown markdown2pdf
 # Add .exe extensions if we're running Windows/Cygwin.
 EXTENSION := $(shell uname | tr '[:upper:]' '[:lower:]' | \
                sed -ne 's/^cygwin.*$$/\.exe/p')
@@ -85,8 +85,8 @@ all: build-program
 	./$(MAIN) -s -w latex $< >$@ || rm -f $@
 %.rtf: % $(MAIN)
 	./$(MAIN) -s -w rtf $< >$@ || rm -f $@
-%.pdf: % $(MAIN)
-	./$(MAIN) -w pdf -o $@ $< || rm -f $@
+%.pdf: % $(MAIN) markdown2pdf
+	sh ./markdown2pdf $< || rm -f $@
 %.txt: %
 	perl -p -e 's/\n/\r\n/' $< > $@ || rm -f $@ # convert to DOS line endings
 
diff --git a/README b/README
index 73cb92f3a..89314fbb2 100644
--- a/README
+++ b/README
@@ -55,9 +55,8 @@ If you want to write to a file, use the `-o` option:
 
     pandoc -o hello.html hello.txt
 
-[^1]:  The exception is for non-text output formats, such as `odt`
-       and `pdf`. For output in these formats, an output file must be
-       specified explicitly.
+[^1]:  The exception is for `odt`.  Since this is a binary output format,
+       an output file must be specified explicitly.
 
 Note that you can specify multiple input files on the command line.
 `pandoc` will concatenate them all (with blank lines between them)
@@ -82,28 +81,16 @@ To convert `hello.html` from html to markdown:
 	pandoc -f html -t markdown hello.html
 
 Supported output formats include `markdown`, `latex`, `context`
-(ConTeXt), `pdf`, `html`, `rtf` (rich text format), `rst`
+(ConTeXt), `html`, `rtf` (rich text format), `rst`
 (reStructuredText), `docbook` (DocBook XML), `opendocument`
 (OpenDocument XML), `odt` (OpenOffice text document), `texinfo`, (GNU
 Texinfo), `mediawiki` (MediaWiki markup), `man` (groff man), and `s5`
 (which produces an HTML file that acts like powerpoint).
 
-Notes:
-
-- For `odt` output, you must have `zip` in the path. If you
-  don't have it installed, you can get the free [Info-ZIP].
-
-- For `pdf` output, you must have `pdflatex` and `bibtex` in the
-  path. You should also have the following LaTeX packages installed:
-  `unicode`, `fancyhdr` (if you have verbatim text in footnotes),
-  `graphicx` (if you use images), `array` (if you use tables), and
-  `ulem` (if you use strikeout text). If they are not already included
-  in your LaTeX distribution, you can get them from [CTAN].  A full
-  [TeX Live] or [MacTeX] distribution will have all of these packages.
-
-  [Info-ZIP]: http://www.info-zip.org/Zip.html
-  [TeX Live]: http://www.tug.org/texlive/
-  [MacTeX]:   http://www.tug.org/mactex/
+For `odt` output, you must have `zip` in the path. If you
+don't have it installed, you can get the free [Info-ZIP].
+  
+[Info-ZIP]: http://www.info-zip.org/Zip.html
 
 Supported input formats include `markdown`, `html`, `latex`, and `rst`.
 Note that the `rst` reader only parses a subset of reStructuredText
@@ -148,12 +135,38 @@ then convert the output back to the local encoding.
 Shell scripts
 =============
 
-Two shell scripts, `html2markdown` and `hsmarkdown`, are included in
-the standard Pandoc installation. (They are not included in the Windows
-binary package, as they require a POSIX shell, but they may be used in
-Windows under Cygwin.)
+Three shell scripts, `markdown2pdf`, `html2markdown`, and `hsmarkdown`,
+are included in the standard Pandoc installation. (They are not included
+in the Windows binary package, as they require a POSIX shell, but they
+may be used in Windows under Cygwin.)
+
+1.  `markdown2pdf` produces a PDF file from markdown-formatted
+    text, using `pandoc` and `pdflatex`.  The default
+    behavior of `markdown2pdf` is to create a file with the same
+    base name as the first argument and the extension `pdf`; thus,
+    for example,
+
+           markdown2pdf sample.txt endnotes.txt
+
+    will produce `sample.pdf`.  (If `sample.pdf` exists already,
+    it will be backed up before being overwritten.)  An output file
+    name can be specified explicitly using the `-o` option:
+
+           markdown2pdf -o book.pdf chap1 chap2
+
+    If no input file is specified, input will be taken from stdin.
+    All of `pandoc`'s options will work with `markdown2pdf` as well.
+
+    `markdown2pdf` assumes that `pdflatex` is in the path.  It also
+    assumes that the following LaTeX packages are available:
+    `unicode`, `fancyhdr` (if you have verbatim text in footnotes),
+    `graphicx` (if you use images), `array` (if you use tables),
+    and `ulem` (if you use strikeout text).  If they are not already
+    included in your LaTeX distribution, you can get them from
+    [CTAN]. A full [TeX Live] or [MacTeX] distribution will have all of
+    these packages.
 
-1.  `html2markdown` grabs a web page from a file or URL and converts
+2.  `html2markdown` grabs a web page from a file or URL and converts
     it to markdown-formatted text, using `tidy` and `pandoc`.
 
     All of `pandoc`'s options will work with `html2markdown` as well.
@@ -182,7 +195,7 @@ Windows under Cygwin.)
     It uses [`iconv`] for character encoding conversions; if `iconv`
     is absent, it will still work, but it will treat everything as UTF-8.
 
-2.  `hsmarkdown` is designed to be used as a drop-in replacement for
+3.  `hsmarkdown` is designed to be used as a drop-in replacement for
     `Markdown.pl`.  It forces `pandoc` to convert from markdown to
     HTML, and to use the `--strict` flag for maximal compliance with
     official markdown syntax.  (All of Pandoc's syntax extensions and
@@ -202,6 +215,8 @@ Windows under Cygwin.)
 [HTML Tidy]:  http://tidy.sourceforge.net/
 [`iconv`]: http://www.gnu.org/software/libiconv/
 [CTAN]: http://www.ctan.org "Comprehensive TeX Archive Network"
+[TeX Live]: http://www.tug.org/texlive/
+[MacTeX]:   http://www.tug.org/mactex/
 
 Command-line options
 ====================
@@ -227,7 +242,7 @@ For further documentation, see the `pandoc(1)` man page.
 `-o` or `--output` *filename*
 :   sends output to *filename*. If this option is not specified,
     or if its argument is `-`, output will be sent to stdout.
-    (Exception: if the output format is `odt` or `pdf`, output to stdout
+    (Exception: if the output format is `odt`, output to stdout
     is disabled.)
 
 `-p` or `--preserve-tabs`
diff --git a/README.Debian b/README.Debian
index e2d2003f2..5b15862b1 100644
--- a/README.Debian
+++ b/README.Debian
@@ -1,17 +1,9 @@
-Notes to Debian users:
+Notes to Debian users on "suggested" dependencies:
 
-1.  `markdown2pdf` has been removed, since pandoc now includes `pdf`
-    as a writer option.  You can replace
+If you intend to use the markdown2pdf script, you should install
+texlive-latex-recommended (or, if you use teTeX, tetex-extra). This
+provides LaTeX packages that are needed by markdown2pdf.
 
-        markdown2pdf foo.txt
-
-    with
-
-        pandoc foo.txt -o foo.pdf
-
-    Note that unlike `markdown2npdf`, `pandoc` requires that the output
-    filename be specified explicitly.
-
-2.  If you intend to use the html2markdown script, you should install
-    tidy, plus either wget or w3m.
+If you intend to use the html2markdown script, you should install
+tidy, plus either wget or w3m.
 
diff --git a/Setup.hs b/Setup.hs
index d1c3c5c90..c51c53bb1 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -50,7 +50,7 @@ makeReferenceODT sources = do
 
 -- | Build man pages from markdown sources in man/man1/.
 makeManPages _ _ _ _ = do
-  mapM makeManPage ["pandoc.1", "hsmarkdown.1", "html2markdown.1"]
+  mapM makeManPage ["pandoc.1", "hsmarkdown.1", "html2markdown.1", "markdown2pdf.1"]
   return ()
 
 -- | Build a man page from markdown source in man/man1.
diff --git a/Text/Pandoc/PDF.hs b/Text/Pandoc/PDF.hs
deleted file mode 100644
index 1e2d5e9b5..000000000
--- a/Text/Pandoc/PDF.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-{-
-Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--}
-
-{- |
-   Module      : Text.Pandoc.PDF
-   Copyright   : Copyright (C) 2006-7 John MacFarlane
-   License     : GNU GPL, version 2 or above
-
-   Maintainer  : John MacFarlane <jgm@berkeley.edu>
-   Stability   : alpha
-   Portability : portable
-
-Functions for producing a PDF file from LaTeX.
--}
-module Text.Pandoc.PDF ( saveLaTeXAsPDF ) where
-import Data.List ( isInfixOf )
-import System.Directory
-import System.FilePath ( (</>), (<.>), takeBaseName )
-import System.Process ( runProcess, waitForProcess )
-import System.Exit
-import System.Environment ( getEnvironment )
-import Text.Pandoc.Shared ( withTempDir )
-import Prelude hiding ( writeFile, readFile, putStrLn )
-import System.IO ( stderr, openFile, IOMode (..), hClose )
-import System.IO.UTF8
-
--- | Produce an PDF file from LaTeX.
-saveLaTeXAsPDF :: FilePath    -- ^ Pathname of PDF file to be produced.
-                -> FilePath    -- ^ Relative directory of source file.
-                -> String      -- ^ LaTeX document.
-                -> IO ()
-saveLaTeXAsPDF destinationPDFPath sourceDirRelative latex = do
-  -- check for pdflatex and bibtex in path:
-  latexPathMaybe <- findExecutable "pdflatex"
-  bibtexPathMaybe <- findExecutable "bibtex"
-  let latexPath = case latexPathMaybe of
-                  Nothing -> error $ "The 'pdflatex' command, which is needed to build a PDF file, was not found."
-                  Just x  -> x
-  let bibtexPath = case bibtexPathMaybe of
-                  Nothing -> error $ "The 'bibtex' command, which is needed to build an PDF file, was not found."
-                  Just x  -> x
-  sourceDirAbsolute <- getCurrentDirectory >>= return . (</> sourceDirRelative) >>= canonicalizePath
-  withTempDir "pandoc-pdf" $ \tempDir -> do
-    env <- getEnvironment
-    let env' = ("TEXINPUTS", ".:" ++ sourceDirAbsolute ++ ":") : env
-    let baseName = "input"
-    writeFile (tempDir </> baseName <.> "tex") latex
-    let runLatex = runProgram latexPath ["-interaction=nonstopmode", baseName] tempDir env'
-    let runBibtex = runProgram bibtexPath [baseName] tempDir env'
-    messages1 <- runLatex
-    let logPath = tempDir </> baseName <.> "log"
-    tocExists <- doesFileExist (tempDir </> baseName <.> "toc")
-    logContents <- readFile logPath
-    let undefinedRefs = "There were undefined references" `isInfixOf` logContents
-    let needsBibtex = "itation" `isInfixOf` logContents
-    if needsBibtex
-       then runBibtex >>= hPutStr stderr . unlines
-       else return ()
-    if tocExists || undefinedRefs
-       then do
-         messages2 <- runLatex
-         logContents' <- readFile logPath
-         let stillUndefinedRefs = "There were undefined references" `isInfixOf` logContents'
-         if stillUndefinedRefs
-            then runLatex >>= hPutStr stderr . unlines
-            else hPutStr stderr $ unlines messages2
-       else
-         hPutStr stderr $ unlines messages1
-    let pdfPath = tempDir </> baseName <.> "pdf"
-    pdfExists <- doesFileExist pdfPath
-    if pdfExists
-       then copyFile pdfPath destinationPDFPath
-       else error "The PDF could not be created."
-
-runProgram :: FilePath             -- ^ pathname of executable
-           -> [String]             -- ^ arguments
-           -> FilePath             -- ^ working directory
-           -> [(String, String)]   -- ^ environment
-           -> IO [String]
-runProgram cmdPath arguments workingDir env = do
-   let runOutputPath = workingDir </> "output" <.> "tmp"
-   runOutput <- openFile runOutputPath WriteMode
-   ph <- runProcess cmdPath arguments (Just workingDir) (Just env) Nothing (Just runOutput) (Just runOutput)
-   ec <- waitForProcess ph   -- requires compilation with -threaded
-   hClose runOutput
-   case ec of
-         ExitSuccess -> return []
-         _           -> do
-                          output <- readFile runOutputPath
-                          if (takeBaseName cmdPath) == "bibtex"
-                             then return $! lines output
-                             else do
-                               return $!
-                                   (if "`ucs.sty' not found" `isInfixOf` output
-                                       then ["Please install the 'unicode' package from CTAN:",
-                                             "  http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/"]
-                                       else []) ++
-                                   (if "`ulem.sty' not found" `isInfixOf` output
-                                       then ["Please install the 'ulem' package from CTAN:",
-                                             "  http://www.ctan.org/tex-archive/macros/latex/contrib/misc/"]
-                                       else []) ++
-                                   (if "`graphicx.sty' not found" `isInfixOf` output
-                                       then ["Please install the 'graphicx' package from CTAN:",
-                                             "  http://www.ctan.org/tex-archive/macros/latex/required/graphics/"]
-                                       else []) ++
-                                   (if "`fancyhdr.sty' not found" `isInfixOf` output
-                                       then ["Please install the 'fancyhdr' package from CTAN:",
-                                             "  http://www.ctan.org/tex-archive/macros/latex/contrib/fancyhdr/"]
-                                       else []) ++
-                                   (if "`array.sty' not found" `isInfixOf` output
-                                       then ["Please install the 'array' package from CTAN:",
-                                             "  http://www.ctan.org/tex-archive/macros/latex/required/tools/"]
-                                       else []) ++
-                                   (filter isUseful $ lines output)
-                                     where isUseful ln = take 1 ln == "!"  ||
-                                                         take 2 ln == "l." ||
-                                                         "Error"   `isInfixOf` ln ||
-                                                         "error"   `isInfixOf` ln
-
diff --git a/debian/control b/debian/control
index 8cfa302f0..8443a1cea 100644
--- a/debian/control
+++ b/debian/control
@@ -18,7 +18,7 @@ Description: general markup converter
  Pandoc is a Haskell library for converting from one markup format to
  another, and a command-line tool that uses this library. It can read
  markdown and (subsets of) reStructuredText, HTML, and LaTeX, and it
- can write markdown, reStructuredText, HTML, LaTeX, ConTeXt, PDF,
+ can write markdown, reStructuredText, HTML, LaTeX, ConTeXt,
  DocBook XML, OpenDocument XML, ODT, RTF, GNU Texinfo, MediaWiki markup,
  groff man pages, and S5 HTML slide shows.
  .
@@ -26,7 +26,7 @@ Description: general markup converter
  tables, definition lists, and other features. A compatibility mode is
  provided for those who need a drop-in replacement for Markdown.pl.
  Included wrapper scripts make it easy to convert markdown documents to
- PDF or ODT format and to convert web pages to markdown documents.
+ PDF and to convert web pages to markdown documents.
  .
  In contrast to existing tools for converting markdown to HTML, which
  use regex substitutions, pandoc has a modular design: it consists of a
@@ -44,7 +44,7 @@ Description: general markup converter
  Pandoc is a Haskell library for converting from one markup format to
  another, and a command-line tool that uses this library. It can read
  markdown and (subsets of) reStructuredText, HTML, and LaTeX, and it
- can write markdown, reStructuredText, HTML, LaTeX, ConTeXt, PDF,
+ can write markdown, reStructuredText, HTML, LaTeX, ConTeXt,
  DocBook XML, OpenDocument XML, ODT, RTF, GNU Texinfo, MediaWiki markup,
  groff man pages, and S5 HTML slide shows.
  .
@@ -52,7 +52,7 @@ Description: general markup converter
  tables, definition lists, and other features. A compatibility mode is
  provided for those who need a drop-in replacement for Markdown.pl.
  Included wrapper scripts make it easy to convert markdown documents to
- PDF or ODT format and to convert web pages to markdown documents.
+ PDF and to convert web pages to markdown documents.
  .
  In contrast to existing tools for converting markdown to HTML, which
  use regex substitutions, pandoc has a modular design: it consists of a
@@ -70,7 +70,7 @@ Description: general markup converter
  Pandoc is a Haskell library for converting from one markup format to
  another, and a command-line tool that uses this library. It can read
  markdown and (subsets of) reStructuredText, HTML, and LaTeX, and it
- can write markdown, reStructuredText, HTML, LaTeX, ConTeXt, PDF,
+ can write markdown, reStructuredText, HTML, LaTeX, ConTeXt,
  DocBook XML, OpenDocument XML, ODT, RTF, GNU Texinfo, MediaWiki markup,
  groff man pages, and S5 HTML slide shows.
  .
@@ -78,7 +78,7 @@ Description: general markup converter
  tables, definition lists, and other features. A compatibility mode is
  provided for those who need a drop-in replacement for Markdown.pl.
  Included wrapper scripts make it easy to convert markdown documents to
- PDF or ODT format and to convert web pages to markdown documents.
+ PDF and to convert web pages to markdown documents.
  .
  In contrast to existing tools for converting markdown to HTML, which
  use regex substitutions, pandoc has a modular design: it consists of a
diff --git a/debian/rules b/debian/rules
index 9dc6a9fce..58c192bd2 100755
--- a/debian/rules
+++ b/debian/rules
@@ -111,7 +111,7 @@ binary-arch: build install
 	dh_installexamples -a
 	dh_installman -a
 	dh_link -a
-	dh_strip -a -Xhtml2
+	dh_strip -a -Xhtml2 -Xhsmarkdown -Xmarkdown2
 	dh_compress -a
 	dh_fixperms -a
 	dh_installdeb -a
diff --git a/freebsd/Makefile.in b/freebsd/Makefile.in
index 6ca30e32c..77748dbbc 100644
--- a/freebsd/Makefile.in
+++ b/freebsd/Makefile.in
@@ -16,14 +16,14 @@ COMMENT=	A general markup converter
 BUILD_DEPENDS=	ghc>=6.6:${PORTSDIR}/lang/ghc
 
 MANCOMPRESSED=	no
-MAN1=		pandoc.1 html2markdown.1 hsmarkdown.1
+MAN1=		pandoc.1 markdown2pdf.1 html2markdown.1 hsmarkdown.1
 
 USE_GMAKE=	yes
 USE_PERL5=	yes
 
-PLIST_FILES=	bin/pandoc bin/html2markdown bin/hsmarkdown
+PLIST_FILES=	bin/pandoc bin/markdown2pdf bin/html2markdown bin/hsmarkdown
 PORTDOCS=	BUGS README README.html
-SCRIPTS=	hsmarkdown html2markdown
+SCRIPTS=	markdown2pdf hsmarkdown html2markdown
 
 do-install:
 	@${INSTALL_PROGRAM} ${WRKSRC}/dist/build/pandoc/pandoc ${PREFIX}/bin
diff --git a/freebsd/pkg-descr b/freebsd/pkg-descr
index b71af93a5..cff194cfb 100644
--- a/freebsd/pkg-descr
+++ b/freebsd/pkg-descr
@@ -1,14 +1,14 @@
 Pandoc is a command-line tool for converting from one markup format
 to another.  It can read markdown and (subsets of) reStructuredText,
 HTML, and LaTeX, and it can write markdown, reStructuredText, HTML,
-LaTeX, ConTeXt, PDF, DocBook XML, OpenDocument XML, ODT, RTF, GNU
+LaTeX, ConTeXt, DocBook XML, OpenDocument XML, ODT, RTF, GNU
 Texinfo, MediaWiki markup, groff man pages, and S5 HTML slide shows.
 
 Pandoc extends standard markdown syntax with footnotes, embedded LaTeX,
 and other features.  A compatibility mode is provided for those who
 need a drop-in replacement for Markdown.pl.  Included wrapper scripts
-make it easy to convert markdown documents to PDF or ODT format and to
-convert web pages to markdown documents.
+make it easy to convert markdown documents to PDF and to convert web
+pages to markdown documents.
 
 In contrast to existing tools for converting markdown to HTML, which
 use regex substitutions, pandoc has a modular design: it consists of a
diff --git a/macports/Portfile.in b/macports/Portfile.in
index af7fada3e..c91cf16dd 100644
--- a/macports/Portfile.in
+++ b/macports/Portfile.in
@@ -11,7 +11,7 @@ long_description    \
     Pandoc is a command-line tool for converting from one markup format \
     to another.  It can read markdown and (subsets of) reStructuredText, \
     HTML, and LaTeX, and it can write markdown, reStructuredText, HTML, \
-    LaTeX, ConTeXt, PDF, DocBook XML, OpenDocument XML, ODT, RTF, Texinfo, \
+    LaTeX, ConTeXt, DocBook XML, OpenDocument XML, ODT, RTF, Texinfo, \
     MediaWiki markup, groff man, and S5 HTML slide shows.
 
 homepage            http://johnmacfarlane.net/pandoc/
@@ -40,7 +40,7 @@ destroot            {
   xinstall -m 755 ${worksrcpath}/unregister.sh \
     ${destroot}${prefix}/libexec/${name}-${version}
   # install shell scripts:
-  xinstall -m 755 -W ${worksrcpath} html2markdown hsmarkdown \
+  xinstall -m 755 -W ${worksrcpath} html2markdown hsmarkdown markdown2pdf \
     ${destroot}${prefix}/bin
   # install data file:
   xinstall -d ${destroot}${prefix}/share/${name}
@@ -51,7 +51,7 @@ destroot            {
   xinstall -m 644 -W ${worksrcpath} README README.html COPYRIGHT BUGS \
     ${destroot}${prefix}/share/doc/${name}
   xinstall -m 644 -W ${worksrcpath}/man/man1 pandoc.1 hsmarkdown.1 \
-    html2markdown.1 \
+    markdown2pdf.1 html2markdown.1 \
     ${destroot}${prefix}/share/man/man1
 }
 
diff --git a/man/man1/markdown2pdf.1.md b/man/man1/markdown2pdf.1.md
new file mode 100644
index 000000000..0bc8329d7
--- /dev/null
+++ b/man/man1/markdown2pdf.1.md
@@ -0,0 +1,69 @@
+% MARKDOWN2PDF(1) Pandoc User Manuals
+% John MacFarlane and Recai Oktas
+% January 8, 2008
+
+# NAME
+
+markdown2pdf - converts markdown-formatted text to PDF, using pdflatex 
+
+# SYNOPSIS
+
+markdown2pdf [*options*] [*input-file*]...
+
+# DESCRIPTION
+
+`markdown2pdf` converts *input-file* (or text from standard 
+input) from markdown-formatted plain text to PDF, using `pdflatex`.
+If no output filename is specified (using the `-o` option),
+the name of the output file is derived from the input file; thus, for
+example, if the input file is *hello.txt*, the output file will be
+*hello.pdf*.  If the input is read from STDIN and no output filename
+is specified, the output file will be named *stdin.pdf*.  If multiple
+input files are specified, they will be concatenated before conversion,
+and the name of the output file will be derived from the first input file.
+
+Input is assumed to be in the UTF-8 character encoding.  If your
+local character encoding is not UTF-8, you should pipe input
+through `iconv`:
+
+    iconv -t utf-8 input.txt | markdown2pdf
+
+`markdown2pdf` assumes that the `unicode`, `array`, `fancyvrb`,
+`graphicx`, and `ulem` packages are in latex's search path. If these
+packages are not included in your latex setup, they can be obtained from
+<http://ctan.org>.
+
+# OPTIONS
+
+`markdown2pdf` is a wrapper around `pandoc`, so all of
+`pandoc`'s options can be used with `markdown2pdf` as well.
+See `pandoc`(1) for a complete list.
+The following options are most relevant:
+
+-o *FILE*, \--output=*FILE*
+:   Write output to *FILE*.
+
+\--strict
+:   Use strict markdown syntax, with no extensions or variants.
+
+-N, \--number-sections
+:   Number section headings in LaTeX output.  (Default is not to number them.)
+
+-H *FILE*, \--include-in-header=*FILE*
+:   Include (LaTeX) contents of *FILE* at the end of the header.  Implies
+    `-s`.
+
+-B *FILE*, \--include-before-body=*FILE*
+:   Include (LaTeX) contents of *FILE* at the beginning of the document body.
+
+-A *FILE*, \--include-after-body=*FILE*
+:   Include (LaTeX) contents of *FILE* at the end of the document body.
+
+-C *FILE*, \--custom-header=*FILE*
+:   Use contents of *FILE*
+    as the LaTeX document header (overriding the default header, which can be
+    printed using `pandoc -D latex`).  Implies `-s`.
+
+# SEE ALSO
+
+`pandoc`(1), `pdflatex`(1)
diff --git a/man/man1/pandoc.1.md b/man/man1/pandoc.1.md
index 15dfaa5e4..8013bd498 100644
--- a/man/man1/pandoc.1.md
+++ b/man/man1/pandoc.1.md
@@ -197,7 +197,8 @@ to Pandoc.  Or use `html2markdown`(1), a wrapper around `pandoc`.
 # SEE ALSO
 
 `hsmarkdown`(1),
-`html2markdown`(1).
+`html2markdown`(1),
+`markdown2pdf` (1).
 The *README* file distributed with Pandoc contains full documentation.
 
 The Pandoc source code and all documentation may be downloaded from
diff --git a/markdown2pdf b/markdown2pdf
new file mode 100755
index 000000000..ab0f3ae78
--- /dev/null
+++ b/markdown2pdf
@@ -0,0 +1,140 @@
+#!/bin/sh -e
+
+REQUIRED="pdflatex"
+SYNOPSIS="converts markdown-formatted text to PDF, using pdflatex."
+
+THIS=${0##*/}
+
+NEWLINE='
+'
+
+err ()  { echo "$*"   | fold -s -w ${COLUMNS:-110} >&2; }
+errn () { printf "$*" | fold -s -w ${COLUMNS:-110} >&2; }
+
+usage () {
+    err "$1 - $2" # short description
+    err "See the $1(1) man page for usage."
+}
+
+# Portable which(1).
+pathfind () {
+    oldifs="$IFS"; IFS=':'
+    for _p in $PATH; do
+        if [ -x "$_p/$*" ] && [ -f "$_p/$*" ]; then
+            IFS="$oldifs"
+            return 0
+        fi
+    done
+    IFS="$oldifs"
+    return 1
+}
+
+for p in pandoc $REQUIRED; do
+    pathfind $p || {
+        err "You need '$p' to use this program!"
+        exit 1
+    }
+done
+
+CONF=$(pandoc --dump-args "$@" 2>&1) || {
+    errcode=$?
+    echo "$CONF" | sed -e '/^pandoc \[OPTIONS\] \[FILES\]/,$d' >&2
+    [ $errcode -eq 2 ] && usage "$THIS" "$SYNOPSIS"
+    exit $errcode
+}
+
+OUTPUT=$(echo "$CONF" | sed -ne '1p')
+ARGS=$(echo "$CONF" | sed -e '1d')
+
+
+# As a security measure refuse to proceed if mktemp is not available.
+pathfind mktemp || { err "Couldn't find 'mktemp'; aborting."; exit 1;  }
+
+# Avoid issues with /tmp directory on Windows/Cygwin 
+cygwin=
+cygwin=$(uname | sed -ne '/^CYGWIN/p')
+if [ -n "$cygwin" ]; then
+    TMPDIR=.
+    export TMPDIR
+fi
+
+THIS_TEMPDIR=
+THIS_TEMPDIR="$(mktemp -d -t $THIS.XXXXXXXX)" || exit 1
+readonly THIS_TEMPDIR
+
+trap 'exitcode=$?
+      [ -z "$THIS_TEMPDIR" ] || rm -rf "$THIS_TEMPDIR"
+      exit $exitcode' 0 1 2 3 13 15
+
+texname=output
+logfile=$THIS_TEMPDIR/log
+
+pandoc -s -r markdown -w latex "$@" -o $THIS_TEMPDIR/$texname.tex
+
+if [ "$OUTPUT" = "-" ]; then
+    firstinfile="$(echo $ARGS | sed -ne '1p')"
+    firstinfilebase="${firstinfile%.*}"
+    destname="${firstinfilebase:-stdin}.pdf"
+else
+    destname="$OUTPUT"
+fi
+
+(
+    origdir=$(pwd)
+    cd $THIS_TEMPDIR
+    TEXINPUTS=$origdir:$TEXINPUTS:
+    export TEXINPUTS
+    finished=no
+    runs=0
+    while [ $finished = "no" ]; do
+      pdflatex -interaction=batchmode $texname.tex >/dev/null || {
+        errcode=$?
+        err "${THIS}: pdfLaTeX failed with error code $errcode"
+        [ -f $texname.log ] && {
+          err "${THIS}: error context:"
+          sed -ne '/^!/,/^[[:space:]]*$/p' \
+            -ne '/^[Ll]a[Tt]e[Xx] [Ww]arning/,/^[[:space:]]*$/p' \
+            -ne '/^[Ee]rror/,/^[[:space:]]*$/p' $texname.log >&2
+          if grep -q "File \`ucs.sty' not found" $texname.log; then
+            err "${THIS}: Please install the 'unicode' package from CTAN:"
+            err "  http://www.ctan.org/tex-archive/macros/latex/contrib/unicode/"
+          fi
+          if grep -q "File \`ulem.sty' not found" $texname.log; then
+            err "${THIS}: Please install the 'ulem' package from CTAN:"
+            err "  http://www.ctan.org/tex-archive/macros/latex/contrib/misc/ulem.sty"
+          fi
+        }
+        exit $errcode
+      }
+      if [ $runs -lt 3 ] && 
+      ((grep -q "LaTeX Warning: There were undefined references." $texname.log) ||
+       (echo "$@" | grep -q -- "--toc\|--table-of-contents")); then
+        runs=$(($runs + 1))
+        if grep -q "LaTeX Warning:.*[Cc]itation" $texname.log; then
+          bibtex $texname 2>&1 >bibtex.err
+          if [ $runs -gt 2 ]; then
+            if grep -q "error message" bibtex.err ||
+            grep -q "Warning" bibtex.err; then
+              cat bibtex.err >&2
+            fi
+          fi
+        fi
+      else
+        finished=yes
+      fi
+    done
+) || exit $?
+
+is_target_exists=
+if [ -f "$destname" ]; then
+    is_target_exists=1
+    mv "$destname" "$destname~" 
+fi
+
+mv -f $THIS_TEMPDIR/$texname.pdf "$destname"
+
+errn "Created $destname"
+[ -z "$is_target_exists" ] || {
+    errn " (previous file has been backed up as $destname~)"
+}
+err .
diff --git a/pandoc.cabal b/pandoc.cabal
index a58eb1ddf..a68a21278 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -18,7 +18,7 @@ Description:     Pandoc is a Haskell library for converting from one markup
                  this library. It can read markdown and (subsets of)
                  reStructuredText, HTML, and LaTeX, and it can write
                  markdown, reStructuredText, HTML, LaTeX, ConTeXt, Docbook,
-                 OpenDocument, ODT, PDF, RTF, MediaWiki, groff man pages, and
+                 OpenDocument, ODT, RTF, MediaWiki, groff man pages, and
                  S5 HTML slide shows.
                  .
                  Pandoc extends standard markdown syntax with footnotes,
@@ -159,7 +159,6 @@ Library
                    Text.Pandoc.CharacterReferences,
                    Text.Pandoc.Shared,
                    Text.Pandoc.ODT,
-                   Text.Pandoc.PDF,
                    Text.Pandoc.LaTeXMathML,
                    Text.Pandoc.DefaultHeaders,
                    Text.Pandoc.Highlighting,
diff --git a/web/demos b/web/demos
index 976e4ad7e..453e59955 100644
--- a/web/demos
+++ b/web/demos
@@ -61,11 +61,11 @@ click on the name of the output file:
 
 13. From markdown to PDF:
 
-@   pandoc @@README@@ -o @@example13.pdf@@
+@   markdown2pdf @@README@@ -o @@example13.pdf@@
 
 14. PDF with numbered sections and a custom LaTeX header:
 
-@   pandoc -N -C @@myheader.tex@@ @@README@@ -o @@example14.pdf@@
+@   markdown2pdf -N -C @@myheader.tex@@ @@README@@ -o @@example14.pdf@@
 
 [xmlto]:  http://cyberelk.net/tim/xmlto/
 
diff --git a/web/index.txt.in b/web/index.txt.in
index 5894e1f70..8b3c66e3a 100644
--- a/web/index.txt.in
+++ b/web/index.txt.in
@@ -34,6 +34,8 @@ Pandoc features
     + Compatibility mode to turn off syntax entensions and emulate
       `Markdown.pl`.
 - Convenient wrapper scripts:
+    + `markdown2pdf` converts directly from markdown to PDF, using
+      `pdflatex`.
     + `html2markdown` makes it easy to produce a markdown version
       of any web page.
     + `hsmarkdown` is a drop-in replacement for `Markdown.pl`.
@@ -49,6 +51,7 @@ or [try pandoc on the web](/pandoc/try).
 - [Demonstrations](examples.html)
 - Man pages
     - [`pandoc(1)`](pandoc.1.html)
+    - [`markdown2pdf(1)`](markdown2pdf.1.html)
     - [`html2markdown(1)`](html2markdown.1.html)
     - [`hsmarkdown(1)`](hsmarkdown.1.html)
 - [Library documentation](doc/pandoc/index.html) (for Haskell programmers)
-- 
cgit v1.2.3