- Page breaks (five "*")
- Headings with anchors (make it round trip with Muse writer)
-- Verse markup (">")
- Org tables
- table.el tables
- Images with attributes (floating and width)
@@ -101,6 +101,9 @@ parseBlocks = do
-- utility functions
--
+eol :: Stream s m Char => ParserT s st m ()
+eol = void newline <|> eof
+
nested :: PandocMonad m => MuseParser m a -> MuseParser m a
nested p = do
nestlevel <- stateMaxNestingLevel <$> getState
@@ -180,7 +183,9 @@ blockElements = choice [ comment
, centerTag
, rightTag
, quoteTag
+ , divTag
, verseTag
+ , lineBlock
, bulletList
, orderedList
, definitionList
@@ -194,7 +199,7 @@ comment = try $ do
char ';'
space
many $ noneOf "\n"
- void newline <|> eof
+ eol
return mempty
separator :: PandocMonad m => MuseParser m (F Blocks)
@@ -202,7 +207,7 @@ separator = try $ do
string "----"
many $ char '-'
many spaceChar
- void newline <|> eof
+ eol
return $ return B.horizontalRule
header :: PandocMonad m => MuseParser m (F Blocks)
@@ -212,8 +217,8 @@ header = try $ do
getPosition >>= \pos -> guard (st == NullState && q == NoQuote && sourceColumn pos == 1)
level <- liftM length $ many1 $ char '*'
guard $ level <= 5
- skipSpaces
- content <- trimInlinesF . mconcat <$> manyTill inline newline
+ spaceChar
+ content <- trimInlinesF . mconcat <$> manyTill inline eol
attr <- registerHeader ("", [], []) (runF content defaultParserState)
return $ B.headerWith attr level <$> content
@@ -245,6 +250,12 @@ rightTag = blockTag id "right"
quoteTag :: PandocMonad m => MuseParser m (F Blocks)
quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote"
+-- tag is supported by Emacs Muse, but not Amusewiki 2.025
+divTag :: PandocMonad m => MuseParser m (F Blocks)
+divTag = do
+ (attrs, content) <- parseHtmlContentWithAttrs "div" block
+ return $ (B.divWith attrs) <$> mconcat content
+
verseLine :: PandocMonad m => MuseParser m String
verseLine = do
line <- anyLine <|> many1Till anyChar eof
@@ -261,8 +272,7 @@ verseLines = do
verseTag :: PandocMonad m => MuseParser m (F Blocks)
verseTag = do
(_, content) <- htmlElement "verse"
- parsedContent <- parseFromString verseLines content
- return parsedContent
+ parseFromString verseLines content
commentTag :: PandocMonad m => MuseParser m (F Blocks)
commentTag = parseHtmlContent "comment" anyChar >> return mempty
@@ -299,6 +309,26 @@ noteBlock = try $ do
blocksTillNote =
many1Till block (eof <|> () <$ lookAhead noteMarker)
+--
+-- Verse markup
+--
+
+lineVerseLine :: PandocMonad m => MuseParser m String
+lineVerseLine = try $ do
+ char '>'
+ white <- many1 (char ' ' >> pure '\160')
+ rest <- anyLine
+ return $ tail white ++ rest
+
+blanklineVerseLine :: PandocMonad m => MuseParser m Char
+blanklineVerseLine = try $ char '>' >> blankline
+
+lineBlock :: PandocMonad m => MuseParser m (F Blocks)
+lineBlock = try $ do
+ lns <- many1 (pure <$> blanklineVerseLine <|> lineVerseLine)
+ lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns
+ return $ B.lineBlock <$> sequence lns'
+
--
-- lists
--
@@ -379,8 +409,8 @@ definitionListItem = try $ do
pure $ do lineContent' <- lineContent
pure (B.text term, [lineContent'])
where
- termParser = (many1 spaceChar) >> -- Initial space as required by Amusewiki, but not Emacs Muse
- (many1Till anyChar $ lookAhead (void (try (spaceChar >> string "::")) <|> void newline))
+ termParser = many1 spaceChar >> -- Initial space as required by Amusewiki, but not Emacs Muse
+ many1Till anyChar (lookAhead (void (try (spaceChar >> string "::")) <|> void newline))
endOfInput = try $ skipMany blankline >> skipSpaces >> eof
twoBlankLines = try $ blankline >> skipMany1 blankline
newDefinitionListItem = try $ void termParser
@@ -438,10 +468,10 @@ museAppendElement tbl element =
tableCell :: PandocMonad m => MuseParser m (F Blocks)
tableCell = try $ liftM B.plain . trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd)
- where cellEnd = try $ void (many1 spaceChar >> char '|') <|> void newline <|> eof
+ where cellEnd = try $ void (many1 spaceChar >> char '|') <|> eol
tableElements :: PandocMonad m => MuseParser m [MuseTableElement]
-tableElements = tableParseElement `sepEndBy1` (void newline <|> eof)
+tableElements = tableParseElement `sepEndBy1` eol
elementsToTable :: [MuseTableElement] -> F MuseTable
elementsToTable = foldM museAppendElement emptyTable
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 190b065fb..daaeff2f0 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -219,7 +219,6 @@ block = choice [ codeBlock
, directive
, anchor
, comment
- , include
, header
, hrule
, lineBlock -- must go before definitionList
@@ -460,16 +459,16 @@ tab-width
encoding
-}
-include :: PandocMonad m => RSTParser m Blocks
-include = try $ do
- string ".. include::"
- skipMany spaceChar
- f <- trim <$> anyLine
- fields <- many $ rawFieldListItem 3
+includeDirective :: PandocMonad m
+ => String -> [(String, String)] -> String
+ -> RSTParser m Blocks
+includeDirective top fields body = do
+ let f = trim top
+ guard $ not (null f)
+ guard $ null (trim body)
-- options
let (startLine :: Maybe Int) = lookup "start-line" fields >>= safeRead
let (endLine :: Maybe Int) = lookup "end-line" fields >>= safeRead
- guard $ not (null f)
oldPos <- getPosition
oldInput <- getInput
containers <- stateContainers <$> getState
@@ -501,7 +500,7 @@ include = try $ do
Just patt -> drop 1 .
dropWhile (not . (patt `isInfixOf`))
Nothing -> id) $ contentLines'
- let contents' = unlines contentLines''
+ let contents' = unlines contentLines'' ++ "\n"
case lookup "code" fields of
Just lang -> do
let numberLines = lookup "number-lines" fields
@@ -687,6 +686,7 @@ directive' = do
$ lookup "height" fields >>=
(lengthToDim . filter (not . isSpace))
case label of
+ "include" -> includeDirective top fields body'
"table" -> tableDirective top fields body'
"list-table" -> listTableDirective top fields body'
"csv-table" -> csvTableDirective top fields body'
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 9ac37a0ba..1641b991c 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -47,7 +47,7 @@ import Control.Monad.State.Strict
import Data.Char (ord, toLower)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
-import Data.List (intersperse, isPrefixOf)
+import Data.List (intersperse, isPrefixOf, partition, intercalate)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Monoid ((<>))
import qualified Data.Set as Set
@@ -569,8 +569,15 @@ imgAttrsToHtml opts attr = do
isNotDim _ = True
dimensionsToAttrList :: Attr -> [(String, String)]
-dimensionsToAttrList attr = (go Width) ++ (go Height)
+dimensionsToAttrList attr = consolidateStyles $ go Width ++ go Height
where
+ consolidateStyles :: [(String, String)] -> [(String, String)]
+ consolidateStyles xs =
+ case partition isStyle xs of
+ ([], _) -> xs
+ (ss, rest) -> ("style", intercalate ";" $ map snd ss) : rest
+ isStyle ("style", _) = True
+ isStyle _ = False
go dir = case (dimension dir attr) of
(Just (Pixel a)) -> [(show dir, show a)]
(Just x) -> [("style", show dir ++ ":" ++ show x)]
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 4a81cd245..2da087077 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -628,6 +628,7 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
put $ st {stOLLevel = oldlevel + 1}
items <- mapM listItemToLaTeX lst
modify (\s -> s {stOLLevel = oldlevel})
+ let beamer = stBeamer st
let tostyle x = case numstyle of
Decimal -> "\\arabic" <> braces x
UpperRoman -> "\\Roman" <> braces x
@@ -641,11 +642,21 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
TwoParens -> parens x
Period -> x <> "."
_ -> x <> "."
+ let exemplar = case numstyle of
+ Decimal -> "1"
+ UpperRoman -> "I"
+ LowerRoman -> "i"
+ UpperAlpha -> "A"
+ LowerAlpha -> "a"
+ Example -> "1"
+ DefaultStyle -> "1"
let enum = text $ "enum" ++ map toLower (toRomanNumeral oldlevel)
let stylecommand = if numstyle == DefaultStyle && numdelim == DefaultDelim
then empty
- else "\\def" <> "\\label" <> enum <>
- braces (todelim $ tostyle enum)
+ else if beamer
+ then brackets (todelim exemplar)
+ else "\\def" <> "\\label" <> enum <>
+ braces (todelim $ tostyle enum)
let resetcounter = if start == 1 || oldlevel > 4
then empty
else "\\setcounter" <> braces enum <>
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 95977ce17..0221ba6ef 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -288,6 +288,7 @@ escapeString opts (c:cs) =
| otherwise -> ">" ++ escapeString opts cs
_ | c `elem` ['\\','`','*','_','[',']','#'] ->
'\\':c:escapeString opts cs
+ '|' | isEnabled Ext_pipe_tables opts -> '\\':'|':escapeString opts cs
'^' | isEnabled Ext_superscript opts -> '\\':'^':escapeString opts cs
'~' | isEnabled Ext_subscript opts -> '\\':'~':escapeString opts cs
'$' | isEnabled Ext_tex_math_dollars opts -> '\\':'$':escapeString opts cs
@@ -787,6 +788,7 @@ blockListToMarkdown :: PandocMonad m
-> MD m Doc
blockListToMarkdown opts blocks = do
inlist <- asks envInList
+ isPlain <- asks envPlain
-- a) insert comment between list and indented code block, or the
-- code block will be treated as a list continuation paragraph
-- b) change Plain to Para unless it's followed by a RawBlock
@@ -813,9 +815,11 @@ blockListToMarkdown opts blocks = do
isListBlock (OrderedList _ _) = True
isListBlock (DefinitionList _) = True
isListBlock _ = False
- commentSep = if isEnabled Ext_raw_html opts
- then RawBlock "html" "\n"
- else RawBlock "markdown" " \n"
+ commentSep = if isPlain
+ then Null
+ else if isEnabled Ext_raw_html opts
+ then RawBlock "html" "\n"
+ else RawBlock "markdown" " \n"
mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat
getKey :: Doc -> Key
@@ -931,7 +935,7 @@ avoidBadWrapsInList (s:Str cs:[])
avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs
isOrderedListMarker :: String -> Bool
-isOrderedListMarker xs = (last xs `elem` ['.',')']) &&
+isOrderedListMarker xs = not (null xs) && (last xs `elem` ['.',')']) &&
isRight (runParser (anyOrderedListMarker >> eof)
defaultParserState "" xs)
@@ -946,11 +950,10 @@ inlineToMarkdown opts (Span attrs ils) = do
contents <- inlineListToMarkdown opts ils
return $ case plain of
True -> contents
- False | isEnabled Ext_bracketed_spans opts ->
+ False | attrs == nullAttr -> contents
+ | isEnabled Ext_bracketed_spans opts ->
"[" <> contents <> "]" <>
- if attrs == nullAttr
- then "{}"
- else linkAttributes opts attrs
+ linkAttributes opts attrs
| isEnabled Ext_raw_html opts ||
isEnabled Ext_native_spans opts ->
tagWithAttrs "span" attrs <> contents <> text ""
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 48f17c4fb..88f42acd4 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -129,36 +129,25 @@ blockToOrg (Div (_,classes@(cls:_),kvs) bs) | "drawer" `elem` classes = do
blankline $$ contents $$
blankline $$ drawerEndTag $$
blankline
-blockToOrg (Div attrs bs) = do
+blockToOrg (Div (ident, classes, kv) bs) = do
contents <- blockListToOrg bs
+ -- if one class looks like the name of a greater block then output as such:
+ -- The ID, if present, is added via the #+NAME keyword; other classes and
+ -- key-value pairs are kept as #+ATTR_HTML attributes.
let isGreaterBlockClass = (`elem` ["center", "quote"]) . map toLower
- return $ case attrs of
- ("", [], []) ->
- -- nullAttr, treat contents as if it wasn't wrapped
- blankline $$ contents $$ blankline
- (ident, [], []) ->
- -- only an id: add id as an anchor, unwrap the rest
- blankline $$ "<<" <> text ident <> ">>" $$ contents $$ blankline
- (ident, classes, kv) ->
- -- if one class looks like the name of a greater block then output as
- -- such: The ID, if present, is added via the #+NAME keyword; other
- -- classes and key-value pairs are kept as #+ATTR_HTML attributes.
- let
- (blockTypeCand, classes') = partition isGreaterBlockClass classes
- in case blockTypeCand of
- (blockType:classes'') ->
- blankline $$ attrHtml (ident, classes'' <> classes', kv) $$
- "#+BEGIN_" <> text blockType $$ contents $$
- "#+END_" <> text blockType $$ blankline
- _ ->
- -- fallback: wrap in div tags
- let
- startTag = tagWithAttrs "div" attrs
- endTag = text "
"
- in blankline $$ "#+BEGIN_HTML" $$
- nest 2 startTag $$ "#+END_HTML" $$ blankline $$
- contents $$ blankline $$ "#+BEGIN_HTML" $$
- nest 2 endTag $$ "#+END_HTML" $$ blankline
+ (blockTypeCand, classes') = partition isGreaterBlockClass classes
+ return $ case blockTypeCand of
+ (blockType:classes'') ->
+ blankline $$ attrHtml (ident, classes'' <> classes', kv) $$
+ "#+BEGIN_" <> text blockType $$ contents $$
+ "#+END_" <> text blockType $$ blankline
+ _ ->
+ -- fallback with id: add id as an anchor if present, discard classes and
+ -- key-value pairs, unwrap the content.
+ let contents' = if not (null ident)
+ then "<<" <> text ident <> ">>" $$ contents
+ else contents
+ in blankline $$ contents' $$ blankline
blockToOrg (Plain inlines) = inlineListToOrg inlines
-- title beginning with fig: indicates that the image is a figure
blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
@@ -173,7 +162,7 @@ blockToOrg (Para inlines) = do
blockToOrg (LineBlock lns) = do
let splitStanza [] = []
splitStanza xs = case break (== mempty) xs of
- (l, []) -> l : []
+ (l, []) -> [l]
(l, _:r) -> l : splitStanza r
let joinWithLinefeeds = nowrap . mconcat . intersperse cr
let joinWithBlankLines = mconcat . intersperse blankline
@@ -213,7 +202,7 @@ blockToOrg (Table caption' _ _ headers rows) = do
caption'' <- inlineListToOrg caption'
let caption = if null caption'
then empty
- else ("#+CAPTION: " <> caption'')
+ else "#+CAPTION: " <> caption''
headers' <- mapM blockListToOrg headers
rawRows <- mapM (mapM blockListToOrg) rows
let numChars = maximum . map offset
@@ -289,8 +278,8 @@ propertiesDrawer (ident, classes, kv) =
let
drawerStart = text ":PROPERTIES:"
drawerEnd = text ":END:"
- kv' = if (classes == mempty) then kv else ("CLASS", unwords classes):kv
- kv'' = if (ident == mempty) then kv' else ("CUSTOM_ID", ident):kv'
+ kv' = if classes == mempty then kv else ("CLASS", unwords classes):kv
+ kv'' = if ident == mempty then kv' else ("CUSTOM_ID", ident):kv'
properties = vcat $ map kvToOrgProperty kv''
in
drawerStart <> cr <> properties <> cr <> drawerEnd
@@ -303,7 +292,7 @@ attrHtml :: Attr -> Doc
attrHtml ("" , [] , []) = mempty
attrHtml (ident, classes, kvs) =
let
- name = if (null ident) then mempty else "#+NAME: " <> text ident <> cr
+ name = if null ident then mempty else "#+NAME: " <> text ident <> cr
keyword = "#+ATTR_HTML"
classKv = ("class", unwords classes)
kvStrings = map (\(k,v) -> ":" <> k <> " " <> v) (classKv:kvs)
@@ -370,19 +359,19 @@ inlineToOrg SoftBreak = do
WrapPreserve -> return cr
WrapAuto -> return space
WrapNone -> return space
-inlineToOrg (Link _ txt (src, _)) = do
+inlineToOrg (Link _ txt (src, _)) =
case txt of
[Str x] | escapeURI x == src -> -- autolink
- do return $ "[[" <> text (orgPath x) <> "]]"
+ return $ "[[" <> text (orgPath x) <> "]]"
_ -> do contents <- inlineListToOrg txt
return $ "[[" <> text (orgPath src) <> "][" <> contents <> "]]"
-inlineToOrg (Image _ _ (source, _)) = do
+inlineToOrg (Image _ _ (source, _)) =
return $ "[[" <> text (orgPath source) <> "]]"
inlineToOrg (Note contents) = do
-- add to notes in state
notes <- gets stNotes
modify $ \st -> st { stNotes = contents:notes }
- let ref = show $ (length notes) + 1
+ let ref = show $ length notes + 1
return $ "[fn:" <> text ref <> "]"
orgPath :: String -> String
diff --git a/stack.pkg.yaml b/stack.pkg.yaml
index d9de4fdd9..c93c9e920 100644
--- a/stack.pkg.yaml
+++ b/stack.pkg.yaml
@@ -14,7 +14,7 @@ packages:
- '.'
- location:
git: https://github.com/jgm/pandoc-citeproc.git
- commit: 71ca48b6e0044ea959d8e7882b03cceba9c7960c
+ commit: 5a7f26b61c8577916093851cdeb31fa9a198edcb
extra-dep: false
extra-deps:
- hslua-0.8.0
diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs
index 1f3218daf..dac167a92 100644
--- a/test/Tests/Readers/Muse.hs
+++ b/test/Tests/Readers/Muse.hs
@@ -145,6 +145,38 @@ tests =
, " with a continuation"
] =?>
blockQuote (para "This is a quotation with a continuation")
+ , testGroup "Div"
+ [ "Div without id" =:
+ "Foo bar
" =?>
+ divWith nullAttr (para "Foo bar")
+ , "Div with id" =:
+ "Foo bar
" =?>
+ divWith ("foo", [], []) (para "Foo bar")
+ ]
+ , "Verse" =:
+ T.unlines [ "> This is"
+ , "> First stanza"
+ , ">" -- Emacs produces verbatim ">" here, we follow Amusewiki
+ , "> And this is"
+ , "> Second stanza"
+ , ">"
+ , ""
+ , ">"
+ , ""
+ , "> Another verse"
+ , "> is here"
+ ] =?>
+ lineBlock [ "This is"
+ , "First stanza"
+ , ""
+ , "And this is"
+ , "\160\160Second stanza"
+ , ""
+ ] <>
+ lineBlock [ "" ] <>
+ lineBlock [ "Another verse"
+ , "\160\160\160is here"
+ ]
]
, "Quote tag" =: "Hello, world
" =?> blockQuote (para $ text "Hello, world")
, "Verse tag" =:
@@ -178,20 +210,21 @@ tests =
]
, testGroup "Headers"
[ "Part" =:
- "* First level\n" =?>
+ "* First level" =?>
header 1 "First level"
, "Chapter" =:
- "** Second level\n" =?>
+ "** Second level" =?>
header 2 "Second level"
, "Section" =:
- "*** Third level\n" =?>
+ "*** Third level" =?>
header 3 "Third level"
, "Subsection" =:
- "**** Fourth level\n" =?>
+ "**** Fourth level" =?>
header 4 "Fourth level"
, "Subsubsection" =:
- "***** Fifth level\n" =?>
+ "***** Fifth level" =?>
header 5 "Fifth level"
+ , "Whitespace is required after *" =: "**Not a header" =?> para "**Not a header"
, "No headers in footnotes" =:
T.unlines [ "Foo[1]"
, "[1] * Bar"
diff --git a/test/Tests/Readers/RST.hs b/test/Tests/Readers/RST.hs
index 61a2673f5..928fc1a99 100644
--- a/test/Tests/Readers/RST.hs
+++ b/test/Tests/Readers/RST.hs
@@ -136,6 +136,19 @@ tests = [ "line block with blank line" =:
para "but must stop here")
, "line block with 3 lines" =: "| a\n| b\n| c"
=?> lineBlock ["a", "b", "c"]
+ , "line blocks with blank lines" =: T.unlines
+ [ "|"
+ , ""
+ , "|"
+ , "| a"
+ , "| b"
+ , "|"
+ , ""
+ , "|"
+ ] =?>
+ lineBlock [""] <>
+ lineBlock ["", "a", "b", ""] <>
+ lineBlock [""]
, "quoted literal block using >" =: "::\n\n> quoted\n> block\n\nOrdinary paragraph"
=?> codeBlock "> quoted\n> block" <> para "Ordinary paragraph"
, "quoted literal block using | (not a line block)" =: "::\n\n| quoted\n| block\n\nOrdinary paragraph"
diff --git a/test/command/3497.md b/test/command/3497.md
index 326817b0d..ca591cdd6 100644
--- a/test/command/3497.md
+++ b/test/command/3497.md
@@ -46,6 +46,6 @@ Also escape things that might become line blocks or tables:
% pandoc -t markdown
\| hi \|
^D
-\| hi |
+\| hi \|
```
diff --git a/test/command/3771.md b/test/command/3771.md
new file mode 100644
index 000000000..1d3a75ae1
--- /dev/null
+++ b/test/command/3771.md
@@ -0,0 +1,14 @@
+```
+% pandoc -f html -t org
+
+ Today is a nice day.
+
+
+ Tomorrow will be rainy.
+
+^D
+Today is a nice day.
+
+<>
+Tomorrow will be rainy.
+```
diff --git a/test/command/3880.md b/test/command/3880.md
new file mode 100644
index 000000000..b8edaf08f
--- /dev/null
+++ b/test/command/3880.md
@@ -0,0 +1,6 @@
+```
+pandoc -f rst -t native
+.. include:: command/3880.txt
+^D
+[Para [Str "hi"]]
+```
diff --git a/test/command/3880.txt b/test/command/3880.txt
new file mode 100644
index 000000000..45b983be3
--- /dev/null
+++ b/test/command/3880.txt
@@ -0,0 +1 @@
+hi
diff --git a/test/writers-lang-and-dir.latex b/test/writers-lang-and-dir.latex
index b8481c879..ae29cd1bb 100644
--- a/test/writers-lang-and-dir.latex
+++ b/test/writers-lang-and-dir.latex
@@ -44,6 +44,12 @@
\let\oldsubparagraph\subparagraph
\renewcommand{\subparagraph}[1]{\oldsubparagraph{#1}\mbox{}}
\fi
+
+% set default figure placement to htbp
+\makeatletter
+\def\fps@figure{htbp}
+\makeatother
+
\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex
\usepackage[shorthands=off,ngerman,british,nswissgerman,spanish,french,main=english]{babel}
\newcommand{\textgerman}[2][]{\foreignlanguage{ngerman}{#2}}
@@ -77,12 +83,6 @@
\newenvironment{LTR}{\beginL}{\endL}
\fi
-% set default figure placement to htbp
-\makeatletter
-\def\fps@figure{htbp}
-\makeatother
-
-
\date{}
\begin{document}
diff --git a/tools/pandoc-template-mode.el b/tools/pandoc-template-mode.el
new file mode 100644
index 000000000..7a6346458
--- /dev/null
+++ b/tools/pandoc-template-mode.el
@@ -0,0 +1,58 @@
+ ;;; pandoc-template-mode.el --- Pandoc-Template major mode
+
+;; Copyright (C) 2017
+
+;; Author: Václav Haisman
+;; Keywords: extensions
+
+;; This file 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, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+ ;;; Commentary:
+
+;;
+
+ ;;; Code:
+
+(defvar pandoc-template-font-lock-keywords
+ '(("\\(\\$\\)\\(if\\|for\\)(\\([^)]+\\))\\(\\$\\)"
+ (1 font-lock-preprocessor-face)
+ (2 font-lock-keyword-face)
+ (3 font-lock-variable-name-face)
+ (4 font-lock-preprocessor-face))
+ ("\\(\\$\\)\\(endif\\|endfor\\|else\\)\\(\\$\\)"
+ (1 font-lock-preprocessor-face)
+ (2 font-lock-keyword-face)
+ (3 font-lock-preprocessor-face))
+ ("\\(\\$\\)\\(sep\\)\\(\\$\\)"
+ (1 font-lock-preprocessor-face)
+ (2 font-lock-builtin-face)
+ (3 font-lock-preprocessor-face))
+ ("\\(\\$\\)\\([^$]+\\)\\(\\$\\)"
+ (1 font-lock-preprocessor-face)
+ (2 font-lock-variable-name-face)
+ (3 font-lock-preprocessor-face))
+ )
+ "Keyword highlighting specification for `pandoc-template-mode'.")
+
+ ;;;###autoload
+(define-derived-mode pandoc-template-mode fundamental-mode "Pandoc-Template"
+ "A major mode for editing Pandoc-Template files."
+ :syntax-table nil
+ (setq-local font-lock-defaults
+ '(pandoc-template-font-lock-keywords)))
+
+(provide 'pandoc-template-mode)
+ ;;; pandoc-template.el ends here