diff options
Diffstat (limited to 'src/Text')
62 files changed, 2589 insertions, 762 deletions
diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index e49fef3b5..3f46648a2 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -207,18 +207,18 @@ parseFormatSpec = parse formatSpec "" data Reader = StringReader (ReaderOptions -> String -> IO (Either PandocError Pandoc)) | ByteStringReader (ReaderOptions -> BL.ByteString -> IO (Either PandocError (Pandoc,MediaBag))) -mkStringReader :: (ReaderOptions -> String -> (Either PandocError Pandoc)) -> Reader +mkStringReader :: (ReaderOptions -> String -> Either PandocError Pandoc) -> Reader mkStringReader r = StringReader (\o s -> return $ r o s) mkStringReaderWithWarnings :: (ReaderOptions -> String -> Either PandocError (Pandoc, [String])) -> Reader -mkStringReaderWithWarnings r = StringReader $ \o s -> do +mkStringReaderWithWarnings r = StringReader $ \o s -> case r o s of Left err -> return $ Left err Right (doc, warnings) -> do mapM_ warn warnings return (Right doc) -mkBSReader :: (ReaderOptions -> BL.ByteString -> (Either PandocError (Pandoc, MediaBag))) -> Reader +mkBSReader :: (ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag)) -> Reader mkBSReader r = ByteStringReader (\o s -> return $ r o s) -- | Association list of formats and readers. @@ -266,7 +266,7 @@ writers = [ ,("html" , PureStringWriter writeHtmlString) ,("html5" , PureStringWriter $ \o -> writeHtmlString o{ writerHtml5 = True }) - ,("icml" , PureStringWriter writeICML) + ,("icml" , IOStringWriter writeICML) ,("s5" , PureStringWriter $ \o -> writeHtmlString o{ writerSlideVariant = S5Slides , writerTableOfContents = False }) @@ -330,7 +330,7 @@ getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers] getReader :: String -> Either String Reader getReader s = case parseFormatSpec s of - Left e -> Left $ intercalate "\n" $ [m | Message m <- errorMessages e] + Left e -> Left $ intercalate "\n" [m | Message m <- errorMessages e] Right (readerName, setExts) -> case lookup readerName readers of Nothing -> Left $ "Unknown reader: " ++ readerName @@ -345,7 +345,7 @@ getReader s = getWriter :: String -> Either String Writer getWriter s = case parseFormatSpec s of - Left e -> Left $ intercalate "\n" $ [m | Message m <- errorMessages e] + Left e -> Left $ intercalate "\n" [m | Message m <- errorMessages e] Right (writerName, setExts) -> case lookup writerName writers of Nothing -> Left $ "Unknown writer: " ++ writerName diff --git a/src/Text/Pandoc/CSS.hs b/src/Text/Pandoc/CSS.hs index 9d0c84243..f479ed9d0 100644 --- a/src/Text/Pandoc/CSS.hs +++ b/src/Text/Pandoc/CSS.hs @@ -1,5 +1,6 @@ -module Text.Pandoc.CSS ( foldOrElse, - pickStyleAttrProps +module Text.Pandoc.CSS ( foldOrElse + , pickStyleAttrProps + , pickStylesToKVs ) where @@ -10,13 +11,11 @@ import Text.Parsec.String ruleParser :: Parser (String, String) ruleParser = do p <- many1 (noneOf ":") <* char ':' - v <- many1 (noneOf ":;") <* char ';' <* spaces + v <- many1 (noneOf ":;") <* (optional $ char ';') <* spaces return (trim p, trim v) styleAttrParser :: Parser [(String, String)] -styleAttrParser = do - p <- many1 ruleParser - return p +styleAttrParser = many1 ruleParser orElse :: Eq a => a -> a -> a -> a orElse v x y = if v == x then y else x @@ -28,6 +27,16 @@ eitherToMaybe :: Either a b -> Maybe b eitherToMaybe (Right x) = Just x eitherToMaybe _ = Nothing +-- | takes a list of keys/properties and a CSS string and +-- returns the corresponding key-value-pairs. +pickStylesToKVs :: [String] -> String -> [(String, String)] +pickStylesToKVs props styleAttr = + case parse styleAttrParser "" styleAttr of + Left _ -> [] + Right styles -> filter (\s -> fst s `elem` props) styles + +-- | takes a list of key/property synonyms and a CSS string and maybe +-- returns the value of the first match (in order of the supplied list) pickStyleAttrProps :: [String] -> String -> Maybe String pickStyleAttrProps lookupProps styleAttr = do styles <- eitherToMaybe $ parse styleAttrParser "" styleAttr diff --git a/src/Text/Pandoc/Compat/Monoid.hs b/src/Text/Pandoc/Compat/Monoid.hs new file mode 100644 index 000000000..4daceb8e1 --- /dev/null +++ b/src/Text/Pandoc/Compat/Monoid.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE CPP #-} +module Text.Pandoc.Compat.Monoid ( (<>) ) + where + +#if MIN_VERSION_base(4,5,0) +import Data.Monoid ((<>)) + +#else +import Data.Monoid + +infixr 6 <> + +--- | An infix synonym for 'mappend'. +(<>) :: Monoid m => m -> m -> m +(<>) = mappend +{-# INLINE (<>) #-} +#endif diff --git a/src/Text/Pandoc/Data.hsb b/src/Text/Pandoc/Data.hsb index 3a0bf8ac4..d408bf510 100644 --- a/src/Text/Pandoc/Data.hsb +++ b/src/Text/Pandoc/Data.hsb @@ -2,6 +2,14 @@ -- to be processed using hsb2hs module Text.Pandoc.Data (dataFiles) where import qualified Data.ByteString as B +import System.FilePath (splitDirectories) +import qualified System.FilePath.Posix as Posix +-- We ensure that the data files are stored using Posix +-- path separators (/), even on Windows. dataFiles :: [(FilePath, B.ByteString)] -dataFiles = ("README", %blob "README") : %blobs "data"
\ No newline at end of file +dataFiles = map (\(fp, contents) -> + (Posix.joinPath (splitDirectories fp), contents)) dataFiles' + +dataFiles' :: [(FilePath, B.ByteString)] +dataFiles' = ("README", %blob "README") : %blobs "data" diff --git a/src/Text/Pandoc/Emoji.hs b/src/Text/Pandoc/Emoji.hs new file mode 100644 index 000000000..c9f368abc --- /dev/null +++ b/src/Text/Pandoc/Emoji.hs @@ -0,0 +1,906 @@ +{- +Copyright (C) 2015 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.Emoji + Copyright : Copyright (C) 2015 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm@berkeley.edu> + Stability : alpha + Portability : portable + +Emoji symbol lookup from canonical string identifier. +-} +module Text.Pandoc.Emoji ( emojis ) where +import qualified Data.Map as M + +emojis :: M.Map String String +emojis = M.fromList + [("+1","\128077") + ,("-1","\128078") + ,("100","\128175") + ,("1234","\128290") + ,("8ball","\127921") + ,("a","\127344\65039") + ,("ab","\127374") + ,("abc","\128292") + ,("abcd","\128289") + ,("accept","\127569") + ,("aerial_tramway","\128673") + ,("airplane","\9992\65039") + ,("alarm_clock","\9200") + ,("alien","\128125") + ,("ambulance","\128657") + ,("anchor","\9875") + ,("angel","\128124") + ,("anger","\128162") + ,("angry","\128544") + ,("anguished","\128551") + ,("ant","\128028") + ,("apple","\127822") + ,("aquarius","\9810") + ,("aries","\9800") + ,("arrow_backward","\9664\65039") + ,("arrow_double_down","\9196") + ,("arrow_double_up","\9195") + ,("arrow_down","\11015\65039") + ,("arrow_down_small","\128317") + ,("arrow_forward","\9654\65039") + ,("arrow_heading_down","\10549\65039") + ,("arrow_heading_up","\10548\65039") + ,("arrow_left","\11013\65039") + ,("arrow_lower_left","\8601\65039") + ,("arrow_lower_right","\8600\65039") + ,("arrow_right","\10145\65039") + ,("arrow_right_hook","\8618\65039") + ,("arrow_up","\11014\65039") + ,("arrow_up_down","\8597\65039") + ,("arrow_up_small","\128316") + ,("arrow_upper_left","\8598\65039") + ,("arrow_upper_right","\8599\65039") + ,("arrows_clockwise","\128259") + ,("arrows_counterclockwise","\128260") + ,("art","\127912") + ,("articulated_lorry","\128667") + ,("astonished","\128562") + ,("athletic_shoe","\128095") + ,("atm","\127975") + ,("b","\127345\65039") + ,("baby","\128118") + ,("baby_bottle","\127868") + ,("baby_chick","\128036") + ,("baby_symbol","\128700") + ,("back","\128281") + ,("baggage_claim","\128708") + ,("balloon","\127880") + ,("ballot_box_with_check","\9745\65039") + ,("bamboo","\127885") + ,("banana","\127820") + ,("bangbang","\8252\65039") + ,("bank","\127974") + ,("bar_chart","\128202") + ,("barber","\128136") + ,("baseball","\9918\65039") + ,("basketball","\127936") + ,("bath","\128704") + ,("bathtub","\128705") + ,("battery","\128267") + ,("bear","\128059") + ,("bee","\128029") + ,("beer","\127866") + ,("beers","\127867") + ,("beetle","\128030") + ,("beginner","\128304") + ,("bell","\128276") + ,("bento","\127857") + ,("bicyclist","\128692") + ,("bike","\128690") + ,("bikini","\128089") + ,("bird","\128038") + ,("birthday","\127874") + ,("black_circle","\9899") + ,("black_joker","\127183") + ,("black_large_square","\11035") + ,("black_medium_small_square","\9726") + ,("black_medium_square","\9724\65039") + ,("black_nib","\10002\65039") + ,("black_small_square","\9642\65039") + ,("black_square_button","\128306") + ,("blossom","\127804") + ,("blowfish","\128033") + ,("blue_book","\128216") + ,("blue_car","\128665") + ,("blue_heart","\128153") + ,("blush","\128522") + ,("boar","\128023") + ,("boat","\9973") + ,("bomb","\128163") + ,("book","\128214") + ,("bookmark","\128278") + ,("bookmark_tabs","\128209") + ,("books","\128218") + ,("boom","\128165") + ,("boot","\128098") + ,("bouquet","\128144") + ,("bow","\128583") + ,("bowling","\127923") + ,("boy","\128102") + ,("bread","\127838") + ,("bride_with_veil","\128112") + ,("bridge_at_night","\127753") + ,("briefcase","\128188") + ,("broken_heart","\128148") + ,("bug","\128027") + ,("bulb","\128161") + ,("bullettrain_front","\128645") + ,("bullettrain_side","\128644") + ,("bus","\128652") + ,("busstop","\128655") + ,("bust_in_silhouette","\128100") + ,("busts_in_silhouette","\128101") + ,("cactus","\127797") + ,("cake","\127856") + ,("calendar","\128198") + ,("calling","\128242") + ,("camel","\128043") + ,("camera","\128247") + ,("cancer","\9803") + ,("candy","\127852") + ,("capital_abcd","\128288") + ,("capricorn","\9809") + ,("car","\128663") + ,("card_index","\128199") + ,("carousel_horse","\127904") + ,("cat","\128049") + ,("cat2","\128008") + ,("cd","\128191") + ,("chart","\128185") + ,("chart_with_downwards_trend","\128201") + ,("chart_with_upwards_trend","\128200") + ,("checkered_flag","\127937") + ,("cherries","\127826") + ,("cherry_blossom","\127800") + ,("chestnut","\127792") + ,("chicken","\128020") + ,("children_crossing","\128696") + ,("chocolate_bar","\127851") + ,("christmas_tree","\127876") + ,("church","\9962") + ,("cinema","\127910") + ,("circus_tent","\127914") + ,("city_sunrise","\127751") + ,("city_sunset","\127750") + ,("cl","\127377") + ,("clap","\128079") + ,("clapper","\127916") + ,("clipboard","\128203") + ,("clock1","\128336") + ,("clock10","\128345") + ,("clock1030","\128357") + ,("clock11","\128346") + ,("clock1130","\128358") + ,("clock12","\128347") + ,("clock1230","\128359") + ,("clock130","\128348") + ,("clock2","\128337") + ,("clock230","\128349") + ,("clock3","\128338") + ,("clock330","\128350") + ,("clock4","\128339") + ,("clock430","\128351") + ,("clock5","\128340") + ,("clock530","\128352") + ,("clock6","\128341") + ,("clock630","\128353") + ,("clock7","\128342") + ,("clock730","\128354") + ,("clock8","\128343") + ,("clock830","\128355") + ,("clock9","\128344") + ,("clock930","\128356") + ,("closed_book","\128213") + ,("closed_lock_with_key","\128272") + ,("closed_umbrella","\127746") + ,("cloud","\9729\65039") + ,("clubs","\9827\65039") + ,("cn","\127464\127475") + ,("cocktail","\127864") + ,("coffee","\9749") + ,("cold_sweat","\128560") + ,("collision","\128165") + ,("computer","\128187") + ,("confetti_ball","\127882") + ,("confounded","\128534") + ,("confused","\128533") + ,("congratulations","\12951\65039") + ,("construction","\128679") + ,("construction_worker","\128119") + ,("convenience_store","\127978") + ,("cookie","\127850") + ,("cool","\127378") + ,("cop","\128110") + ,("copyright","\169\65039") + ,("corn","\127805") + ,("couple","\128107") + ,("couple_with_heart","\128145") + ,("couplekiss","\128143") + ,("cow","\128046") + ,("cow2","\128004") + ,("credit_card","\128179") + ,("crescent_moon","\127769") + ,("crocodile","\128010") + ,("crossed_flags","\127884") + ,("crown","\128081") + ,("cry","\128546") + ,("crying_cat_face","\128575") + ,("crystal_ball","\128302") + ,("cupid","\128152") + ,("curly_loop","\10160") + ,("currency_exchange","\128177") + ,("curry","\127835") + ,("custard","\127854") + ,("customs","\128707") + ,("cyclone","\127744") + ,("dancer","\128131") + ,("dancers","\128111") + ,("dango","\127841") + ,("dart","\127919") + ,("dash","\128168") + ,("date","\128197") + ,("de","\127465\127466") + ,("deciduous_tree","\127795") + ,("department_store","\127980") + ,("diamond_shape_with_a_dot_inside","\128160") + ,("diamonds","\9830\65039") + ,("disappointed","\128542") + ,("disappointed_relieved","\128549") + ,("dizzy","\128171") + ,("dizzy_face","\128565") + ,("do_not_litter","\128687") + ,("dog","\128054") + ,("dog2","\128021") + ,("dollar","\128181") + ,("dolls","\127886") + ,("dolphin","\128044") + ,("door","\128682") + ,("doughnut","\127849") + ,("dragon","\128009") + ,("dragon_face","\128050") + ,("dress","\128087") + ,("dromedary_camel","\128042") + ,("droplet","\128167") + ,("dvd","\128192") + ,("e-mail","\128231") + ,("ear","\128066") + ,("ear_of_rice","\127806") + ,("earth_africa","\127757") + ,("earth_americas","\127758") + ,("earth_asia","\127759") + ,("egg","\127859") + ,("eggplant","\127814") + ,("eight","8\65039\8419") + ,("eight_pointed_black_star","\10036\65039") + ,("eight_spoked_asterisk","\10035\65039") + ,("electric_plug","\128268") + ,("elephant","\128024") + ,("email","\9993\65039") + ,("end","\128282") + ,("envelope","\9993\65039") + ,("envelope_with_arrow","\128233") + ,("es","\127466\127480") + ,("euro","\128182") + ,("european_castle","\127984") + ,("european_post_office","\127972") + ,("evergreen_tree","\127794") + ,("exclamation","\10071") + ,("expressionless","\128529") + ,("eyeglasses","\128083") + ,("eyes","\128064") + ,("facepunch","\128074") + ,("factory","\127981") + ,("fallen_leaf","\127810") + ,("family","\128106") + ,("fast_forward","\9193") + ,("fax","\128224") + ,("fearful","\128552") + ,("feet","\128062") + ,("ferris_wheel","\127905") + ,("file_folder","\128193") + ,("fire","\128293") + ,("fire_engine","\128658") + ,("fireworks","\127878") + ,("first_quarter_moon","\127763") + ,("first_quarter_moon_with_face","\127771") + ,("fish","\128031") + ,("fish_cake","\127845") + ,("fishing_pole_and_fish","\127907") + ,("fist","\9994") + ,("five","5\65039\8419") + ,("flags","\127887") + ,("flashlight","\128294") + ,("flipper","\128044") + ,("floppy_disk","\128190") + ,("flower_playing_cards","\127924") + ,("flushed","\128563") + ,("foggy","\127745") + ,("football","\127944") + ,("footprints","\128099") + ,("fork_and_knife","\127860") + ,("fountain","\9970") + ,("four","4\65039\8419") + ,("four_leaf_clover","\127808") + ,("fr","\127467\127479") + ,("free","\127379") + ,("fried_shrimp","\127844") + ,("fries","\127839") + ,("frog","\128056") + ,("frowning","\128550") + ,("fuelpump","\9981") + ,("full_moon","\127765") + ,("full_moon_with_face","\127773") + ,("game_die","\127922") + ,("gb","\127468\127463") + ,("gem","\128142") + ,("gemini","\9802") + ,("ghost","\128123") + ,("gift","\127873") + ,("gift_heart","\128157") + ,("girl","\128103") + ,("globe_with_meridians","\127760") + ,("goat","\128016") + ,("golf","\9971") + ,("grapes","\127815") + ,("green_apple","\127823") + ,("green_book","\128215") + ,("green_heart","\128154") + ,("grey_exclamation","\10069") + ,("grey_question","\10068") + ,("grimacing","\128556") + ,("grin","\128513") + ,("grinning","\128512") + ,("guardsman","\128130") + ,("guitar","\127928") + ,("gun","\128299") + ,("haircut","\128135") + ,("hamburger","\127828") + ,("hammer","\128296") + ,("hamster","\128057") + ,("hand","\9995") + ,("handbag","\128092") + ,("hankey","\128169") + ,("hash","#\65039\8419") + ,("hatched_chick","\128037") + ,("hatching_chick","\128035") + ,("headphones","\127911") + ,("hear_no_evil","\128585") + ,("heart","\10084\65039") + ,("heart_decoration","\128159") + ,("heart_eyes","\128525") + ,("heart_eyes_cat","\128571") + ,("heartbeat","\128147") + ,("heartpulse","\128151") + ,("hearts","\9829\65039") + ,("heavy_check_mark","\10004\65039") + ,("heavy_division_sign","\10135") + ,("heavy_dollar_sign","\128178") + ,("heavy_exclamation_mark","\10071") + ,("heavy_minus_sign","\10134") + ,("heavy_multiplication_x","\10006\65039") + ,("heavy_plus_sign","\10133") + ,("helicopter","\128641") + ,("herb","\127807") + ,("hibiscus","\127802") + ,("high_brightness","\128262") + ,("high_heel","\128096") + ,("hocho","\128298") + ,("honey_pot","\127855") + ,("honeybee","\128029") + ,("horse","\128052") + ,("horse_racing","\127943") + ,("hospital","\127973") + ,("hotel","\127976") + ,("hotsprings","\9832\65039") + ,("hourglass","\8987") + ,("hourglass_flowing_sand","\9203") + ,("house","\127968") + ,("house_with_garden","\127969") + ,("hushed","\128559") + ,("ice_cream","\127848") + ,("icecream","\127846") + ,("id","\127380") + ,("ideograph_advantage","\127568") + ,("imp","\128127") + ,("inbox_tray","\128229") + ,("incoming_envelope","\128232") + ,("information_desk_person","\128129") + ,("information_source","\8505\65039") + ,("innocent","\128519") + ,("interrobang","\8265\65039") + ,("iphone","\128241") + ,("it","\127470\127481") + ,("izakaya_lantern","\127982") + ,("jack_o_lantern","\127875") + ,("japan","\128510") + ,("japanese_castle","\127983") + ,("japanese_goblin","\128122") + ,("japanese_ogre","\128121") + ,("jeans","\128086") + ,("joy","\128514") + ,("joy_cat","\128569") + ,("jp","\127471\127477") + ,("key","\128273") + ,("keycap_ten","\128287") + ,("kimono","\128088") + ,("kiss","\128139") + ,("kissing","\128535") + ,("kissing_cat","\128573") + ,("kissing_closed_eyes","\128538") + ,("kissing_heart","\128536") + ,("kissing_smiling_eyes","\128537") + ,("knife","\128298") + ,("koala","\128040") + ,("koko","\127489") + ,("kr","\127472\127479") + ,("lantern","\127982") + ,("large_blue_circle","\128309") + ,("large_blue_diamond","\128311") + ,("large_orange_diamond","\128310") + ,("last_quarter_moon","\127767") + ,("last_quarter_moon_with_face","\127772") + ,("laughing","\128518") + ,("leaves","\127811") + ,("ledger","\128210") + ,("left_luggage","\128709") + ,("left_right_arrow","\8596\65039") + ,("leftwards_arrow_with_hook","\8617\65039") + ,("lemon","\127819") + ,("leo","\9804") + ,("leopard","\128006") + ,("libra","\9806") + ,("light_rail","\128648") + ,("link","\128279") + ,("lips","\128068") + ,("lipstick","\128132") + ,("lock","\128274") + ,("lock_with_ink_pen","\128271") + ,("lollipop","\127853") + ,("loop","\10175") + ,("loud_sound","\128266") + ,("loudspeaker","\128226") + ,("love_hotel","\127977") + ,("love_letter","\128140") + ,("low_brightness","\128261") + ,("m","\9410\65039") + ,("mag","\128269") + ,("mag_right","\128270") + ,("mahjong","\126980") + ,("mailbox","\128235") + ,("mailbox_closed","\128234") + ,("mailbox_with_mail","\128236") + ,("mailbox_with_no_mail","\128237") + ,("man","\128104") + ,("man_with_gua_pi_mao","\128114") + ,("man_with_turban","\128115") + ,("mans_shoe","\128094") + ,("maple_leaf","\127809") + ,("mask","\128567") + ,("massage","\128134") + ,("meat_on_bone","\127830") + ,("mega","\128227") + ,("melon","\127816") + ,("memo","\128221") + ,("mens","\128697") + ,("metro","\128647") + ,("microphone","\127908") + ,("microscope","\128300") + ,("milky_way","\127756") + ,("minibus","\128656") + ,("minidisc","\128189") + ,("mobile_phone_off","\128244") + ,("money_with_wings","\128184") + ,("moneybag","\128176") + ,("monkey","\128018") + ,("monkey_face","\128053") + ,("monorail","\128669") + ,("moon","\127764") + ,("mortar_board","\127891") + ,("mount_fuji","\128507") + ,("mountain_bicyclist","\128693") + ,("mountain_cableway","\128672") + ,("mountain_railway","\128670") + ,("mouse","\128045") + ,("mouse2","\128001") + ,("movie_camera","\127909") + ,("moyai","\128511") + ,("muscle","\128170") + ,("mushroom","\127812") + ,("musical_keyboard","\127929") + ,("musical_note","\127925") + ,("musical_score","\127932") + ,("mute","\128263") + ,("nail_care","\128133") + ,("name_badge","\128219") + ,("necktie","\128084") + ,("negative_squared_cross_mark","\10062") + ,("neutral_face","\128528") + ,("new","\127381") + ,("new_moon","\127761") + ,("new_moon_with_face","\127770") + ,("newspaper","\128240") + ,("ng","\127382") + ,("night_with_stars","\127747") + ,("nine","9\65039\8419") + ,("no_bell","\128277") + ,("no_bicycles","\128691") + ,("no_entry","\9940") + ,("no_entry_sign","\128683") + ,("no_good","\128581") + ,("no_mobile_phones","\128245") + ,("no_mouth","\128566") + ,("no_pedestrians","\128695") + ,("no_smoking","\128685") + ,("non-potable_water","\128689") + ,("nose","\128067") + ,("notebook","\128211") + ,("notebook_with_decorative_cover","\128212") + ,("notes","\127926") + ,("nut_and_bolt","\128297") + ,("o","\11093") + ,("o2","\127358\65039") + ,("ocean","\127754") + ,("octopus","\128025") + ,("oden","\127842") + ,("office","\127970") + ,("ok","\127383") + ,("ok_hand","\128076") + ,("ok_woman","\128582") + ,("older_man","\128116") + ,("older_woman","\128117") + ,("on","\128283") + ,("oncoming_automobile","\128664") + ,("oncoming_bus","\128653") + ,("oncoming_police_car","\128660") + ,("oncoming_taxi","\128662") + ,("one","1\65039\8419") + ,("open_book","\128214") + ,("open_file_folder","\128194") + ,("open_hands","\128080") + ,("open_mouth","\128558") + ,("ophiuchus","\9934") + ,("orange_book","\128217") + ,("outbox_tray","\128228") + ,("ox","\128002") + ,("package","\128230") + ,("page_facing_up","\128196") + ,("page_with_curl","\128195") + ,("pager","\128223") + ,("palm_tree","\127796") + ,("panda_face","\128060") + ,("paperclip","\128206") + ,("parking","\127359\65039") + ,("part_alternation_mark","\12349\65039") + ,("partly_sunny","\9925") + ,("passport_control","\128706") + ,("paw_prints","\128062") + ,("peach","\127825") + ,("pear","\127824") + ,("pencil","\128221") + ,("pencil2","\9999\65039") + ,("penguin","\128039") + ,("pensive","\128532") + ,("performing_arts","\127917") + ,("persevere","\128547") + ,("person_frowning","\128589") + ,("person_with_blond_hair","\128113") + ,("person_with_pouting_face","\128590") + ,("phone","\9742\65039") + ,("pig","\128055") + ,("pig2","\128022") + ,("pig_nose","\128061") + ,("pill","\128138") + ,("pineapple","\127821") + ,("pisces","\9811") + ,("pizza","\127829") + ,("point_down","\128071") + ,("point_left","\128072") + ,("point_right","\128073") + ,("point_up","\9757\65039") + ,("point_up_2","\128070") + ,("police_car","\128659") + ,("poodle","\128041") + ,("poop","\128169") + ,("post_office","\127971") + ,("postal_horn","\128239") + ,("postbox","\128238") + ,("potable_water","\128688") + ,("pouch","\128093") + ,("poultry_leg","\127831") + ,("pound","\128183") + ,("pouting_cat","\128574") + ,("pray","\128591") + ,("princess","\128120") + ,("punch","\128074") + ,("purple_heart","\128156") + ,("purse","\128091") + ,("pushpin","\128204") + ,("put_litter_in_its_place","\128686") + ,("question","\10067") + ,("rabbit","\128048") + ,("rabbit2","\128007") + ,("racehorse","\128014") + ,("radio","\128251") + ,("radio_button","\128280") + ,("rage","\128545") + ,("railway_car","\128643") + ,("rainbow","\127752") + ,("raised_hand","\9995") + ,("raised_hands","\128588") + ,("raising_hand","\128587") + ,("ram","\128015") + ,("ramen","\127836") + ,("rat","\128000") + ,("recycle","\9851\65039") + ,("red_car","\128663") + ,("red_circle","\128308") + ,("registered","\174\65039") + ,("relaxed","\9786\65039") + ,("relieved","\128524") + ,("repeat","\128257") + ,("repeat_one","\128258") + ,("restroom","\128699") + ,("revolving_hearts","\128158") + ,("rewind","\9194") + ,("ribbon","\127872") + ,("rice","\127834") + ,("rice_ball","\127833") + ,("rice_cracker","\127832") + ,("rice_scene","\127889") + ,("ring","\128141") + ,("rocket","\128640") + ,("roller_coaster","\127906") + ,("rooster","\128019") + ,("rose","\127801") + ,("rotating_light","\128680") + ,("round_pushpin","\128205") + ,("rowboat","\128675") + ,("ru","\127479\127482") + ,("rugby_football","\127945") + ,("runner","\127939") + ,("running","\127939") + ,("running_shirt_with_sash","\127933") + ,("sa","\127490\65039") + ,("sagittarius","\9808") + ,("sailboat","\9973") + ,("sake","\127862") + ,("sandal","\128097") + ,("santa","\127877") + ,("satellite","\128225") + ,("satisfied","\128518") + ,("saxophone","\127927") + ,("school","\127979") + ,("school_satchel","\127890") + ,("scissors","\9986\65039") + ,("scorpius","\9807") + ,("scream","\128561") + ,("scream_cat","\128576") + ,("scroll","\128220") + ,("seat","\128186") + ,("secret","\12953\65039") + ,("see_no_evil","\128584") + ,("seedling","\127793") + ,("seven","7\65039\8419") + ,("shaved_ice","\127847") + ,("sheep","\128017") + ,("shell","\128026") + ,("ship","\128674") + ,("shirt","\128085") + ,("shit","\128169") + ,("shoe","\128094") + ,("shower","\128703") + ,("signal_strength","\128246") + ,("six","6\65039\8419") + ,("six_pointed_star","\128303") + ,("ski","\127935") + ,("skull","\128128") + ,("sleeping","\128564") + ,("sleepy","\128554") + ,("slot_machine","\127920") + ,("small_blue_diamond","\128313") + ,("small_orange_diamond","\128312") + ,("small_red_triangle","\128314") + ,("small_red_triangle_down","\128315") + ,("smile","\128516") + ,("smile_cat","\128568") + ,("smiley","\128515") + ,("smiley_cat","\128570") + ,("smiling_imp","\128520") + ,("smirk","\128527") + ,("smirk_cat","\128572") + ,("smoking","\128684") + ,("snail","\128012") + ,("snake","\128013") + ,("snowboarder","\127938") + ,("snowflake","\10052\65039") + ,("snowman","\9924") + ,("sob","\128557") + ,("soccer","\9917") + ,("soon","\128284") + ,("sos","\127384") + ,("sound","\128265") + ,("space_invader","\128126") + ,("spades","\9824\65039") + ,("spaghetti","\127837") + ,("sparkle","\10055\65039") + ,("sparkler","\127879") + ,("sparkles","\10024") + ,("sparkling_heart","\128150") + ,("speak_no_evil","\128586") + ,("speaker","\128264") + ,("speech_balloon","\128172") + ,("speedboat","\128676") + ,("star","\11088") + ,("star2","\127775") + ,("stars","\127776") + ,("station","\128649") + ,("statue_of_liberty","\128509") + ,("steam_locomotive","\128642") + ,("stew","\127858") + ,("straight_ruler","\128207") + ,("strawberry","\127827") + ,("stuck_out_tongue","\128539") + ,("stuck_out_tongue_closed_eyes","\128541") + ,("stuck_out_tongue_winking_eye","\128540") + ,("sun_with_face","\127774") + ,("sunflower","\127803") + ,("sunglasses","\128526") + ,("sunny","\9728\65039") + ,("sunrise","\127749") + ,("sunrise_over_mountains","\127748") + ,("surfer","\127940") + ,("sushi","\127843") + ,("suspension_railway","\128671") + ,("sweat","\128531") + ,("sweat_drops","\128166") + ,("sweat_smile","\128517") + ,("sweet_potato","\127840") + ,("swimmer","\127946") + ,("symbols","\128291") + ,("syringe","\128137") + ,("tada","\127881") + ,("tanabata_tree","\127883") + ,("tangerine","\127818") + ,("taurus","\9801") + ,("taxi","\128661") + ,("tea","\127861") + ,("telephone","\9742\65039") + ,("telephone_receiver","\128222") + ,("telescope","\128301") + ,("tennis","\127934") + ,("tent","\9978") + ,("thought_balloon","\128173") + ,("three","3\65039\8419") + ,("thumbsdown","\128078") + ,("thumbsup","\128077") + ,("ticket","\127915") + ,("tiger","\128047") + ,("tiger2","\128005") + ,("tired_face","\128555") + ,("tm","\8482\65039") + ,("toilet","\128701") + ,("tokyo_tower","\128508") + ,("tomato","\127813") + ,("tongue","\128069") + ,("top","\128285") + ,("tophat","\127913") + ,("tractor","\128668") + ,("traffic_light","\128677") + ,("train","\128651") + ,("train2","\128646") + ,("tram","\128650") + ,("triangular_flag_on_post","\128681") + ,("triangular_ruler","\128208") + ,("trident","\128305") + ,("triumph","\128548") + ,("trolleybus","\128654") + ,("trophy","\127942") + ,("tropical_drink","\127865") + ,("tropical_fish","\128032") + ,("truck","\128666") + ,("trumpet","\127930") + ,("tshirt","\128085") + ,("tulip","\127799") + ,("turtle","\128034") + ,("tv","\128250") + ,("twisted_rightwards_arrows","\128256") + ,("two","2\65039\8419") + ,("two_hearts","\128149") + ,("two_men_holding_hands","\128108") + ,("two_women_holding_hands","\128109") + ,("u5272","\127545") + ,("u5408","\127540") + ,("u55b6","\127546") + ,("u6307","\127535") + ,("u6708","\127543\65039") + ,("u6709","\127542") + ,("u6e80","\127541") + ,("u7121","\127514") + ,("u7533","\127544") + ,("u7981","\127538") + ,("u7a7a","\127539") + ,("uk","\127468\127463") + ,("umbrella","\9748") + ,("unamused","\128530") + ,("underage","\128286") + ,("unlock","\128275") + ,("up","\127385") + ,("us","\127482\127480") + ,("v","\9996\65039") + ,("vertical_traffic_light","\128678") + ,("vhs","\128252") + ,("vibration_mode","\128243") + ,("video_camera","\128249") + ,("video_game","\127918") + ,("violin","\127931") + ,("virgo","\9805") + ,("volcano","\127755") + ,("vs","\127386") + ,("walking","\128694") + ,("waning_crescent_moon","\127768") + ,("waning_gibbous_moon","\127766") + ,("warning","\9888\65039") + ,("watch","\8986") + ,("water_buffalo","\128003") + ,("watermelon","\127817") + ,("wave","\128075") + ,("wavy_dash","\12336\65039") + ,("waxing_crescent_moon","\127762") + ,("waxing_gibbous_moon","\127764") + ,("wc","\128702") + ,("weary","\128553") + ,("wedding","\128146") + ,("whale","\128051") + ,("whale2","\128011") + ,("wheelchair","\9855") + ,("white_check_mark","\9989") + ,("white_circle","\9898") + ,("white_flower","\128174") + ,("white_large_square","\11036") + ,("white_medium_small_square","\9725") + ,("white_medium_square","\9723\65039") + ,("white_small_square","\9643\65039") + ,("white_square_button","\128307") + ,("wind_chime","\127888") + ,("wine_glass","\127863") + ,("wink","\128521") + ,("wolf","\128058") + ,("woman","\128105") + ,("womans_clothes","\128090") + ,("womans_hat","\128082") + ,("womens","\128698") + ,("worried","\128543") + ,("wrench","\128295") + ,("x","\10060") + ,("yellow_heart","\128155") + ,("yen","\128180") + ,("yum","\128523") + ,("zap","\9889") + ,("zero","0\65039\8419") + ,("zzz","\128164") + ] + diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index d0b945d45..d7a14c129 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -65,9 +65,7 @@ highlight :: (FormatOptions -> [SourceLine] -> a) -- ^ Formatter -> String -- ^ Raw contents of the CodeBlock -> Maybe a -- ^ Maybe the formatted result highlight formatter (_, classes, keyvals) rawCode = - let firstNum = case safeRead (fromMaybe "1" $ lookup "startFrom" keyvals) of - Just n -> n - Nothing -> 1 + let firstNum = fromMaybe 1 (safeRead (fromMaybe "1" $ lookup "startFrom" keyvals)) fmtOpts = defaultFormatOpts{ startNumber = firstNum, numberLines = any (`elem` @@ -126,6 +124,7 @@ langsList = [("ada","Ada") ,("php","PHP") ,("xslt","XSLT") ,("html","HTML") + ,("gap","GAP") ] listingsLangs :: [String] @@ -140,7 +139,7 @@ listingsLangs = ["Ada","Java","Prolog","Algol","JVMIS","Promela", "Oberon-2","TeX","erlang","OCL","VBScript","Euphoria", "Octave","Verilog","Fortran","Oz","VHDL","GCL", "Pascal","VRML","Gnuplot","Perl","XML","Haskell", - "PHP","XSLT","HTML","PL/I"] + "PHP","XSLT","HTML","PL/I","GAP"] -- Determine listings language name from highlighting-kate language name. toListingsLanguage :: String -> Maybe String diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index a38a9dcd1..571fdd665 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -29,16 +29,35 @@ Portability : portable Functions for determining the size of a PNG, JPEG, or GIF image. -} -module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize, - sizeInPixels, sizeInPoints ) where +module Text.Pandoc.ImageSize ( ImageType(..) + , imageType + , imageSize + , sizeInPixels + , sizeInPoints + , desiredSizeInPoints + , Dimension(..) + , Direction(..) + , dimension + , inInch + , inPoints + , numUnit + , showInInch + , showInPixel + , showFl + ) where import Data.ByteString (ByteString, unpack) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as BL +import Data.Char (isDigit) import Control.Monad import Data.Bits import Data.Binary import Data.Binary.Get import Text.Pandoc.Shared (safeRead, hush) +import Data.Default (Default) +import Numeric (showFFloat) +import Text.Pandoc.Definition +import Text.Pandoc.Options import qualified Data.Map as M import Text.Pandoc.Compat.Except import Control.Monad.Trans @@ -48,6 +67,20 @@ import Data.Maybe (fromMaybe) -- algorithms borrowed from wwwis.pl data ImageType = Png | Gif | Jpeg | Pdf | Eps deriving Show +data Direction = Width | Height +instance Show Direction where + show Width = "width" + show Height = "height" + +data Dimension = Pixel Integer + | Centimeter Double + | Inch Double + | Percent Double +instance Show Dimension where + show (Pixel a) = show a ++ "px" + show (Centimeter a) = showFl a ++ "cm" + show (Inch a) = showFl a ++ "in" + show (Percent a) = show a ++ "%" data ImageSize = ImageSize{ pxX :: Integer @@ -55,7 +88,11 @@ data ImageSize = ImageSize{ , dpiX :: Integer , dpiY :: Integer } deriving (Read, Show, Eq) +instance Default ImageSize where + def = ImageSize 300 200 72 72 +showFl :: (RealFloat a) => a -> String +showFl a = showFFloat (Just 5) a "" imageType :: ByteString -> Maybe ImageType imageType img = case B.take 4 img of @@ -87,8 +124,93 @@ defaultSize = (72, 72) sizeInPixels :: ImageSize -> (Integer, Integer) sizeInPixels s = (pxX s, pxY s) -sizeInPoints :: ImageSize -> (Integer, Integer) -sizeInPoints s = (pxX s * 72 `div` dpiX s, pxY s * 72 `div` dpiY s) +-- | Calculate (height, width) in points using the image file's dpi metadata, +-- using 72 Points == 1 Inch. +sizeInPoints :: ImageSize -> (Double, Double) +sizeInPoints s = (pxXf * 72 / dpiXf, pxYf * 72 / dpiYf) + where + pxXf = fromIntegral $ pxX s + pxYf = fromIntegral $ pxY s + dpiXf = fromIntegral $ dpiX s + dpiYf = fromIntegral $ dpiY s + +-- | Calculate (height, width) in points, considering the desired dimensions in the +-- attribute, while falling back on the image file's dpi metadata if no dimensions +-- are specified in the attribute (or only dimensions in percentages). +desiredSizeInPoints :: WriterOptions -> Attr -> ImageSize -> (Double, Double) +desiredSizeInPoints opts attr s = + case (getDim Width, getDim Height) of + (Just w, Just h) -> (w, h) + (Just w, Nothing) -> (w, w / ratio) + (Nothing, Just h) -> (h * ratio, h) + (Nothing, Nothing) -> sizeInPoints s + where + ratio = fromIntegral (pxX s) / fromIntegral (pxY s) + getDim dir = case (dimension dir attr) of + Just (Percent _) -> Nothing + Just dim -> Just $ inPoints opts dim + Nothing -> Nothing + +inPoints :: WriterOptions -> Dimension -> Double +inPoints opts dim = 72 * inInch opts dim + +inInch :: WriterOptions -> Dimension -> Double +inInch opts dim = + case dim of + (Pixel a) -> fromIntegral a / (fromIntegral $ writerDpi opts) + (Centimeter a) -> a * 0.3937007874 + (Inch a) -> a + (Percent _) -> 0 + +-- | Convert a Dimension to a String denoting its equivalent in inches, for example "2.00000". +-- Note: Dimensions in percentages are converted to the empty string. +showInInch :: WriterOptions -> Dimension -> String +showInInch _ (Percent _) = "" +showInInch opts dim = showFl $ inInch opts dim + +-- | Convert a Dimension to a String denoting its equivalent in pixels, for example "600". +-- Note: Dimensions in percentages are converted to the empty string. +showInPixel :: WriterOptions -> Dimension -> String +showInPixel opts dim = + case dim of + (Pixel a) -> show a + (Centimeter a) -> show (floor $ dpi * a * 0.3937007874 :: Int) + (Inch a) -> show (floor $ dpi * a :: Int) + (Percent _) -> "" + where + dpi = fromIntegral $ writerDpi opts + +-- | Maybe split a string into a leading number and trailing unit, e.g. "3cm" to Just (3.0, "cm") +numUnit :: String -> Maybe (Double, String) +numUnit s = + let (nums, unit) = span (\c -> isDigit c || ('.'==c)) s + in case safeRead nums of + Just n -> Just (n, unit) + Nothing -> Nothing + +-- | Read a Dimension from an Attr attribute. +-- `dimension Width attr` might return `Just (Pixel 3)` or for example `Just (Centimeter 2.0)`, etc. +dimension :: Direction -> Attr -> Maybe Dimension +dimension dir (_, _, kvs) = + case dir of + Width -> extractDim "width" + Height -> extractDim "height" + where + extractDim key = + case lookup key kvs of + Just str -> + case numUnit str of + Just (num, unit) -> toDim num unit + Nothing -> Nothing + Nothing -> Nothing + toDim a "cm" = Just $ Centimeter a + toDim a "mm" = Just $ Centimeter (a / 10) + toDim a "in" = Just $ Inch a + toDim a "inch" = Just $ Inch a + toDim a "%" = Just $ Percent a + toDim a "px" = Just $ Pixel (floor a::Integer) + toDim a "" = Just $ Pixel (floor a::Integer) + toDim _ _ = Nothing epsSize :: ByteString -> Maybe ImageSize epsSize img = do @@ -278,21 +400,21 @@ exifHeader hdr = do return (tag, payload) entries <- sequence $ replicate (fromIntegral numentries) ifdEntry subentries <- case lookup ExifOffset entries of - Just (UnsignedLong offset) -> do + Just (UnsignedLong offset') -> do pos <- lift bytesRead - lift $ skip (fromIntegral offset - (fromIntegral pos - 8)) + lift $ skip (fromIntegral offset' - (fromIntegral pos - 8)) numsubentries <- lift getWord16 sequence $ replicate (fromIntegral numsubentries) ifdEntry _ -> return [] let allentries = entries ++ subentries - (width, height) <- case (lookup ExifImageWidth allentries, - lookup ExifImageHeight allentries) of - (Just (UnsignedLong w), Just (UnsignedLong h)) -> - return (fromIntegral w, fromIntegral h) - _ -> return defaultSize - -- we return a default width and height when - -- the exif header doesn't contain these + (wdth, hght) <- case (lookup ExifImageWidth allentries, + lookup ExifImageHeight allentries) of + (Just (UnsignedLong w), Just (UnsignedLong h)) -> + return (fromIntegral w, fromIntegral h) + _ -> return defaultSize + -- we return a default width and height when + -- the exif header doesn't contain these let resfactor = case lookup ResolutionUnit allentries of Just (UnsignedShort 1) -> (100 / 254) _ -> 1 @@ -301,8 +423,8 @@ exifHeader hdr = do let yres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor) $ lookup YResolution allentries return $ ImageSize{ - pxX = width - , pxY = height + pxX = wdth + , pxY = hght , dpiX = xres , dpiY = yres } diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 20c842e0d..7dd47cd59 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} {- Copyright (C) 2012-2015 John MacFarlane <jgm@berkeley.edu> @@ -42,6 +42,7 @@ module Text.Pandoc.Options ( Extension(..) , ObfuscationMethod (..) , HTMLSlideVariant (..) , EPUBVersion (..) + , WrapOption (..) , WriterOptions (..) , TrackChanges (..) , def @@ -54,6 +55,7 @@ import Text.Pandoc.Highlighting (Style, pygments) import Text.Pandoc.MediaBag (MediaBag) import Data.Data (Data) import Data.Typeable (Typeable) +import GHC.Generics (Generic) -- | Individually selectable syntax extensions. data Extension = @@ -85,7 +87,8 @@ data Extension = | Ext_markdown_attribute -- ^ Interpret text inside HTML as markdown -- iff container has attribute 'markdown' | Ext_escaped_line_breaks -- ^ Treat a backslash at EOL as linebreak - | Ext_link_attributes -- ^ MMD style reference link attributes + | Ext_link_attributes -- ^ link and image attributes + | Ext_mmd_link_attributes -- ^ MMD style reference link attributes | Ext_autolink_bare_uris -- ^ Make all absolute URIs into links | Ext_fancy_lists -- ^ Enable fancy list numbers and delimiters | Ext_lists_without_preceding_blankline -- ^ Allow lists without preceding blank @@ -103,8 +106,11 @@ data Extension = | Ext_subscript -- ^ Subscript using ~this~ syntax | Ext_hard_line_breaks -- ^ All newlines become hard line breaks | Ext_ignore_line_breaks -- ^ Newlines in paragraphs are ignored + | Ext_east_asian_line_breaks -- ^ Newlines in paragraphs are ignored between + -- East Asian wide characters | Ext_literate_haskell -- ^ Enable literate Haskell conventions | Ext_abbreviations -- ^ PHP markdown extra abbreviation definitions + | Ext_emoji -- ^ Support emoji like :smile: | Ext_auto_identifiers -- ^ Automatic identifiers for headers | Ext_ascii_identifiers -- ^ ascii-only identifiers for headers | Ext_header_attributes -- ^ Explicit header attributes {#id .class k=v} @@ -113,7 +119,7 @@ data Extension = | Ext_line_blocks -- ^ RST style line blocks | Ext_epub_html_exts -- ^ Recognise the EPUB extended version of HTML | Ext_shortcut_reference_links -- ^ Shortcut reference links - deriving (Show, Read, Enum, Eq, Ord, Bounded, Data, Typeable) + deriving (Show, Read, Enum, Eq, Ord, Bounded, Data, Typeable, Generic) pandocExtensions :: Set Extension pandocExtensions = Set.fromList @@ -153,6 +159,7 @@ pandocExtensions = Set.fromList , Ext_subscript , Ext_auto_identifiers , Ext_header_attributes + , Ext_link_attributes , Ext_implicit_header_references , Ext_line_blocks , Ext_shortcut_reference_links @@ -186,6 +193,7 @@ phpMarkdownExtraExtensions = Set.fromList , Ext_definition_lists , Ext_intraword_underscores , Ext_header_attributes + , Ext_link_attributes , Ext_abbreviations , Ext_shortcut_reference_links ] @@ -203,6 +211,7 @@ githubMarkdownExtensions = Set.fromList , Ext_intraword_underscores , Ext_strikeout , Ext_hard_line_breaks + , Ext_emoji , Ext_lists_without_preceding_blankline , Ext_shortcut_reference_links ] @@ -212,7 +221,7 @@ multimarkdownExtensions = Set.fromList [ Ext_pipe_tables , Ext_raw_html , Ext_markdown_attribute - , Ext_link_attributes + , Ext_mmd_link_attributes , Ext_raw_tex , Ext_tex_math_double_backslash , Ext_intraword_underscores @@ -256,7 +265,7 @@ data ReaderOptions = ReaderOptions{ , readerDefaultImageExtension :: String -- ^ Default extension for images , readerTrace :: Bool -- ^ Print debugging info , readerTrackChanges :: TrackChanges -} deriving (Show, Read, Data, Typeable) +} deriving (Show, Read, Data, Typeable, Generic) instance Default ReaderOptions where def = ReaderOptions{ @@ -278,7 +287,7 @@ instance Default ReaderOptions -- Writer options -- -data EPUBVersion = EPUB2 | EPUB3 deriving (Eq, Show, Read, Data, Typeable) +data EPUBVersion = EPUB2 | EPUB3 deriving (Eq, Show, Read, Data, Typeable, Generic) data HTMLMathMethod = PlainMath | LaTeXMathML (Maybe String) -- url of LaTeXMathML.js @@ -288,18 +297,18 @@ data HTMLMathMethod = PlainMath | MathML (Maybe String) -- url of MathMLinHTML.js | MathJax String -- url of MathJax.js | KaTeX String String -- url of stylesheet and katex.js - deriving (Show, Read, Eq, Data, Typeable) + deriving (Show, Read, Eq, Data, Typeable, Generic) data CiteMethod = Citeproc -- use citeproc to render them | Natbib -- output natbib cite commands | Biblatex -- output biblatex cite commands - deriving (Show, Read, Eq, Data, Typeable) + deriving (Show, Read, Eq, Data, Typeable, Generic) -- | Methods for obfuscating email addresses in HTML. data ObfuscationMethod = NoObfuscation | ReferenceObfuscation | JavascriptObfuscation - deriving (Show, Read, Eq, Data, Typeable) + deriving (Show, Read, Eq, Data, Typeable, Generic) -- | Varieties of HTML slide shows. data HTMLSlideVariant = S5Slides @@ -308,13 +317,19 @@ data HTMLSlideVariant = S5Slides | DZSlides | RevealJsSlides | NoSlides - deriving (Show, Read, Eq, Data, Typeable) + deriving (Show, Read, Eq, Data, Typeable, Generic) -- | Options for accepting or rejecting MS Word track-changes. data TrackChanges = AcceptChanges | RejectChanges | AllChanges - deriving (Show, Read, Eq, Data, Typeable) + deriving (Show, Read, Eq, Data, Typeable, Generic) + +-- | Options for wrapping text in the output. +data WrapOption = WrapAuto -- ^ Automatically wrap to width + | WrapNone -- ^ No non-semantic newlines + | WrapPreserve -- ^ Preserve wrapping of input source + deriving (Show, Read, Eq, Data, Typeable, Generic) -- | Options for writers data WriterOptions = WriterOptions @@ -332,7 +347,8 @@ data WriterOptions = WriterOptions , writerSectionDivs :: Bool -- ^ Put sections in div tags in HTML , writerExtensions :: Set Extension -- ^ Markdown extensions that can be used , writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst - , writerWrapText :: Bool -- ^ Wrap text to line length + , writerDpi :: Int -- ^ Dpi for pixel to/from inch/cm conversions + , writerWrapText :: WrapOption -- ^ Option for wrapping text , writerColumns :: Int -- ^ Characters in a line (for text wrapping) , writerEmailObfuscation :: ObfuscationMethod -- ^ How to obfuscate emails , writerIdentifierPrefix :: String -- ^ Prefix for section & note ids in HTML @@ -361,7 +377,7 @@ data WriterOptions = WriterOptions , writerMediaBag :: MediaBag -- ^ Media collected by docx or epub reader , writerVerbose :: Bool -- ^ Verbose debugging output , writerLaTeXArgs :: [String] -- ^ Flags to pass to latex-engine - } deriving (Show, Data, Typeable) + } deriving (Show, Data, Typeable, Generic) instance Default WriterOptions where def = WriterOptions { writerStandalone = False @@ -378,7 +394,8 @@ instance Default WriterOptions where , writerSectionDivs = False , writerExtensions = pandocExtensions , writerReferenceLinks = False - , writerWrapText = True + , writerDpi = 96 + , writerWrapText = WrapAuto , writerColumns = 72 , writerEmailObfuscation = JavascriptObfuscation , writerIdentifierPrefix = "" diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index f466fcb72..0e533ede8 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -34,6 +34,7 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as BC import qualified Data.ByteString as BS +import Text.Pandoc.Compat.Monoid ((<>)) import System.Exit (ExitCode (..)) import System.FilePath import System.IO (stderr, stdout) @@ -47,7 +48,7 @@ import Data.Maybe (fromMaybe) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Definition import Text.Pandoc.Walk (walkM) -import Text.Pandoc.Shared (fetchItem', warn, withTempDir) +import Text.Pandoc.Shared (fetchItem', warn, withTempDir, inDirectory) import Text.Pandoc.Options (WriterOptions(..)) import Text.Pandoc.MIME (extensionFromMimeType, getMimeType) import Text.Pandoc.Process (pipeProcess) @@ -71,7 +72,9 @@ makePDF program writer opts doc = withTempDir "tex2pdf." $ \tmpdir -> do doc' <- handleImages opts tmpdir doc let source = writer opts doc' args = writerLaTeXArgs opts - tex2pdf' (writerVerbose opts) args tmpdir program source + case program of + "context" -> context2pdf (writerVerbose opts) tmpdir source + _ -> tex2pdf' (writerVerbose opts) args tmpdir program source handleImages :: WriterOptions -> FilePath -- ^ temp dir to store images @@ -83,10 +86,10 @@ handleImage' :: WriterOptions -> FilePath -> Inline -> IO Inline -handleImage' opts tmpdir (Image ils (src,tit)) = do +handleImage' opts tmpdir (Image attr ils (src,tit)) = do exists <- doesFileExist src if exists - then return $ Image ils (src,tit) + then return $ Image attr ils (src,tit) else do res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case res of @@ -96,20 +99,20 @@ handleImage' opts tmpdir (Image ils (src,tit)) = do let basename = showDigest $ sha1 $ BL.fromChunks [contents] let fname = tmpdir </> basename <.> ext BS.writeFile fname contents - return $ Image ils (fname,tit) + return $ Image attr ils (fname,tit) _ -> do warn $ "Could not find image `" ++ src ++ "', skipping..." - return $ Image ils (src,tit) + return $ Image attr ils (src,tit) handleImage' _ _ x = return x convertImages :: FilePath -> Inline -> IO Inline -convertImages tmpdir (Image ils (src, tit)) = do +convertImages tmpdir (Image attr ils (src, tit)) = do img <- convertImage tmpdir src newPath <- case img of Left e -> src <$ warn e Right fp -> return fp - return (Image ils (newPath, tit)) + return (Image attr ils (newPath, tit)) convertImages _ x = return x -- Convert formats which do not work well in pdf to png @@ -127,7 +130,7 @@ convertImage tmpdir fname = E.catch (Right fileOut <$ JP.savePngImage fileOut img) $ \(e :: E.SomeException) -> return (Left (show e)) where - fileOut = replaceDirectory (replaceExtension fname (".png")) tmpdir + fileOut = replaceDirectory (replaceExtension fname ".png") tmpdir mime = getMimeType fname doNothing = return (Right fname) @@ -147,8 +150,8 @@ tex2pdf' verbose args tmpDir program source = do let logmsg = extractMsg log' let extramsg = case logmsg of - x | ("! Package inputenc Error" `BC.isPrefixOf` x - && program /= "xelatex") + x | "! Package inputenc Error" `BC.isPrefixOf` x + && program /= "xelatex" -> "\nTry running pandoc with --latex-engine=xelatex." _ -> "" return $ Left $ logmsg <> extramsg @@ -166,6 +169,14 @@ extractMsg log' = do then log' else BC.unlines (msg'' ++ lineno) +extractConTeXtMsg :: ByteString -> ByteString +extractConTeXtMsg log' = do + let msg' = take 1 $ + dropWhile (not . ("tex error" `BC.isPrefixOf`)) $ BC.lines log' + if null msg' + then log' + else BC.unlines msg' + -- running tex programs -- Run a TeX program on an input bytestring and return (exit code, @@ -188,18 +199,18 @@ runTeXProgram verbose program args runNumber numRuns tmpDir source = do let programArgs = ["-halt-on-error", "-interaction", "nonstopmode", "-output-directory", tmpDir'] ++ args ++ [file'] env' <- getEnvironment - let sep = searchPathSeparator:[] + let sep = [searchPathSeparator] let texinputs = maybe (tmpDir' ++ sep) ((tmpDir' ++ sep) ++) $ lookup "TEXINPUTS" env' let env'' = ("TEXINPUTS", texinputs) : [(k,v) | (k,v) <- env', k /= "TEXINPUTS"] when (verbose && runNumber == 1) $ do - putStrLn $ "[makePDF] temp dir:" + putStrLn "[makePDF] temp dir:" putStrLn tmpDir' - putStrLn $ "[makePDF] Command line:" + putStrLn "[makePDF] Command line:" putStrLn $ program ++ " " ++ unwords (map show programArgs) putStr "\n" - putStrLn $ "[makePDF] Environment:" + putStrLn "[makePDF] Environment:" mapM_ print env'' putStr "\n" putStrLn $ "[makePDF] Contents of " ++ file' ++ ":" @@ -224,3 +235,56 @@ runTeXProgram verbose program args runNumber numRuns tmpDir source = do else return Nothing return (exit, out <> err, pdf) +context2pdf :: Bool -- ^ Verbose output + -> FilePath -- ^ temp directory for output + -> String -- ^ ConTeXt source + -> IO (Either ByteString ByteString) +context2pdf verbose tmpDir source = inDirectory tmpDir $ do + let file = "input.tex" + UTF8.writeFile file source +#ifdef _WINDOWS + -- note: we want / even on Windows, for TexLive + let tmpDir' = changePathSeparators tmpDir +#else + let tmpDir' = tmpDir +#endif + let programArgs = "--batchmode" : [file] + env' <- getEnvironment + let sep = [searchPathSeparator] + let texinputs = maybe (".." ++ sep) ((".." ++ sep) ++) + $ lookup "TEXINPUTS" env' + let env'' = ("TEXINPUTS", texinputs) : + [(k,v) | (k,v) <- env', k /= "TEXINPUTS"] + when verbose $ do + putStrLn "[makePDF] temp dir:" + putStrLn tmpDir' + putStrLn "[makePDF] Command line:" + putStrLn $ "context" ++ " " ++ unwords (map show programArgs) + putStr "\n" + putStrLn "[makePDF] Environment:" + mapM_ print env'' + putStr "\n" + putStrLn $ "[makePDF] Contents of " ++ file ++ ":" + B.readFile file >>= B.putStr + putStr "\n" + (exit, out, err) <- pipeProcess (Just env'') "context" programArgs BL.empty + when verbose $ do + B.hPutStr stdout out + B.hPutStr stderr err + putStr "\n" + let pdfFile = replaceExtension file ".pdf" + pdfExists <- doesFileExist pdfFile + mbPdf <- if pdfExists + -- We read PDF as a strict bytestring to make sure that the + -- temp directory is removed on Windows. + -- See https://github.com/jgm/pandoc/issues/1192. + then (Just . B.fromChunks . (:[])) `fmap` BS.readFile pdfFile + else return Nothing + let log' = out <> err + case (exit, mbPdf) of + (ExitFailure _, _) -> do + let logmsg = extractConTeXtMsg log' + return $ Left logmsg + (ExitSuccess, Nothing) -> return $ Left "" + (ExitSuccess, Just pdf) -> return $ Right pdf + diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index d2eaaf0d1..85786eb3e 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -164,7 +164,8 @@ module Text.Pandoc.Parsing ( anyLine, setSourceLine, newPos, addWarning, - (<+?>) + (<+?>), + extractIdClass ) where @@ -185,6 +186,7 @@ import Text.TeXMath.Readers.TeX.Macros (applyMacros, Macro, parseMacroDefinitions) import Text.Pandoc.Compat.TagSoupEntity ( lookupEntity ) import Text.Pandoc.Asciify (toAsciiChar) +import Text.Pandoc.Compat.Monoid ((<>)) import Data.Default import qualified Data.Set as Set import Control.Monad.Reader @@ -1065,7 +1067,7 @@ toKey = Key . map toLower . unwords . words . unbracket where unbracket ('[':xs) | "]" `isSuffixOf` xs = take (length xs - 1) xs unbracket xs = xs -type KeyTable = M.Map Key Target +type KeyTable = M.Map Key (Target, Attr) type SubstTable = M.Map Key Inlines @@ -1210,7 +1212,8 @@ citeKey = try $ do firstChar <- alphaNum <|> char '_' <|> char '*' -- @* for wildcard in nocite let regchar = satisfy (\c -> isAlphaNum c || c == '_') let internal p = try $ p <* lookAhead regchar - rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/") + rest <- many $ regchar <|> internal (oneOf ":.#$%&-+?<>~/") <|> + try (oneOf ":/" <* lookAhead (char '/')) let key = firstChar:rest return (suppress_author, key) @@ -1262,3 +1265,14 @@ addWarning mbpos msg = infixr 5 <+?> (<+?>) :: (Monoid a, Monad m) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>) + +extractIdClass :: Attr -> Attr +extractIdClass (ident, cls, kvs) = (ident', cls', kvs') + where + ident' = case (lookup "id" kvs) of + Just v -> v + Nothing -> ident + cls' = case (lookup "class" kvs) of + Just cl -> words cl + Nothing -> cls + kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs index f100fb75d..88b7dd09e 100644 --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -80,6 +80,7 @@ import Data.List (intercalate) import Data.String import Control.Monad.State import Data.Char (isSpace) +import Text.Pandoc.Compat.Monoid ((<>)) data RenderState a = RenderState{ output :: [a] -- ^ In reverse order @@ -170,7 +171,7 @@ infixr 5 $$ else x <> cr <> y infixr 5 $+$ --- | @a $$ b@ puts @a@ above @b@, with a blank line between. +-- | @a $+$ b@ puts @a@ above @b@, with a blank line between. ($+$) :: Doc -> Doc -> Doc ($+$) x y = if isEmpty x then y diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs index 51a35c8ad..71c7d05b2 100644 --- a/src/Text/Pandoc/Readers/CommonMark.hs +++ b/src/Text/Pandoc/Readers/CommonMark.hs @@ -103,7 +103,7 @@ addInline (Node _ (TEXT t) _) = (map toinl clumps ++) toinl (' ':_) = Space toinl xs = Str xs addInline (Node _ LINEBREAK _) = (LineBreak :) -addInline (Node _ SOFTBREAK _) = (Space :) +addInline (Node _ SOFTBREAK _) = (SoftBreak :) addInline (Node _ (INLINE_HTML t) _) = (RawInline (Format "html") (unpack t) :) addInline (Node _ (CODE t) _) = @@ -113,7 +113,7 @@ addInline (Node _ EMPH nodes) = addInline (Node _ STRONG nodes) = (Strong (addInlines nodes) :) addInline (Node _ (LINK url title) nodes) = - (Link (addInlines nodes) (unpack url, unpack title) :) + (Link nullAttr (addInlines nodes) (unpack url, unpack title) :) addInline (Node _ (IMAGE url title) nodes) = - (Image (addInlines nodes) (unpack url, unpack title) :) + (Image nullAttr (addInlines nodes) (unpack url, unpack title) :) addInline _ = id diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index f679ddb57..e8fe92e27 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -635,11 +635,20 @@ addToStart toadd bs = -- A DocBook mediaobject is a wrapper around a set of alternative presentations getMediaobject :: Element -> DB Inlines getMediaobject e = do - imageUrl <- case filterChild (named "imageobject") e of - Nothing -> return mempty - Just z -> case filterChild (named "imagedata") z of - Nothing -> return mempty - Just i -> return $ attrValue "fileref" i + (imageUrl, attr) <- + case filterChild (named "imageobject") e of + Nothing -> return (mempty, nullAttr) + Just z -> case filterChild (named "imagedata") z of + Nothing -> return (mempty, nullAttr) + Just i -> let atVal a = attrValue a i + w = case atVal "width" of + "" -> [] + d -> [("width", d)] + h = case atVal "depth" of + "" -> [] + d -> [("height", d)] + atr = (atVal "id", words $ atVal "role", w ++ h) + in return (atVal "fileref", atr) let getCaption el = case filterChild (\x -> named "caption" x || named "textobject" x || named "alt" x) el of @@ -649,7 +658,7 @@ getMediaobject e = do let (caption, title) = if isNull figTitle then (getCaption e, "") else (return figTitle, "fig:") - liftM (image imageUrl title) caption + liftM (imageWith attr imageUrl title) caption getBlocks :: Element -> DB Blocks getBlocks e = mconcat <$> (mapM parseBlock $ elContent e) @@ -968,7 +977,8 @@ parseInline (Elem e) = Just h -> h _ -> ('#' : attrValue "linkend" e) let ils' = if ils == mempty then str href else ils - return $ link href "" ils' + let attr = (attrValue "id" e, words $ attrValue "role" e, []) + return $ linkWith attr href "" ils' "foreignphrase" -> emph <$> innerInlines "emphasis" -> case attrValue "role" e of "bold" -> strong <$> innerInlines diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index ab49bf002..44f67ce75 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -298,10 +298,17 @@ runToInlines (Footnote bps) = do runToInlines (Endnote bps) = do blksList <- concatReduce <$> (mapM bodyPartToBlocks bps) return $ note blksList -runToInlines (InlineDrawing fp bs) = do +runToInlines (InlineDrawing fp bs ext) = do mediaBag <- gets docxMediaBag modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag } - return $ image fp "" "" + return $ imageWith (extentToAttr ext) fp "" "" + +extentToAttr :: Extent -> Attr +extentToAttr (Just (w, h)) = + ("", [], [("width", showDim w), ("height", showDim h)] ) + where + showDim d = show (d / 914400) ++ "in" +extentToAttr _ = nullAttr parPartToInlines :: ParPart -> DocxContext Inlines parPartToInlines (PlainRun r) = runToInlines r @@ -348,10 +355,10 @@ parPartToInlines (BookMark _ anchor) = unless inHdrBool (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}) return $ spanWith (newAnchor, ["anchor"], []) mempty -parPartToInlines (Drawing fp bs) = do +parPartToInlines (Drawing fp bs ext) = do mediaBag <- gets docxMediaBag modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag } - return $ image fp "" "" + return $ imageWith (extentToAttr ext) fp "" "" parPartToInlines (InternalHyperLink anchor runs) = do ils <- concatReduce <$> mapM runToInlines runs return $ link ('#' : anchor) "" ils @@ -486,7 +493,7 @@ bodyPartToBlocks (Paragraph pPr parparts) return $ case isNull ils' of True -> mempty _ -> parStyleToTransform pPr $ para ils' -bodyPartToBlocks (ListItem pPr numId lvl levelInfo parparts) = do +bodyPartToBlocks (ListItem pPr numId lvl (Just levelInfo) parparts) = do let kvs = case levelInfo of (_, fmt, txt, Just start) -> [ ("level", lvl) @@ -503,6 +510,10 @@ bodyPartToBlocks (ListItem pPr numId lvl levelInfo parparts) = do ] blks <- bodyPartToBlocks (Paragraph pPr parparts) return $ divWith ("", ["list-item"], kvs) blks +bodyPartToBlocks (ListItem pPr _ _ _ parparts) = + let pPr' = pPr {pStyle = "ListParagraph": (pStyle pPr)} + in + bodyPartToBlocks $ Paragraph pPr' parparts bodyPartToBlocks (Tbl _ _ _ []) = return $ para mempty bodyPartToBlocks (Tbl cap _ look (r:rs)) = do @@ -535,10 +546,10 @@ bodyPartToBlocks (OMathPara e) = do -- replace targets with generated anchors. rewriteLink' :: Inline -> DocxContext Inline -rewriteLink' l@(Link ils ('#':target, title)) = do +rewriteLink' l@(Link attr ils ('#':target, title)) = do anchorMap <- gets docxAnchorMap return $ case M.lookup target anchorMap of - Just newTarget -> (Link ils ('#':newTarget, title)) + Just newTarget -> (Link attr ils ('#':newTarget, title)) Nothing -> l rewriteLink' il = return il diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 432965d49..eec8b12c9 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -35,6 +35,7 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..) , Body(..) , BodyPart(..) , TblLook(..) + , Extent , ParPart(..) , Run(..) , RunElem(..) @@ -62,6 +63,7 @@ import Control.Monad.Reader import Control.Applicative ((<|>)) import qualified Data.Map as M import Text.Pandoc.Compat.Except +import Text.Pandoc.Shared (safeRead) import Text.TeXMath.Readers.OMML (readOMML) import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..)) import Text.TeXMath (Exp) @@ -75,6 +77,7 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes , envFont :: Maybe Font , envCharStyles :: CharStyleMap , envParStyles :: ParStyleMap + , envLocation :: DocumentLocation } deriving Show @@ -87,7 +90,7 @@ instance Error DocxError where type D = ExceptT DocxError (Reader ReaderEnv) runD :: D a -> ReaderEnv -> Either DocxError a -runD dx re = runReader (runExceptT dx ) re +runD dx re = runReader (runExceptT dx) re maybeToD :: Maybe a -> D a maybeToD (Just a) = return a @@ -140,7 +143,10 @@ data AbstractNumb = AbstractNumb String [Level] -- (ilvl, format, string, start) type Level = (String, String, String, Maybe Integer) -data Relationship = Relationship (RelId, Target) +data DocumentLocation = InDocument | InFootnote | InEndnote + deriving (Eq,Show) + +data Relationship = Relationship DocumentLocation RelId Target deriving Show data Notes = Notes NameSpaces @@ -173,7 +179,7 @@ defaultParagraphStyle = ParagraphStyle { pStyle = [] data BodyPart = Paragraph ParagraphStyle [ParPart] - | ListItem ParagraphStyle String String Level [ParPart] + | ListItem ParagraphStyle String String (Maybe Level) [ParPart] | Tbl String TblGrid TblLook [Row] | OMathPara [Exp] deriving Show @@ -192,20 +198,23 @@ data Row = Row [Cell] data Cell = Cell [BodyPart] deriving Show +-- (width, height) in EMUs +type Extent = Maybe (Double, Double) + data ParPart = PlainRun Run | Insertion ChangeId Author ChangeDate [Run] | Deletion ChangeId Author ChangeDate [Run] | BookMark BookMarkId Anchor | InternalHyperLink Anchor [Run] | ExternalHyperLink URL [Run] - | Drawing FilePath B.ByteString + | Drawing FilePath B.ByteString Extent | PlainOMath [Exp] deriving Show data Run = Run RunStyle [RunElem] | Footnote [BodyPart] | Endnote [BodyPart] - | InlineDrawing FilePath B.ByteString + | InlineDrawing FilePath B.ByteString Extent deriving Show data RunElem = TextRun String | LnBrk | Tab | SoftHyphen | NoBreakHyphen @@ -238,7 +247,6 @@ defaultRunStyle = RunStyle { isBold = Nothing , rUnderline = Nothing , rStyle = Nothing} - type Target = String type Anchor = String type URL = String @@ -255,7 +263,8 @@ archiveToDocx archive = do rels = archiveToRelationships archive media = archiveToMedia archive (styles, parstyles) = archiveToStyles archive - rEnv = ReaderEnv notes numbering rels media Nothing styles parstyles + rEnv = + ReaderEnv notes numbering rels media Nothing styles parstyles InDocument doc <- runD (archiveToDocument archive) rEnv return $ Docx doc @@ -362,29 +371,30 @@ archiveToNotes zf = in Notes ns fn en -filePathIsRel :: FilePath -> Bool -filePathIsRel fp = - let (dir, name) = splitFileName fp - in - (dir == "word/_rels/") && ((takeExtension name) == ".rels") +filePathToRelType :: FilePath -> Maybe DocumentLocation +filePathToRelType "word/_rels/document.xml.rels" = Just InDocument +filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote +filePathToRelType "word/_rels/endnotes.xml.rels" = Just InEndnote +filePathToRelType _ = Nothing -relElemToRelationship :: Element -> Maybe Relationship -relElemToRelationship element | qName (elName element) == "Relationship" = +relElemToRelationship :: DocumentLocation -> Element -> Maybe Relationship +relElemToRelationship relType element | qName (elName element) == "Relationship" = do relId <- findAttr (QName "Id" Nothing Nothing) element target <- findAttr (QName "Target" Nothing Nothing) element - return $ Relationship (relId, target) -relElemToRelationship _ = Nothing - - + return $ Relationship relType relId target +relElemToRelationship _ _ = Nothing + +filePathToRelationships :: Archive -> FilePath -> [Relationship] +filePathToRelationships ar fp | Just relType <- filePathToRelType fp + , Just entry <- findEntryByPath fp ar + , Just relElems <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry = + mapMaybe (relElemToRelationship relType) $ elChildren relElems +filePathToRelationships _ _ = [] + archiveToRelationships :: Archive -> [Relationship] archiveToRelationships archive = - let relPaths = filter filePathIsRel (filesInArchive archive) - entries = mapMaybe (\f -> findEntryByPath f archive) relPaths - relElems = mapMaybe (parseXMLDoc . UTF8.toStringLazy . fromEntry) entries - rels = mapMaybe relElemToRelationship $ concatMap elChildren relElems - in - rels + concatMap (filePathToRelationships archive) $ filesInArchive archive filePathIsMedia :: FilePath -> Bool filePathIsMedia fp = @@ -409,6 +419,7 @@ lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do lvl <- lookup ilvl $ map (\l@(i, _, _, _) -> (i, l)) lvls return lvl + numElemToNum :: NameSpaces -> Element -> Maybe Numb numElemToNum ns element | qName (elName element) == "num" && @@ -558,9 +569,8 @@ elemToBodyPart ns element let parstyle = elemToParagraphStyle ns element sty parparts <- mapD (elemToParPart ns) (elChildren element) num <- asks envNumbering - case lookupLevel numId lvl num of - Just levelInfo -> return $ ListItem parstyle numId lvl levelInfo parparts - Nothing -> throwError WrongElem + let levelInfo = lookupLevel numId lvl num + return $ ListItem parstyle numId lvl levelInfo parparts elemToBodyPart ns element | isElem ns "w" "p" element = do sty <- asks envParStyles @@ -569,11 +579,8 @@ elemToBodyPart ns element case pNumInfo parstyle of Just (numId, lvl) -> do num <- asks envNumbering - case lookupLevel numId lvl num of - Just levelInfo -> - return $ ListItem parstyle numId lvl levelInfo parparts - Nothing -> - throwError WrongElem + let levelInfo = lookupLevel numId lvl num + return $ ListItem parstyle numId lvl levelInfo parparts Nothing -> return $ Paragraph parstyle parparts elemToBodyPart ns element | isElem ns "w" "tbl" element = do @@ -596,13 +603,16 @@ elemToBodyPart ns element return $ Tbl caption grid tblLook rows elemToBodyPart _ _ = throwError WrongElem -lookupRelationship :: RelId -> [Relationship] -> Maybe Target -lookupRelationship relid rels = - lookup relid (map (\(Relationship pair) -> pair) rels) +lookupRelationship :: DocumentLocation -> RelId -> [Relationship] -> Maybe Target +lookupRelationship docLocation relid rels = + lookup (docLocation, relid) pairs + where + pairs = map (\(Relationship loc relid' target) -> ((loc, relid'), target)) rels expandDrawingId :: String -> D (FilePath, B.ByteString) expandDrawingId s = do - target <- asks (lookupRelationship s . envRelationships) + location <- asks envLocation + target <- asks (lookupRelationship location s . envRelationships) case target of Just filepath -> do bytes <- asks (lookup ("word/" ++ filepath) . envMedia) @@ -614,13 +624,13 @@ expandDrawingId s = do elemToParPart :: NameSpaces -> Element -> D ParPart elemToParPart ns element | isElem ns "w" "r" element - , Just _ <- findChild (elemName ns "w" "drawing") element = + , Just drawingElem <- findChild (elemName ns "w" "drawing") element = let a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main" drawing = findElement (QName "blip" (Just a_ns) (Just "a")) element >>= findAttr (QName "embed" (lookup "r" ns) (Just "r")) in case drawing of - Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs) + Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs $ elemToExtent drawingElem) Nothing -> throwError WrongElem -- The below is an attempt to deal with images in deprecated vml format. elemToParPart ns element @@ -630,7 +640,7 @@ elemToParPart ns element >>= findAttr (elemName ns "r" "id") in case drawing of - Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs) + Just s -> expandDrawingId s >>= (\(fp, bs) -> return $ Drawing fp bs Nothing) Nothing -> throwError WrongElem elemToParPart ns element | isElem ns "w" "r" element = @@ -657,9 +667,10 @@ elemToParPart ns element elemToParPart ns element | isElem ns "w" "hyperlink" element , Just relId <- findAttr (elemName ns "r" "id") element = do + location <- asks envLocation runs <- mapD (elemToRun ns) (elChildren element) rels <- asks envRelationships - case lookupRelationship relId rels of + case lookupRelationship location relId rels of Just target -> do case findAttr (elemName ns "w" "anchor") element of Just anchor -> return $ ExternalHyperLink (target ++ '#':anchor) runs @@ -681,6 +692,16 @@ lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s) lookupEndnote :: String -> Notes -> Maybe Element lookupEndnote s (Notes _ _ ens) = ens >>= (M.lookup s) +elemToExtent :: Element -> Extent +elemToExtent drawingElem = + case (getDim "cx", getDim "cy") of + (Just w, Just h) -> Just (w, h) + _ -> Nothing + where + wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing" + getDim at = findElement (QName "extent" (Just wp_ns) (Just "wp")) drawingElem + >>= findAttr (QName at Nothing Nothing) >>= safeRead + elemToRun :: NameSpaces -> Element -> D Run elemToRun ns element | isElem ns "w" "r" element @@ -691,7 +712,7 @@ elemToRun ns element in case drawing of Just s -> expandDrawingId s >>= - (\(fp, bs) -> return $ InlineDrawing fp bs) + (\(fp, bs) -> return $ InlineDrawing fp bs $ elemToExtent drawingElem) Nothing -> throwError WrongElem elemToRun ns element | isElem ns "w" "r" element @@ -699,7 +720,7 @@ elemToRun ns element , Just fnId <- findAttr (elemName ns "w" "id") ref = do notes <- asks envNotes case lookupFootnote fnId notes of - Just e -> do bps <- mapD (elemToBodyPart ns) (elChildren e) + Just e -> do bps <- local (\r -> r {envLocation=InFootnote}) $ mapD (elemToBodyPart ns) (elChildren e) return $ Footnote bps Nothing -> return $ Footnote [] elemToRun ns element @@ -708,7 +729,7 @@ elemToRun ns element , Just enId <- findAttr (elemName ns "w" "id") ref = do notes <- asks envNotes case lookupEndnote enId notes of - Just e -> do bps <- mapD (elemToBodyPart ns) (elChildren e) + Just e -> do bps <- local (\r -> r {envLocation=InEndnote}) $ mapD (elemToBodyPart ns) (elChildren e) return $ Endnote bps Nothing -> return $ Endnote [] elemToRun ns element diff --git a/src/Text/Pandoc/Readers/EPUB.hs b/src/Text/Pandoc/Readers/EPUB.hs index 2da5e9e18..79aa540f6 100644 --- a/src/Text/Pandoc/Readers/EPUB.hs +++ b/src/Text/Pandoc/Readers/EPUB.hs @@ -16,6 +16,7 @@ import Text.Pandoc.Options ( ReaderOptions(..), readerTrace) import Text.Pandoc.Shared (escapeURI, collapseFilePath, addMetaField) import Text.Pandoc.MediaBag (MediaBag, insertMedia) import Text.Pandoc.Compat.Except (MonadError, throwError, runExcept, Except) +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.MIME (MimeType) import qualified Text.Pandoc.Builder as B import Codec.Archive.Zip ( Archive (..), toArchive, fromEntry @@ -99,12 +100,12 @@ fetchImages mimes root arc (query iq -> links) = <$> findEntryByPath abslink arc iq :: Inline -> [FilePath] -iq (Image _ (url, _)) = [url] +iq (Image _ _ (url, _)) = [url] iq _ = [] -- Remove relative paths renameImages :: FilePath -> Inline -> Inline -renameImages root (Image a (url, b)) = Image a (collapseFilePath (root </> url), b) +renameImages root (Image attr a (url, b)) = Image attr a (collapseFilePath (root </> url), b) renameImages _ x = x imageToPandoc :: FilePath -> Pandoc @@ -189,14 +190,14 @@ fixInlineIRs s (Span as v) = Span (fixAttrs s as) v fixInlineIRs s (Code as code) = Code (fixAttrs s as) code -fixInlineIRs s (Link t ('#':url, tit)) = - Link t (addHash s url, tit) +fixInlineIRs s (Link attr t ('#':url, tit)) = + Link attr t (addHash s url, tit) fixInlineIRs _ v = v prependHash :: [String] -> Inline -> Inline -prependHash ps l@(Link is (url, tit)) +prependHash ps l@(Link attr is (url, tit)) | or [s `isPrefixOf` url | s <- ps] = - Link is ('#':url, tit) + Link attr is ('#':url, tit) | otherwise = l prependHash _ i = i diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index 8b66d2d3d..a34e2fb5c 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -66,7 +66,7 @@ import Control.Monad.Reader (Reader,ask, asks, local, runReader) import Network.URI (isURI) import Text.Pandoc.Error import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps) - +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Parsec.Error @@ -601,16 +601,8 @@ pLineBreak = do return B.linebreak pLink :: TagParser Inlines -pLink = pRelLink <|> pAnchor - -pAnchor :: TagParser Inlines -pAnchor = try $ do - tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "id")) - return $ B.spanWith (fromAttrib "id" tag , [], []) mempty - -pRelLink :: TagParser Inlines -pRelLink = try $ do - tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href")) +pLink = try $ do + tag <- pSatisfy $ tagOpenLit "a" (const True) mbBaseHref <- baseHref <$> getState let url' = fromAttrib "href" tag let url = case (isURI url', mbBaseHref) of @@ -618,11 +610,9 @@ pRelLink = try $ do _ -> url' let title = fromAttrib "title" tag let uid = fromAttrib "id" tag - let spanC = case uid of - [] -> id - s -> B.spanWith (s, [], []) + let cls = words $ fromAttrib "class" tag lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a") - return $ spanC $ B.link (escapeURI url) title lab + return $ B.linkWith (uid, cls, []) (escapeURI url) title lab pImage :: TagParser Inlines pImage = do @@ -634,7 +624,13 @@ pImage = do _ -> url' let title = fromAttrib "title" tag let alt = fromAttrib "alt" tag - return $ B.image (escapeURI url) title (B.text alt) + let uid = fromAttrib "id" tag + let cls = words $ fromAttrib "class" tag + let getAtt k = case fromAttrib k tag of + "" -> [] + v -> [(k, v)] + let kvs = concat $ map getAtt ["width", "height", "sizes", "srcset"] + return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt) pCode :: TagParser Inlines pCode = try $ do @@ -803,7 +799,10 @@ pBad = do return $ B.str [c'] pSpace :: InlinesParser Inlines -pSpace = many1 (satisfy isSpace) >> return B.space +pSpace = many1 (satisfy isSpace) >>= \xs -> + if '\n' `elem` xs + then return B.softbreak + else return B.space -- -- Constants @@ -948,6 +947,7 @@ htmlTag f = try $ do parseOptions{ optTagWarning = True } inp guard $ f next case next of + TagWarning _ -> fail "encountered TagWarning" TagComment s | "<!--" `isPrefixOf` inp -> do count (length s + 4) anyChar diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 2b74f5f62..16f3d7ef3 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -16,6 +16,7 @@ module Text.Pandoc.Readers.Haddock import Text.Pandoc.Builder (Blocks, Inlines) import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Shared (trim, splitBy) import Data.List (intersperse, stripPrefix) import Data.Maybe (fromMaybe) diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 359661c3e..5a4612862 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -54,6 +54,7 @@ import Data.List (intercalate) import qualified Data.Map as M import qualified Control.Exception as E import Text.Pandoc.Highlighting (fromListingsLanguage) +import Text.Pandoc.ImageSize (numUnit, showFl) import Text.Pandoc.Error -- | Parse LaTeX from string and return 'Pandoc' document. @@ -99,8 +100,13 @@ dimenarg = try $ do return $ ch ++ num ++ dim sp :: LP () -sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t') - <|> try (newline <* lookAhead anyChar <* notFollowedBy blankline) +sp = whitespace <|> endline + +whitespace :: LP () +whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t') + +endline :: LP () +endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline) isLowerHex :: Char -> Bool isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f' @@ -166,24 +172,37 @@ mathChars = (concat <$>) $ quoted' :: (Inlines -> Inlines) -> LP String -> LP () -> LP Inlines quoted' f starter ender = do startchs <- starter - try ((f . mconcat) <$> manyTill inline ender) <|> lit startchs + smart <- getOption readerSmart + if smart + then do + ils <- many (notFollowedBy ender >> inline) + (ender >> return (f (mconcat ils))) <|> + lit (case startchs of + "``" -> "“" + "`" -> "‘" + _ -> startchs) + else lit startchs doubleQuote :: LP Inlines -doubleQuote = - quoted' doubleQuoted (try $ string "``") (void $ try $ string "''") - <|> quoted' doubleQuoted (string "“") (void $ char '”') - -- the following is used by babel for localized quotes: - <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'") - <|> quoted' doubleQuoted (string "\"") (void $ char '"') +doubleQuote = do + quoted' doubleQuoted (try $ string "``") (void $ try $ string "''") + <|> quoted' doubleQuoted (string "“") (void $ char '”') + -- the following is used by babel for localized quotes: + <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'") + <|> quoted' doubleQuoted (string "\"") (void $ char '"') singleQuote :: LP Inlines -singleQuote = - quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter) - <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter) +singleQuote = do + smart <- getOption readerSmart + if smart + then quoted' singleQuoted (string "`") (try $ char '\'' >> notFollowedBy letter) + <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter) + else str <$> many1 (oneOf "`\'‘’") inline :: LP Inlines inline = (mempty <$ comment) - <|> (space <$ sp) + <|> (space <$ whitespace) + <|> (softbreak <$ endline) <|> inlineText <|> inlineCommand <|> inlineEnvironment @@ -392,7 +411,8 @@ inlineCommand = try $ do star <- option "" (string "*") let name' = name ++ star let raw = do - rawcommand <- getRawCommand name' + rawargs <- withRaw (skipopts *> option "" dimenarg *> many braced) + let rawcommand = '\\' : name ++ star ++ snd rawargs transformed <- applyMacros' rawcommand if transformed /= rawcommand then parseFromString inlines transformed @@ -522,7 +542,9 @@ inlineCommands = M.fromList $ , ("href", (unescapeURL <$> braced <* optional sp) >>= \url -> tok >>= \lab -> pure (link url "" lab)) - , ("includegraphics", skipopts *> (unescapeURL <$> braced) >>= mkImage) + , ("includegraphics", do options <- option [] keyvals + src <- unescapeURL <$> braced + mkImage options src) , ("enquote", enquote) , ("cite", citation "cite" AuthorInText False) , ("Cite", citation "cite" AuthorInText False) @@ -584,14 +606,19 @@ inlineCommands = M.fromList $ -- in which case they will appear as raw latex blocks: [ "index" ] -mkImage :: String -> LP Inlines -mkImage src = do +mkImage :: [(String, String)] -> String -> LP Inlines +mkImage options src = do + let replaceTextwidth (k,v) = case numUnit v of + Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%") + _ -> (k, v) + let kvs = map replaceTextwidth $ filter (\(k,_) -> k `elem` ["width", "height"]) options + let attr = ("",[], kvs) let alt = str "image" case takeExtension src of "" -> do defaultExt <- getOption readerDefaultImageExtension - return $ image (addExtension src defaultExt) "" alt - _ -> return $ image src "" alt + return $ imageWith attr (addExtension src defaultExt) "" alt + _ -> return $ imageWith attr src "" alt inNote :: Inlines -> Inlines inNote ils = @@ -886,7 +913,7 @@ verbatimEnv' = fmap snd <$> string "\\begin" name <- braced' guard $ name `elem` ["verbatim", "Verbatim", "lstlisting", - "minted", "alltt"] + "minted", "alltt", "comment"] manyTill anyChar (try $ string $ "\\end{" ++ name ++ "}") blob' :: IncludeParser @@ -972,7 +999,7 @@ readFileFromDirs (d:ds) f = keyval :: LP (String, String) keyval = try $ do key <- many1 alphaNum - val <- option "" $ char '=' >> many1 alphaNum + val <- option "" $ char '=' >> many1 (alphaNum <|> char '.' <|> char '\\') skipMany spaceChar optional (char ',') skipMany spaceChar @@ -999,11 +1026,11 @@ rawLaTeXInline = do addImageCaption :: Blocks -> LP Blocks addImageCaption = walkM go - where go (Image alt (src,tit)) = do + where go (Image attr alt (src,tit)) = do mbcapt <- stateCaption <$> getState return $ case mbcapt of - Just ils -> Image (toList ils) (src, "fig:") - Nothing -> Image alt (src,tit) + Just ils -> Image attr (toList ils) (src, "fig:") + Nothing -> Image attr alt (src,tit) go x = return x addTableCaption :: Blocks -> LP Blocks @@ -1039,6 +1066,7 @@ environments = M.fromList , ("code", guardEnabled Ext_literate_haskell *> (codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$> verbEnv "code")) + , ("comment", mempty <$ verbEnv "comment") , ("verbatim", codeBlock <$> verbEnv "verbatim") , ("Verbatim", do options <- option [] keyvals let kvs = [ (if k == "firstnumber" diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index f2b0872bb..7b1341af4 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -39,6 +39,8 @@ import Data.Ord ( comparing ) import Data.Char ( isSpace, isAlphaNum, toLower ) import Data.Maybe import Text.Pandoc.Definition +import Text.Pandoc.Emoji (emojis) +import Text.Pandoc.Generic (bottomUp) import qualified Data.Text as T import Data.Text (Text) import qualified Data.Yaml as Yaml @@ -50,6 +52,7 @@ import qualified Data.Vector as V import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import Text.Pandoc.Options import Text.Pandoc.Shared +import Text.Pandoc.Pretty (charWidth) import Text.Pandoc.XML (fromEntities) import Text.Pandoc.Parsing hiding (tableWith) import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock ) @@ -62,6 +65,7 @@ import Text.HTML.TagSoup.Match (tagOpen) import qualified Data.Set as Set import Text.Printf (printf) import Debug.Trace (trace) +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Error type MarkdownParser = Parser [Char] ParserState @@ -326,23 +330,22 @@ stopLine = try $ (string "---" <|> string "...") >> blankline >> return () mmdTitleBlock :: MarkdownParser () mmdTitleBlock = try $ do guardEnabled Ext_mmd_title_block - kvPairs <- many1 kvPair + firstPair <- kvPair False + restPairs <- many (kvPair True) + let kvPairs = firstPair : restPairs blanklines updateState $ \st -> st{ stateMeta' = stateMeta' st <> return (Meta $ M.fromList kvPairs) } -kvPair :: MarkdownParser (String, MetaValue) -kvPair = try $ do +kvPair :: Bool -> MarkdownParser (String, MetaValue) +kvPair allowEmpty = try $ do key <- many1Till (alphaNum <|> oneOf "_- ") (char ':') - skipMany1 spaceNoNewline - val <- manyTill anyChar + val <- trim <$> manyTill anyChar (try $ newline >> lookAhead (blankline <|> nonspaceChar)) - guard $ not . null . trim $ val + guard $ allowEmpty || not (null val) let key' = concat $ words $ map toLower key - let val' = MetaBlocks $ B.toList $ B.plain $ B.text $ trim val + let val' = MetaBlocks $ B.toList $ B.plain $ B.text $ val return (key',val') - where - spaceNoNewline = satisfy (\x -> isSpace x && (x/='\n') && (x/='\r')) parseMarkdown :: MarkdownParser Pandoc parseMarkdown = do @@ -355,7 +358,19 @@ parseMarkdown = do st <- getState let meta = runF (stateMeta' st) st let Pandoc _ bs = B.doc $ runF blocks st - return $ Pandoc meta bs + eastAsianLineBreaks <- option False $ + True <$ guardEnabled Ext_east_asian_line_breaks + return $ (if eastAsianLineBreaks + then bottomUp softBreakFilter + else id) $ Pandoc meta bs + +softBreakFilter :: [Inline] -> [Inline] +softBreakFilter (x:SoftBreak:y:zs) = + case (stringify x, stringify y) of + (xs@(_:_), (c:_)) + | charWidth (last xs) == 2 && charWidth c == 2 -> x:y:zs + _ -> x:SoftBreak:y:zs +softBreakFilter xs = xs referenceKey :: MarkdownParser (F Blocks) referenceKey = try $ do @@ -367,23 +382,26 @@ referenceKey = try $ do let sourceURL = liftM unwords $ many $ try $ do skipMany spaceChar notFollowedBy' referenceTitle + notFollowedBy' $ guardEnabled Ext_link_attributes >> attributes notFollowedBy' (() <$ reference) many1 $ notFollowedBy space >> litChar let betweenAngles = try $ char '<' >> manyTill litChar (char '>') src <- try betweenAngles <|> sourceURL tit <- option "" referenceTitle - -- currently we just ignore MMD-style link/image attributes - _kvs <- option [] $ guardEnabled Ext_link_attributes - >> many (try $ spnl >> keyValAttr) + attr <- option nullAttr $ try $ + guardEnabled Ext_link_attributes >> skipSpaces >> attributes + addKvs <- option [] $ guardEnabled Ext_mmd_link_attributes + >> many (try $ spnl >> keyValAttr) blanklines - let target = (escapeURI $ trimr src, tit) + let attr' = extractIdClass $ foldl (\x f -> f x) attr addKvs + target = (escapeURI $ trimr src, tit) st <- getState let oldkeys = stateKeys st let key = toKey raw case M.lookup key oldkeys of Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'" Nothing -> return () - updateState $ \s -> s { stateKeys = M.insert key target oldkeys } + updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys } return $ return mempty referenceTitle :: MarkdownParser String @@ -466,7 +484,6 @@ block = do res <- choice [ mempty <$ blanklines , codeBlockFenced , yamlMetaBlock - , guardEnabled Ext_latex_macros *> (macro >>= return . return) -- note: bulletList needs to be before header because of -- the possibility of empty list items: - , bulletList @@ -476,6 +493,7 @@ block = do , htmlBlock , table , codeBlockIndented + , guardEnabled Ext_latex_macros *> (macro >>= return . return) , rawTeXBlock , lineBlock , blockQuote @@ -516,9 +534,9 @@ atxHeader = try $ do (text, raw) <- withRaw $ trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline) attr <- atxClosing - attr'@(ident,_,_) <- registerHeader attr (runF text defaultParserState) + attr' <- registerHeader attr (runF text defaultParserState) guardDisabled Ext_implicit_header_references - <|> registerImplicitHeader raw ident + <|> registerImplicitHeader raw attr' return $ B.headerWith attr' level <$> text atxClosing :: MarkdownParser Attr @@ -559,16 +577,16 @@ setextHeader = try $ do many (char underlineChar) blanklines let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1 - attr'@(ident,_,_) <- registerHeader attr (runF text defaultParserState) + attr' <- registerHeader attr (runF text defaultParserState) guardDisabled Ext_implicit_header_references - <|> registerImplicitHeader raw ident + <|> registerImplicitHeader raw attr' return $ B.headerWith attr' level <$> text -registerImplicitHeader :: String -> String -> MarkdownParser () -registerImplicitHeader raw ident = do +registerImplicitHeader :: String -> Attr -> MarkdownParser () +registerImplicitHeader raw attr@(ident, _, _) = do let key = toKey $ "[" ++ raw ++ "]" updateState (\s -> s { stateHeaderKeys = - M.insert key ('#':ident,"") (stateHeaderKeys s) }) + M.insert key (('#':ident,""), attr) (stateHeaderKeys s) }) -- -- hrule block @@ -979,11 +997,11 @@ para = try $ do return $ do result' <- result case B.toList result' of - [Image alt (src,tit)] + [Image attr alt (src,tit)] | Ext_implicit_figures `Set.member` exts -> -- the fig: at beginning of title indicates a figure return $ B.para $ B.singleton - $ Image alt (src,'f':'i':'g':':':tit) + $ Image attr alt (src,'f':'i':'g':':':tit) _ -> return $ B.para result' plain :: MarkdownParser (F Blocks) @@ -1321,7 +1339,7 @@ removeOneLeadingSpace xs = gridTableFooter :: MarkdownParser [Char] gridTableFooter = blanklines -pipeBreak :: MarkdownParser [Alignment] +pipeBreak :: MarkdownParser ([Alignment], [Int]) pipeBreak = try $ do nonindentSpaces openPipe <- (True <$ char '|') <|> return False @@ -1331,16 +1349,23 @@ pipeBreak = try $ do guard $ not (null rest && not openPipe) optional (char '|') blankline - return (first:rest) + return $ unzip (first:rest) pipeTable :: MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]]) pipeTable = try $ do nonindentSpaces lookAhead nonspaceChar - (heads,aligns) <- (,) <$> pipeTableRow <*> pipeBreak - lines' <- sequence <$> many pipeTableRow - let widths = replicate (length aligns) 0.0 - return $ (aligns, widths, heads, lines') + (heads,(aligns, seplengths)) <- (,) <$> pipeTableRow <*> pipeBreak + lines' <- many pipeTableRow + let maxlength = maximum $ + map (\x -> length . stringify $ runF x def) (heads : lines') + numColumns <- getOption readerColumns + let widths = if maxlength > numColumns + then map (\len -> + fromIntegral (len + 1) / fromIntegral numColumns) + seplengths + else replicate (length aligns) 0.0 + return $ (aligns, widths, heads, sequence lines') sepPipe :: MarkdownParser () sepPipe = try $ do @@ -1369,19 +1394,20 @@ pipeTableRow = do ils' | B.isNull ils' -> mempty | otherwise -> B.plain $ ils') cells' -pipeTableHeaderPart :: Parser [Char] st Alignment +pipeTableHeaderPart :: Parser [Char] st (Alignment, Int) pipeTableHeaderPart = try $ do skipMany spaceChar left <- optionMaybe (char ':') - many1 (char '-') + pipe <- many1 (char '-') right <- optionMaybe (char ':') skipMany spaceChar + let len = length pipe + maybe 0 (const 1) left + maybe 0 (const 1) right return $ - case (left,right) of - (Nothing,Nothing) -> AlignDefault - (Just _,Nothing) -> AlignLeft - (Nothing,Just _) -> AlignRight - (Just _,Just _) -> AlignCenter + ((case (left,right) of + (Nothing,Nothing) -> AlignDefault + (Just _,Nothing) -> AlignLeft + (Nothing,Just _) -> AlignRight + (Just _,Just _) -> AlignCenter), len) -- Succeed only if current line contains a pipe. scanForPipe :: Parser [Char] st () @@ -1460,6 +1486,7 @@ inline = choice [ whitespace , exampleRef , smart , return . B.singleton <$> charRef + , emoji , symbol , ltSign ] <?> "inline" @@ -1666,7 +1693,7 @@ endline = try $ do (eof >> return mempty) <|> (guardEnabled Ext_hard_line_breaks >> return (return B.linebreak)) <|> (guardEnabled Ext_ignore_line_breaks >> return mempty) - <|> (return $ return B.space) + <|> (skipMany spaceChar >> return (return B.softbreak)) -- -- links @@ -1710,16 +1737,18 @@ link = try $ do setState $ st{ stateAllowLinks = False } (lab,raw) <- reference setState $ st{ stateAllowLinks = True } - regLink B.link lab <|> referenceLink B.link (lab,raw) + regLink B.linkWith lab <|> referenceLink B.linkWith (lab,raw) -regLink :: (String -> String -> Inlines -> Inlines) +regLink :: (Attr -> String -> String -> Inlines -> Inlines) -> F Inlines -> MarkdownParser (F Inlines) regLink constructor lab = try $ do (src, tit) <- source - return $ constructor src tit <$> lab + attr <- option nullAttr $ + guardEnabled Ext_link_attributes >> attributes + return $ constructor attr src tit <$> lab -- a link like [this][ref] or [this][] or [this] -referenceLink :: (String -> String -> Inlines -> Inlines) +referenceLink :: (Attr -> String -> String -> Inlines -> Inlines) -> (F Inlines, String) -> MarkdownParser (F Inlines) referenceLink constructor (lab, raw) = do sp <- (True <$ lookAhead (char ' ')) <|> return False @@ -1731,7 +1760,7 @@ referenceLink constructor (lab, raw) = do let labIsRef = raw' == "" || raw' == "[]" let key = toKey $ if labIsRef then raw else raw' parsedRaw <- parseFromString (mconcat <$> many inline) raw' - fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw + fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw implicitHeaderRefs <- option False $ True <$ guardEnabled Ext_implicit_header_references let makeFallback = do @@ -1748,10 +1777,10 @@ referenceLink constructor (lab, raw) = do then do headerKeys <- asksF stateHeaderKeys case M.lookup key headerKeys of - Just (src, tit) -> constructor src tit <$> lab - Nothing -> makeFallback + Just ((src, tit), _) -> constructor nullAttr src tit <$> lab + Nothing -> makeFallback else makeFallback - Just (src,tit) -> constructor src tit <$> lab + Just ((src,tit), attr) -> constructor attr src tit <$> lab dropBrackets :: String -> String dropBrackets = reverse . dropRB . reverse . dropLB @@ -1785,9 +1814,9 @@ image = try $ do char '!' (lab,raw) <- reference defaultExt <- getOption readerDefaultImageExtension - let constructor src = case takeExtension src of - "" -> B.image (addExtension src defaultExt) - _ -> B.image src + let constructor attr' src = case takeExtension src of + "" -> B.imageWith attr' (addExtension src defaultExt) + _ -> B.imageWith attr' src regLink constructor lab <|> referenceLink constructor (lab,raw) note :: MarkdownParser (F Inlines) @@ -1891,6 +1920,21 @@ rawHtmlInline = do else not . isTextTag return $ return $ B.rawInline "html" result +-- Emoji + +emojiChars :: [Char] +emojiChars = ['a'..'z'] ++ ['0'..'9'] ++ ['_','+','-'] + +emoji :: MarkdownParser (F Inlines) +emoji = try $ do + guardEnabled Ext_emoji + char ':' + emojikey <- many1 (oneOf emojiChars) + char ':' + case M.lookup emojikey emojis of + Just s -> return (return (B.str s)) + Nothing -> mzero + -- Citations cite :: MarkdownParser (F Inlines) @@ -1923,7 +1967,7 @@ textualCite = try $ do spc | null spaces' = mempty | otherwise = B.space lab <- parseFromString (mconcat <$> many inline) $ dropBrackets raw' - fallback <- referenceLink B.link (lab,raw') + fallback <- referenceLink B.linkWith (lab,raw') return $ do fallback' <- fallback cs' <- cs diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index 4f5f9c293..e423720df 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -39,6 +39,7 @@ module Text.Pandoc.Readers.MediaWiki ( readMediaWiki ) where import Text.Pandoc.Definition import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Options import Text.Pandoc.Readers.HTML ( htmlTag, isBlockTag, isCommentTag ) import Text.Pandoc.XML ( fromEntities ) @@ -554,7 +555,8 @@ inlineHtml :: MWParser Inlines inlineHtml = B.rawInline "html" . snd <$> htmlTag isInlineTag' whitespace :: MWParser Inlines -whitespace = B.space <$ (skipMany1 spaceChar <|> endline <|> htmlComment) +whitespace = B.space <$ (skipMany1 spaceChar <|> htmlComment) + <|> B.softbreak <$ endline endline :: MWParser () endline = () <$ try (newline <* @@ -575,21 +577,29 @@ image = try $ do sym "[[" choice imageIdentifiers fname <- many1 (noneOf "|]") - _ <- many (try $ char '|' *> imageOption) + _ <- many imageOption + dims <- try (char '|' *> (sepBy (many digit) (char 'x')) <* string "px") + <|> return [] + _ <- many imageOption + let kvs = case dims of + w:[] -> [("width", w)] + w:(h:[]) -> [("width", w), ("height", h)] + _ -> [] + let attr = ("", [], kvs) caption <- (B.str fname <$ sym "]]") <|> try (char '|' *> (mconcat <$> manyTill inline (sym "]]"))) - return $ B.image fname ("fig:" ++ stringify caption) caption + return $ B.imageWith attr fname ("fig:" ++ stringify caption) caption imageOption :: MWParser String -imageOption = - try (oneOfStrings [ "border", "thumbnail", "frameless" - , "thumb", "upright", "left", "right" - , "center", "none", "baseline", "sub" - , "super", "top", "text-top", "middle" - , "bottom", "text-bottom" ]) - <|> try (string "frame") - <|> try (many1 (oneOf "x0123456789") <* string "px") - <|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]")) +imageOption = try $ char '|' *> opt + where + opt = try (oneOfStrings [ "border", "thumbnail", "frameless" + , "thumb", "upright", "left", "right" + , "center", "none", "baseline", "sub" + , "super", "top", "text-top", "middle" + , "bottom", "text-bottom" ]) + <|> try (string "frame") + <|> try (oneOfStrings ["link=","alt=","page=","class="] <* many (noneOf "|]")) collapseUnderscores :: String -> String collapseUnderscores [] = [] diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs index 2cc83183f..30f96c557 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/State.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/State.hs @@ -46,6 +46,7 @@ import Control.Monad import Data.Foldable +import Text.Pandoc.Compat.Monoid import Text.Pandoc.Readers.Odt.Arrows.Utils import Text.Pandoc.Readers.Odt.Generic.Fallible diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs index d4dcf5be2..8c9ee0539 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -46,7 +46,7 @@ import qualified Data.Foldable as F import Text.Pandoc.Readers.Odt.Generic.Fallible import Text.Pandoc.Readers.Odt.Generic.Utils - +import Text.Pandoc.Compat.Monoid and2 :: (Arrow a) => a b c -> a b c' -> a b (c,c') and2 = (&&&) @@ -129,24 +129,23 @@ joinOn :: (Arrow a) => (x -> y -> z) -> a (x,y) z joinOn = arr.uncurry -- | Applies a function to the uncurried result-pair of an arrow-application. --- (The §-symbol was chosen to evoke an association with pairs through the --- shared first character) -(>>§) :: (Arrow a) => a x (b,c) -> (b -> c -> d) -> a x d -a >>§ f = a >>^ uncurry f +-- (The %-symbol was chosen to evoke an association with pairs.) +(>>%) :: (Arrow a) => a x (b,c) -> (b -> c -> d) -> a x d +a >>% f = a >>^ uncurry f --- | '(>>§)' with its arguments flipped -(§<<) :: (Arrow a) => (b -> c -> d) -> a x (b,c) -> a x d -(§<<) = flip (>>§) +-- | '(>>%)' with its arguments flipped +(%<<) :: (Arrow a) => (b -> c -> d) -> a x (b,c) -> a x d +(%<<) = flip (>>%) -- | Precomposition with an uncurried function -(§>>) :: (Arrow a) => (b -> c -> d) -> a d r -> a (b,c) r -f §>> a = uncurry f ^>> a +(%>>) :: (Arrow a) => (b -> c -> d) -> a d r -> a (b,c) r +f %>> a = uncurry f ^>> a -- | Precomposition with an uncurried function (right to left variant) -(<<§) :: (Arrow a) => a d r -> (b -> c -> d) -> a (b,c) r -(<<§) = flip (§>>) +(<<%) :: (Arrow a) => a d r -> (b -> c -> d) -> a (b,c) r +(<<%) = flip (%>>) -infixr 2 >>§, §<<, §>>, <<§ +infixr 2 >>%, %<<, %>>, <<% -- | Duplicate a value and apply an arrow to the second instance. @@ -271,7 +270,7 @@ newtype ParallelArrow a b c = CoEval { evalParallelArrow :: a b c } instance (Arrow a, Monoid m) => Monoid (ParallelArrow a b m) where mempty = CoEval $ returnV mempty - (CoEval a) `mappend` (CoEval ~b) = CoEval $ a &&& b >>§ mappend + (CoEval a) `mappend` (CoEval ~b) = CoEval $ a &&& b >>% mappend -- | Evaluates a collection of arrows in a parallel fashion. -- @@ -433,29 +432,29 @@ a ^>>?^? f = a ^>> Left ^|||^ f a >>?! f = a >>> right f --- -(>>?§) :: (ArrowChoice a, Monoid f) +(>>?%) :: (ArrowChoice a, Monoid f) => FallibleArrow a x f (b,b') -> (b -> b' -> c) -> FallibleArrow a x f c -a >>?§ f = a >>?^ (uncurry f) +a >>?% f = a >>?^ (uncurry f) --- -(^>>?§) :: (ArrowChoice a, Monoid f) +(^>>?%) :: (ArrowChoice a, Monoid f) => (x -> Either f (b,b')) -> (b -> b' -> c) -> FallibleArrow a x f c -a ^>>?§ f = arr a >>?^ (uncurry f) +a ^>>?% f = arr a >>?^ (uncurry f) --- -(>>?§?) :: (ArrowChoice a, Monoid f) +(>>?%?) :: (ArrowChoice a, Monoid f) => FallibleArrow a x f (b,b') -> (b -> b' -> (Either f c)) -> FallibleArrow a x f c -a >>?§? f = a >>?^? (uncurry f) +a >>?%? f = a >>?^? (uncurry f) infixr 1 >>?, >>?^, >>?^? infixr 1 ^>>?, ^>>?^, ^>>?^?, >>?! -infixr 1 >>?§, ^>>?§, >>?§? +infixr 1 >>?%, ^>>?%, >>?%? -- | Keep values that are Right, replace Left values by a constant. ifFailedUse :: (ArrowChoice a) => v -> a (Either f v) v diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 9ff3532e1..1f1c57646 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -145,7 +145,7 @@ type OdtReaderSafe a b = XMLReaderSafe ReaderState a b fromStyles :: (a -> Styles -> b) -> OdtReaderSafe a b fromStyles f = keepingTheValue (getExtraState >>^ styleSet) - >>§ f + >>% f -- getStyleByName :: OdtReader StyleName Style @@ -162,7 +162,7 @@ lookupListStyle = fromStyles lookupListStyleByName >>^ maybeToChoice -- switchCurrentListStyle :: OdtReaderSafe (Maybe ListStyle) (Maybe ListStyle) switchCurrentListStyle = keepingTheValue getExtraState - >>§ swapCurrentListStyle + >>% swapCurrentListStyle >>> first setExtraState >>^ snd @@ -170,7 +170,7 @@ switchCurrentListStyle = keepingTheValue getExtraState pushStyle :: OdtReaderSafe Style Style pushStyle = keepingTheValue ( ( keepingTheValue getExtraState - >>§ pushStyle' + >>% pushStyle' ) >>> setExtraState ) @@ -470,7 +470,7 @@ matchingElement :: (Monoid e) matchingElement ns name reader = (ns, name, asResultAccumulator reader) where asResultAccumulator :: (ArrowChoice a, Monoid m) => a m m -> a m (Fallible m) - asResultAccumulator a = liftAsSuccess $ keepingTheValue a >>§ (<>) + asResultAccumulator a = liftAsSuccess $ keepingTheValue a >>% (<>) -- matchChildContent' :: (Monoid result) @@ -497,14 +497,14 @@ matchChildContent ls fallback = returnV mempty >>> matchContent ls fallback -- -- | Open Document allows several consecutive spaces if they are marked up read_plain_text :: OdtReaderSafe (Inlines, XML.Content) Inlines -read_plain_text = fst ^&&& read_plain_text' >>§ recover +read_plain_text = fst ^&&& read_plain_text' >>% recover where -- fallible version read_plain_text' :: OdtReader (Inlines, XML.Content) Inlines read_plain_text' = ( second ( arr extractText ) >>^ spreadChoice >>?! second text ) - >>?§ (<>) + >>?% (<>) -- extractText :: XML.Content -> Fallible String extractText (XML.Text cData) = succeedWith (XML.cdData cData) diff --git a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs index 343ec14ee..d0fdc228f 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/Fallible.hs @@ -41,7 +41,7 @@ module Text.Pandoc.Readers.Odt.Generic.Fallible where import Control.Applicative import Control.Monad - +import Text.Pandoc.Compat.Monoid ((<>)) import qualified Data.Foldable as F -- | Default for now. Will probably become a class at some point. diff --git a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs index 7c1764889..8c03d1a09 100644 --- a/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs +++ b/src/Text/Pandoc/Readers/Odt/Generic/XMLConverter.hs @@ -331,7 +331,7 @@ convertingExtraState v a = withSubStateF setVAsExtraState modifyWithA where setVAsExtraState = liftAsSuccess $ extractFromState id >>^ replaceExtraState v modifyWithA = keepingTheValue (moreState ^>> a) - >>^ spreadChoice >>?§ flip replaceExtraState + >>^ spreadChoice >>?% flip replaceExtraState -- | First sets the extra state to the new value. Then produces a new -- extra state with a converter that uses the new state. Finally, the @@ -413,14 +413,14 @@ elemName :: (NameSpaceID nsID) -> XMLConverter nsID extraState x XML.QName elemName nsID name = lookupNSiri nsID &&& lookupNSprefix nsID - >>§ XML.QName name + >>% XML.QName name -- | Checks if a given element matches both a specified namespace id -- and a specified element name elemNameIs :: (NameSpaceID nsID) => nsID -> ElementName -> XMLConverter nsID extraState XML.Element Bool -elemNameIs nsID name = keepingTheValue (lookupNSiri nsID) >>§ hasThatName +elemNameIs nsID name = keepingTheValue (lookupNSiri nsID) >>% hasThatName where hasThatName e iri = let elName = XML.elName e in XML.qName elName == name && XML.qURI elName == iri @@ -461,8 +461,8 @@ currentElemIs'' nsID name = ( (getCurrentElement >>^ XML.elName >>> (XML.qName >>^ (&&).(== name) ) ^&&&^ (XML.qIRI >>^ (==) ) - ) >>§ (.) - ) &&& lookupNSiri nsID >>§ ($) + ) >>% (.) + ) &&& lookupNSiri nsID >>% ($) -} -- @@ -487,7 +487,7 @@ findChildren :: (NameSpaceID nsID) -> XMLConverter nsID extraState x [XML.Element] findChildren nsID name = elemName nsID name &&& getCurrentElement - >>§ XML.findChildren + >>% XML.findChildren -- filterChildren :: (XML.Element -> Bool) @@ -508,7 +508,7 @@ findChild' :: (NameSpaceID nsID) -> XMLConverter nsID extraState x (Maybe XML.Element) findChild' nsID name = elemName nsID name &&& getCurrentElement - >>§ XML.findChild + >>% XML.findChild -- findChild :: (NameSpaceID nsID) @@ -596,7 +596,7 @@ isThatTheAttrValue :: (NameSpaceID nsID) isThatTheAttrValue nsID attrName = keepingTheValue (findAttr nsID attrName) - >>§ right.(==) + >>% right.(==) -- | Lookup value in a dictionary, fail if no attribute found or value -- not in dictionary @@ -669,7 +669,7 @@ findAttr' :: (NameSpaceID nsID) -> XMLConverter nsID extraState x (Maybe AttributeValue) findAttr' nsID attrName = elemName nsID attrName &&& getCurrentElement - >>§ XML.findAttr + >>% XML.findAttr -- | Return value as string or fail findAttr :: (NameSpaceID nsID) @@ -787,7 +787,7 @@ prepareIteration :: (NameSpaceID nsID) -> XMLConverter nsID extraState b [(b, XML.Element)] prepareIteration nsID name = keepingTheValue (findChildren nsID name) - >>§ distributeValue + >>% distributeValue -- | Applies a converter to every child element of a specific type. -- Collects results in a 'Monoid'. @@ -877,9 +877,9 @@ makeMatcherE nsID name c = ( second ( elemNameIs nsID name >>^ bool Nothing (Just tryC) ) - >>§ (<|>) + >>% (<|>) ) &&&^ snd - where tryC = (fst ^&&& executeThere c >>§ recover) &&&^ snd + where tryC = (fst ^&&& executeThere c >>% recover) &&&^ snd -- Helper function: The @c@ is actually a converter that is to be selected by -- matching XML content to the first two parameters. @@ -899,14 +899,14 @@ makeMatcherC nsID name c = ( second ( contentToElem >>^ bool Nothing (Just cWithJump) ) ) - >>§ (<|>) + >>% (<|>) ) &&&^ snd where cWithJump = ( fst ^&&& ( second contentToElem >>> spreadChoice ^>>? executeThere c ) - >>§ recover) + >>% recover) &&&^ snd contentToElem :: FallibleXMLConverter nsID extraState XML.Content XML.Element contentToElem = arr $ \e -> case e of diff --git a/src/Text/Pandoc/Readers/Odt/Namespaces.hs b/src/Text/Pandoc/Readers/Odt/Namespaces.hs index e28056814..deb009998 100644 --- a/src/Text/Pandoc/Readers/Odt/Namespaces.hs +++ b/src/Text/Pandoc/Readers/Odt/Namespaces.hs @@ -107,4 +107,4 @@ nsIDs = [ ("http://www.w3.org/1999/xhtml" , NsXHtml ), ("http://www.w3.org/2002/xforms" , NsXForms ), ("http://www.w3.org/1999/xlink" , NsXLink ) - ]
\ No newline at end of file + ] diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index e403424f6..96cfed0b3 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -174,7 +174,7 @@ findPitch :: XMLReaderSafe FontPitches _x (Maybe FontPitch) findPitch = ( lookupAttr NsStyle "font-pitch" `ifFailedDo` findAttr NsStyle "font-name" >>? ( keepingTheValue getExtraState - >>§ M.lookup + >>% M.lookup >>^ maybeToChoice ) ) @@ -447,7 +447,7 @@ readAllStyles :: StyleReader _x Styles readAllStyles = ( readFontPitches >>?! ( readAutomaticStyles &&& readStyles )) - >>?§? chooseMax + >>?%? chooseMax -- all top elements are always on the same hierarchy level -- diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 27a8fe957..99a6927e2 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-} {- -Copyright (C) 2014-2015 Albert Krewinkel <tarleb@moltkeplatz.de> +Copyright (C) 2014-2015 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> 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 @@ -21,10 +21,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Org - Copyright : Copyright (C) 2014 Albert Krewinkel + Copyright : Copyright (C) 2014-2015 Albert Krewinkel License : GNU GPL, version 2 or above - Maintainer : Albert Krewinkel <tarleb@moltkeplatz.de> + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> Conversion of org-mode formatted plain text to 'Pandoc' document. -} @@ -34,6 +34,7 @@ import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), trimInlines ) import Text.Pandoc.Definition +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Options import qualified Text.Pandoc.Parsing as P import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF @@ -140,6 +141,7 @@ data OrgParserState = OrgParserState , orgStateMeta :: Meta , orgStateMeta' :: F Meta , orgStateNotes' :: OrgNoteTable + , orgStateParserContext :: ParserContext , orgStateIdentifiers :: [String] , orgStateHeaderMap :: M.Map Inlines String } @@ -181,6 +183,7 @@ defaultOrgParserState = OrgParserState , orgStateMeta = nullMeta , orgStateMeta' = return nullMeta , orgStateNotes' = [] + , orgStateParserContext = NullState , orgStateIdentifiers = [] , orgStateHeaderMap = M.empty } @@ -291,6 +294,23 @@ blanklines = <* updateLastPreCharPos <* updateLastForbiddenCharPos +-- | Succeeds when we're in list context. +inList :: OrgParser () +inList = do + ctx <- orgStateParserContext <$> getState + guard (ctx == ListItemState) + +-- | Parse in different context +withContext :: ParserContext -- ^ New parser context + -> OrgParser a -- ^ Parser to run in that context + -> OrgParser a +withContext context parser = do + oldContext <- orgStateParserContext <$> getState + updateState $ \s -> s{ orgStateParserContext = context } + result <- parser + updateState $ \s -> s{ orgStateParserContext = oldContext } + return result + -- -- parsing blocks -- @@ -513,10 +533,16 @@ rundocBlockClass :: String rundocBlockClass = rundocPrefix ++ "block" blockOption :: OrgParser (String, String) -blockOption = try $ (,) <$> orgArgKey <*> orgParamValue +blockOption = try $ do + argKey <- orgArgKey + paramValue <- option "yes" orgParamValue + return (argKey, paramValue) inlineBlockOption :: OrgParser (String, String) -inlineBlockOption = try $ (,) <$> orgArgKey <*> orgInlineParamValue +inlineBlockOption = try $ do + argKey <- orgArgKey + paramValue <- option "yes" orgInlineParamValue + return (argKey, paramValue) orgArgKey :: OrgParser String orgArgKey = try $ @@ -525,11 +551,17 @@ orgArgKey = try $ orgParamValue :: OrgParser String orgParamValue = try $ - skipSpaces *> many1 (noneOf "\t\n\r ") <* skipSpaces + skipSpaces + *> notFollowedBy (char ':' ) + *> many1 (noneOf "\t\n\r ") + <* skipSpaces orgInlineParamValue :: OrgParser String orgInlineParamValue = try $ - skipSpaces *> many1 (noneOf "\t\n\r ]") <* skipSpaces + skipSpaces + *> notFollowedBy (char ':') + *> many1 (noneOf "\t\n\r ]") + <* skipSpaces orgArgWordChar :: OrgParser Char orgArgWordChar = alphaNum <|> oneOf "-_" @@ -699,7 +731,7 @@ headerTags = try $ headerStart :: OrgParser Int headerStart = try $ - (length <$> many1 (char '*')) <* many1 (char ' ') + (length <$> many1 (char '*')) <* many1 (char ' ') <* updateLastPreCharPos -- Don't use (or need) the reader wrapper here, we want hline to be @@ -891,9 +923,13 @@ noteBlock = try $ do paraOrPlain :: OrgParser (F Blocks) paraOrPlain = try $ do ils <- parseInlines - nl <- option False (newline >> return True) - try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >> - return (B.para <$> ils)) + nl <- option False (newline *> return True) + -- Read block as paragraph, except if we are in a list context and the block + -- is directly followed by a list item, in which case the block is read as + -- plain text. + try (guard nl + *> notFollowedBy (inList *> (orderedListStart <|> bulletListStart)) + *> return (B.para <$> ils)) <|> (return (B.plain <$> ils)) inlinesTillNewline :: OrgParser (F Inlines) @@ -958,19 +994,22 @@ definitionListItem :: OrgParser Int -> OrgParser (F (Inlines, [Blocks])) definitionListItem parseMarkerGetLength = try $ do markerLength <- parseMarkerGetLength - term <- manyTill (noneOf "\n\r") (try $ string "::") + term <- manyTill (noneOf "\n\r") (try definitionMarker) line1 <- anyLineNewline blank <- option "" ("\n" <$ blankline) cont <- concat <$> many (listContinuation markerLength) term' <- parseFromString parseInlines term contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont return $ (,) <$> term' <*> fmap (:[]) contents' + where + definitionMarker = + spaceChar *> string "::" <* (spaceChar <|> lookAhead P.newline) -- parse raw text for one list item, excluding start marker and continuations listItem :: OrgParser Int -> OrgParser (F Blocks) -listItem start = try $ do +listItem start = try . withContext ListItemState $ do markerLength <- try start firstLine <- anyLineNewline blank <- option "" ("\n" <$ blankline) @@ -1064,7 +1103,7 @@ endline = try $ do decEmphasisNewlinesCount guard =<< newlinesCountWithinLimits updateLastPreCharPos - return . return $ B.space + return . return $ B.softbreak cite :: OrgParser (F Inlines) cite = try $ do @@ -1549,8 +1588,11 @@ smart :: OrgParser (F Inlines) smart = do getOption readerSmart >>= guard doubleQuoted <|> singleQuoted <|> - choice (map (return <$>) [orgApostrophe, dash, ellipses]) - where orgApostrophe = + choice (map (return <$>) [orgApostrophe, orgDash, orgEllipses]) + where + orgDash = dash <* updatePositions '-' + orgEllipses = ellipses <* updatePositions '.' + orgApostrophe = (char '\'' <|> char '\8217') <* updateLastPreCharPos <* updateLastForbiddenCharPos *> return (B.str "\x2019") @@ -1558,9 +1600,10 @@ smart = do singleQuoted :: OrgParser (F Inlines) singleQuoted = try $ do singleQuoteStart + updatePositions '\'' withQuoteContext InSingleQuote $ fmap B.singleQuoted . trimInlinesF . mconcat <$> - many1Till inline singleQuoteEnd + many1Till inline (singleQuoteEnd <* updatePositions '\'') -- doubleQuoted will handle regular double-quoted sections, as well -- as dialogues with an open double-quote without a close double-quote @@ -1568,6 +1611,7 @@ singleQuoted = try $ do doubleQuoted :: OrgParser (F Inlines) doubleQuoted = try $ do doubleQuoteStart + updatePositions '"' contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline) (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return (fmap B.doubleQuoted . trimInlinesF $ contents)) diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 4fb30e6c4..7be0cd392 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -48,7 +48,7 @@ import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import qualified Text.Pandoc.Builder as B import Data.Sequence (viewr, ViewR(..)) import Data.Char (toLower, isHexDigit, isSpace) - +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Error -- | Parse reStructuredText string and return Pandoc document. @@ -541,6 +541,12 @@ directive' = do body <- option "" $ try $ blanklines >> indentedBlock optional blanklines let body' = body ++ "\n\n" + imgAttr cl = ("", classes, getAtt "width" ++ getAtt "height") + where + classes = words $ maybe "" trim $ lookup cl fields + getAtt k = case lookup k fields of + Just v -> [(k, filter (not . isSpace) v)] + Nothing -> [] case label of "raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body) "role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields @@ -590,15 +596,16 @@ directive' = do "figure" -> do (caption, legend) <- parseFromString extractCaption body' let src = escapeURI $ trim top - return $ B.para (B.image src "fig:" caption) <> legend + return $ B.para (B.imageWith (imgAttr "figclass") src "fig:" caption) <> legend "image" -> do let src = escapeURI $ trim top let alt = B.str $ maybe "image" trim $ lookup "alt" fields + let attr = imgAttr "class" return $ B.para $ case lookup "target" fields of Just t -> B.link (escapeURI $ trim t) "" - $ B.image src "" alt - Nothing -> B.image src "" alt + $ B.imageWith attr src "" alt + Nothing -> B.imageWith attr src "" alt "class" -> do let attrs = ("", (splitBy isSpace $ trim top), map (\(k,v) -> (k, trimr v)) fields) -- directive content or the first immediately following element @@ -812,10 +819,10 @@ substKey = try $ do res <- B.toList <$> directive' il <- case res of -- use alt unless :alt: attribute on image: - [Para [Image [Str "image"] (src,tit)]] -> - return $ B.image src tit alt - [Para [Link [Image [Str "image"] (src,tit)] (src',tit')]] -> - return $ B.link src' tit' (B.image src tit alt) + [Para [Image attr [Str "image"] (src,tit)]] -> + return $ B.imageWith attr src tit alt + [Para [Link _ [Image attr [Str "image"] (src,tit)] (src',tit')]] -> + return $ B.link src' tit' (B.imageWith attr src tit alt) [Para ils] -> return $ B.fromList ils _ -> mzero let key = toKey $ stripFirstAndLast ref @@ -827,7 +834,8 @@ anonymousKey = try $ do src <- targetURI pos <- getPosition let key = toKey $ "_" ++ printf "%09d" (sourceLine pos) - updateState $ \s -> s { stateKeys = M.insert key (src,"") $ stateKeys s } + --TODO: parse width, height, class and name attributes + updateState $ \s -> s { stateKeys = M.insert key ((src,""), nullAttr) $ stateKeys s } stripTicks :: String -> String stripTicks = reverse . stripTick . reverse . stripTick @@ -841,7 +849,8 @@ regularKey = try $ do char ':' src <- targetURI let key = toKey $ stripTicks ref - updateState $ \s -> s { stateKeys = M.insert key (src,"") $ stateKeys s } + --TODO: parse width, height, class and name attributes + updateState $ \s -> s { stateKeys = M.insert key ((src,""), nullAttr) $ stateKeys s } -- -- tables @@ -1096,7 +1105,7 @@ endline = try $ do then notFollowedBy (anyOrderedListMarker >> spaceChar) >> notFollowedBy' bulletListStart else return () - return B.space + return B.softbreak -- -- links @@ -1131,12 +1140,12 @@ referenceLink = try $ do if null anonKeys then mzero else return (head anonKeys) - (src,tit) <- case M.lookup key keyTable of - Nothing -> fail "no corresponding key" - Just target -> return target + ((src,tit), attr) <- case M.lookup key keyTable of + Nothing -> fail "no corresponding key" + Just val -> return val -- if anonymous link, remove key so it won't be used again when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable } - return $ B.link src tit label' + return $ B.linkWith attr src tit label' autoURI :: RSTParser Inlines autoURI = do diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 83280aa2e..355285f54 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -51,6 +51,7 @@ TODO : refactor common patterns across readers : module Text.Pandoc.Readers.Textile ( readTextile) where +import Text.Pandoc.CSS import Text.Pandoc.Definition import Text.Pandoc.Builder (Inlines, Blocks, trimInlines) import qualified Text.Pandoc.Builder as B @@ -64,6 +65,7 @@ import Text.HTML.TagSoup.Match import Data.List ( intercalate ) import Data.Char ( digitToInt, isUpper) import Control.Monad ( guard, liftM, when ) +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Printf import Debug.Trace (trace) import Text.Pandoc.Error @@ -79,11 +81,12 @@ readTextile opts s = -- | Generate a Pandoc ADT from a textile document parseTextile :: Parser [Char] ParserState Pandoc parseTextile = do - -- textile allows raw HTML and does smart punctuation by default + -- textile allows raw HTML and does smart punctuation by default, + -- but we do not enable smart punctuation unless it is explicitly + -- asked for, for better conversion to other light markup formats oldOpts <- stateOptions `fmap` getState updateState $ \state -> state{ stateOptions = - oldOpts{ readerSmart = True - , readerParseRaw = True + oldOpts{ readerParseRaw = True , readerOldDashes = True } } many blankline @@ -533,10 +536,14 @@ link = try $ do image :: Parser [Char] ParserState Inlines image = try $ do char '!' >> notFollowedBy space + (ident, cls, kvs) <- attributes + let attr = case lookup "style" kvs of + Just stls -> (ident, cls, pickStylesToKVs ["width", "height"] stls) + Nothing -> (ident, cls, kvs) src <- manyTill anyChar' (lookAhead $ oneOf "!(") alt <- option "" (try $ (char '(' >> manyTill anyChar' (char ')'))) char '!' - return $ B.image src alt (B.str alt) + return $ B.imageWith attr src alt (B.str alt) escapedInline :: Parser [Char] ParserState Inlines escapedInline = escapedEqs <|> escapedTag diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 1c868f5f0..c28ce1653 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Txt2Tags ( readTxt2Tags import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder ( Inlines, Blocks, trimInlines ) +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared (escapeURI,compactify', compactify'DL) @@ -549,7 +550,7 @@ endline = try $ do notFollowedBy quote notFollowedBy list notFollowedBy table - return $ B.space + return $ B.softbreak str :: T2T Inlines str = try $ do diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index 4f4b6057b..390a7a21a 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -135,7 +135,7 @@ pCSSUrl media sourceURL d = P.try $ do 'd':'a':'t':'a':':':_ -> return fallback u -> do let url' = if isURI u then u else d </> u enc <- lift $ getDataURI media sourceURL "" url' - return (B.pack enc) + return (B.pack $ "url(" ++ enc ++ ")") getDataURI :: MediaBag -> Maybe String -> MimeType -> String diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 58e065845..9d799fa52 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -110,8 +110,9 @@ import Data.Char ( toLower, isLower, isUpper, isAlpha, import Data.List ( find, stripPrefix, intercalate ) import Data.Version ( showVersion ) import qualified Data.Map as M -import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo, - unEscapeString, parseURIReference, isAllowedInURI ) +import Network.URI ( escapeURIString, nonStrictRelativeTo, + unEscapeString, parseURIReference, isAllowedInURI, + parseURI, URI(..) ) import qualified Data.Set as Set import System.Directory import System.FilePath (splitDirectories, isPathSeparator) @@ -129,6 +130,7 @@ import System.IO (stderr) import System.IO.Temp import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..), renderOptions) +import Text.Pandoc.Compat.Monoid ((<>)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Base64 (decodeLenient) @@ -373,17 +375,19 @@ isSpaceOrEmpty (Str "") = True isSpaceOrEmpty _ = False -- | Extract the leading and trailing spaces from inside an inline element --- and place them outside the element. - +-- and place them outside the element. SoftBreaks count as Spaces for +-- these purposes. extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines extractSpaces f is = let contents = B.unMany is left = case viewl contents of - (Space :< _) -> B.space - _ -> mempty + (Space :< _) -> B.space + (SoftBreak :< _) -> B.softbreak + _ -> mempty right = case viewr contents of - (_ :> Space) -> B.space - _ -> mempty in + (_ :> Space) -> B.space + (_ :> SoftBreak) -> B.softbreak + _ -> mempty in (left <> f (B.trimInlines . B.Many $ contents) <> right) -- | Normalize @Pandoc@ document, consolidating doubled 'Space's, @@ -450,6 +454,8 @@ normalizeInlines (Str x : ys) = isStr _ = False fromStr (Str z) = z fromStr _ = error "normalizeInlines - fromStr - not a Str" +normalizeInlines (Space : SoftBreak : ys) = + SoftBreak : normalizeInlines ys normalizeInlines (Space : ys) = if null rest then [] @@ -522,10 +528,10 @@ normalizeInlines (Note bs : ys) = Note (normalizeBlocks bs) : normalizeInlines ys normalizeInlines (Quoted qt ils : ys) = Quoted qt (normalizeInlines ils) : normalizeInlines ys -normalizeInlines (Link ils t : ys) = - Link (normalizeInlines ils) t : normalizeInlines ys -normalizeInlines (Image ils t : ys) = - Image (normalizeInlines ils) t : normalizeInlines ys +normalizeInlines (Link attr ils t : ys) = + Link attr (normalizeInlines ils) t : normalizeInlines ys +normalizeInlines (Image attr ils t : ys) = + Image attr (normalizeInlines ils) t : normalizeInlines ys normalizeInlines (Cite cs ils : ys) = Cite cs (normalizeInlines ils) : normalizeInlines ys normalizeInlines (x : xs) = x : normalizeInlines xs @@ -537,6 +543,7 @@ removeFormatting = query go . walk deNote where go :: Inline -> [Inline] go (Str xs) = [Str xs] go Space = [Space] + go SoftBreak = [SoftBreak] go (Code _ x) = [Str x] go (Math _ x) = [Str x] go LineBreak = [Space] @@ -551,6 +558,7 @@ stringify :: Walkable Inline a => a -> String stringify = query go . walk deNote where go :: Inline -> [Char] go Space = " " + go SoftBreak = " " go (Str x) = x go (Code _ x) = x go (Math _ x) = x @@ -854,7 +862,6 @@ readDefaultDataFile fname = #else getDataFileName fname' >>= checkExistence >>= BS.readFile where fname' = if fname == "README" then fname else "data" </> fname -#endif checkExistence :: FilePath -> IO FilePath checkExistence fn = do @@ -862,6 +869,7 @@ checkExistence fn = do if exists then return fn else err 97 ("Could not find data file " ++ fn) +#endif -- | Read file from specified user data directory or, if not found there, from -- Cabal data directory. @@ -878,18 +886,30 @@ readDataFileUTF8 :: Maybe FilePath -> FilePath -> IO String readDataFileUTF8 userDir fname = UTF8.toString `fmap` readDataFile userDir fname +-- | Specialized version of parseURIReference that disallows +-- single-letter schemes. Reason: these are usually windows absolute +-- paths. +parseURIReference' :: String -> Maybe URI +parseURIReference' s = + case parseURIReference s of + Just u | length (uriScheme u) > 2 -> Just u + _ -> Nothing + -- | Fetch an image or other item from the local filesystem or the net. -- Returns raw content and maybe mime type. fetchItem :: Maybe String -> String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) fetchItem sourceURL s = - case (sourceURL >>= parseURIReference . ensureEscaped, ensureEscaped s) of - (_, s') | isURI s' -> openURL s' + case (sourceURL >>= parseURIReference' . ensureEscaped, ensureEscaped s) of (Just u, s') -> -- try fetching from relative path at source - case parseURIReference s' of + case parseURIReference' s' of Just u' -> openURL $ show $ u' `nonStrictRelativeTo` u Nothing -> openURL s' -- will throw error - (Nothing, _) -> E.try readLocalFile -- get from local file system + (Nothing, s') -> + case parseURI s' of -- requires absolute URI + -- We don't want to treat C:/ as a scheme: + Just u' | length (uriScheme u') > 2 -> openURL (show u') + _ -> E.try readLocalFile -- get from local file system where readLocalFile = do cont <- BS.readFile fp return (cont, mime) @@ -913,9 +933,9 @@ fetchItem' media sourceURL s = do -- | Read from a URL and return raw data and maybe mime type. openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType)) openURL u - | Just u' <- stripPrefix "data:" u = - let mime = takeWhile (/=',') u' - contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u' + | Just u'' <- stripPrefix "data:" u = + let mime = takeWhile (/=',') u'' + contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u'' in return $ Right (decodeLenient contents, Just mime) #ifdef HTTP_CLIENT | otherwise = withSocketsDo $ E.try $ do diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index 878c900f7..1a27ab5ac 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -40,7 +40,7 @@ getSlideLevel = go 6 | otherwise = go least (x:xs) go least (_ : xs) = go least xs go least [] = least - nonHOrHR (Header _ _ _) = False + nonHOrHR (Header{}) = False nonHOrHR (HorizontalRule) = False nonHOrHR _ = True diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index f366299d5..a010433fa 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -98,6 +98,7 @@ import Control.Monad (guard, when) import Data.Aeson (ToJSON(..), Value(..)) import qualified Text.Parsec as P import Text.Parsec.Text (Parser) +import Text.Pandoc.Compat.Monoid ((<>)) import qualified Data.Text as T import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index c3406f31f..4ac6aa093 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -46,6 +46,7 @@ import Text.Pandoc.Parsing hiding (blankline, space) import Data.Maybe (fromMaybe) import Data.List ( stripPrefix, intersperse, intercalate ) import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Control.Monad.State import qualified Data.Map as M import Data.Aeson (Value(String), fromJSON, toJSON, Result(..)) @@ -72,7 +73,7 @@ pandocToAsciiDoc :: WriterOptions -> Pandoc -> State WriterState String pandocToAsciiDoc opts (Pandoc meta blocks) = do let titleblock = not $ null (docTitle meta) && null (docAuthors meta) && null (docDate meta) - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing metadata <- metaToJSON opts @@ -126,8 +127,8 @@ blockToAsciiDoc _ Null = return empty blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> blankline -blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do - blockToAsciiDoc opts (Para [Image alt (src,tit)]) +blockToAsciiDoc opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do + blockToAsciiDoc opts (Para [Image attr alt (src,tit)]) blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines -- escape if para starts with ordered list marker @@ -159,13 +160,12 @@ blockToAsciiDoc opts (Header level (ident,_,_) inlines) = do _ -> empty) <> blankline else identifier $$ text (replicate level '=') <> space <> contents <> blankline) -blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ - flush (attrs <> dashes <> space <> attrs <> cr <> text str <> - cr <> dashes) <> blankline - where dashes = text $ replicate (maximum $ map length $ lines str) '-' - attrs = if null classes - then empty - else text $ intercalate "," $ "code" : classes +blockToAsciiDoc _ (CodeBlock (_,classes,_) str) = return $ (flush $ + if null classes + then "...." $$ text str $$ "...." + else attrs $$ "----" $$ text str $$ "----") + <> blankline + where attrs = "[" <> text (intercalate "," ("source" : classes)) <> "]" blockToAsciiDoc opts (BlockQuote blocks) = do contents <- blockListToAsciiDoc opts blocks let isBlock (BlockQuote _) = True @@ -227,7 +227,7 @@ blockToAsciiDoc opts (Table caption aligns widths headers rows) = do rows' <- mapM makeRow rows head' <- makeRow headers let head'' = if all null headers then empty else head' - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then writerColumns opts else 100000 let maxwidth = maximum $ map offset (head':rows') @@ -253,7 +253,10 @@ blockToAsciiDoc opts (OrderedList (_start, sty, _delim) items) = do blockToAsciiDoc opts (DefinitionList items) = do contents <- mapM (definitionListItemToAsciiDoc opts) items return $ cat contents <> blankline -blockToAsciiDoc opts (Div _ bs) = blockListToAsciiDoc opts bs +blockToAsciiDoc opts (Div (ident,_,_) bs) = do + let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + contents <- blockListToAsciiDoc opts bs + return $ identifier $$ contents -- | Convert bullet list item (list of blocks) to asciidoc. bulletListItemToAsciiDoc :: WriterOptions -> [Block] -> State WriterState Doc @@ -335,7 +338,7 @@ inlineListToAsciiDoc opts lst = do x' <- withIntraword $ inlineToAsciiDoc opts x xs' <- go xs return (y' <> x' <> xs') - | x /= Space && x /= LineBreak = do + | not (isSpacy x) = do y' <- withIntraword $ inlineToAsciiDoc opts y xs' <- go (x:xs) return (y' <> xs') @@ -345,6 +348,7 @@ inlineListToAsciiDoc opts lst = do return (x' <> xs') isSpacy Space = True isSpacy LineBreak = True + isSpacy SoftBreak = True isSpacy _ = False setIntraword :: Bool -> State WriterState () @@ -391,8 +395,13 @@ inlineToAsciiDoc _ (RawInline f s) | otherwise = return empty inlineToAsciiDoc _ (LineBreak) = return $ " +" <> cr inlineToAsciiDoc _ Space = return space +inlineToAsciiDoc opts SoftBreak = + case writerWrapText opts of + WrapAuto -> return space + WrapPreserve -> return cr + WrapNone -> return space inlineToAsciiDoc opts (Cite _ lst) = inlineListToAsciiDoc opts lst -inlineToAsciiDoc opts (Link txt (src, _tit)) = do +inlineToAsciiDoc opts (Link _ txt (src, _tit)) = do -- relative: link:downloads/foo.zip[download foo.zip] -- abs: http://google.cod[Google] -- or my@email.com[email john] @@ -408,7 +417,7 @@ inlineToAsciiDoc opts (Link txt (src, _tit)) = do return $ if useAuto then text srcSuffix else prefix <> text src <> "[" <> linktext <> "]" -inlineToAsciiDoc opts (Image alternate (src, tit)) = do +inlineToAsciiDoc opts (Image attr alternate (src, tit)) = do -- image:images/logo.png[Company logo, title="blah"] let txt = if (null alternate) || (alternate == [Str ""]) then [Str "image"] @@ -416,8 +425,19 @@ inlineToAsciiDoc opts (Image alternate (src, tit)) = do linktext <- inlineListToAsciiDoc opts txt let linktitle = if null tit then empty - else text $ ",title=\"" ++ tit ++ "\"" - return $ "image:" <> text src <> "[" <> linktext <> linktitle <> "]" + else ",title=\"" <> text tit <> "\"" + showDim dir = case (dimension dir attr) of + Just (Percent a) -> + ["scaledwidth=" <> text (show (Percent a))] + Just dim -> + [text (show dir) <> "=" <> text (showInPixel opts dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else "," <> cat (intersperse "," dimList) + return $ "image:" <> text src <> "[" <> linktext <> linktitle <> dims <> "]" inlineToAsciiDoc opts (Note [Para inlines]) = inlineToAsciiDoc opts (Note [Plain inlines]) inlineToAsciiDoc opts (Note [Plain inlines]) = do @@ -425,4 +445,8 @@ inlineToAsciiDoc opts (Note [Plain inlines]) = do return $ text "footnote:[" <> contents <> "]" -- asciidoc can't handle blank lines in notes inlineToAsciiDoc _ (Note _) = return "[multiblock footnote omitted]" -inlineToAsciiDoc opts (Span _ ils) = inlineListToAsciiDoc opts ils +inlineToAsciiDoc opts (Span (ident,_,_) ils) = do + let identifier = if (null ident) then empty else ("[[" <> text ident <> "]]") + contents <- inlineListToAsciiDoc opts ils + return $ identifier <> contents + diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index fee36d454..a786dfd24 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -75,7 +75,7 @@ blocksToCommonMark opts bs = return $ T.unpack $ nodeToCommonmark cmarkOpts colwidth $ node DOCUMENT (blocksToNodes bs) where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts] - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -84,7 +84,7 @@ inlinesToCommonMark opts ils = return $ T.unpack $ nodeToCommonmark cmarkOpts colwidth $ node PARAGRAPH (inlinesToNodes ils) where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts] - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing @@ -138,6 +138,7 @@ inlineToNodes :: Inline -> [Node] -> [Node] inlineToNodes (Str s) = (node (TEXT (T.pack s)) [] :) inlineToNodes Space = (node (TEXT (T.pack " ")) [] :) inlineToNodes LineBreak = (node LINEBREAK [] :) +inlineToNodes SoftBreak = (node SOFTBREAK [] :) inlineToNodes (Emph xs) = (node EMPH (inlinesToNodes xs) :) inlineToNodes (Strong xs) = (node STRONG (inlinesToNodes xs) :) inlineToNodes (Strikeout xs) = @@ -153,9 +154,9 @@ inlineToNodes (SmallCaps xs) = ((node (INLINE_HTML (T.pack "<span style=\"font-variant:small-caps;\">")) [] : inlinesToNodes xs ++ [node (INLINE_HTML (T.pack "</span>")) []]) ++ ) -inlineToNodes (Link ils (url,tit)) = +inlineToNodes (Link _ ils (url,tit)) = (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes ils) :) -inlineToNodes (Image ils (url,tit)) = +inlineToNodes (Image _ ils (url,tit)) = (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes ils) :) inlineToNodes (RawInline fmt xs) | fmt == Format "html" = (node (INLINE_HTML (T.pack xs)) [] :) diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 7d3830a60..6680e3003 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -35,10 +35,11 @@ import Text.Pandoc.Writers.Shared import Text.Pandoc.Options import Text.Pandoc.Walk (query) import Text.Printf ( printf ) -import Data.List ( intercalate ) +import Data.List ( intercalate, intersperse ) import Data.Char ( ord ) import Control.Monad.State import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Text.Pandoc.Templates ( renderTemplate' ) import Network.URI ( isURI, unEscapeString ) @@ -62,7 +63,7 @@ writeConTeXt options document = pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String pandocToConTeXt options (Pandoc meta blocks) = do - let colwidth = if writerWrapText options + let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options @@ -141,10 +142,14 @@ blockToConTeXt :: Block blockToConTeXt Null = return empty blockToConTeXt (Plain lst) = inlineListToConTeXt lst -- title beginning with fig: indicates that the image is a figure -blockToConTeXt (Para [Image txt (src,'f':'i':'g':':':_)]) = do +blockToConTeXt (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do capt <- inlineListToConTeXt txt - return $ blankline $$ "\\placefigure" <> braces capt <> - braces ("\\externalfigure" <> brackets (text src)) <> blankline + img <- inlineToConTeXt (Image attr txt (src, "")) + let (ident, _, _) = attr + label = if null ident + then empty + else "[]" <> brackets (text $ toLabel ident) + return $ blankline $$ "\\placefigure" <> label <> braces capt <> img <> blankline blockToConTeXt (Para lst) = do contents <- inlineListToConTeXt lst return $ contents <> blankline @@ -157,17 +162,21 @@ blockToConTeXt (CodeBlock _ str) = blockToConTeXt (RawBlock "context" str) = return $ text str <> blankline blockToConTeXt (RawBlock _ _ ) = return empty blockToConTeXt (Div (ident,_,kvs) bs) = do - contents <- blockListToConTeXt bs - let contents' = if null ident - then contents - else ("\\reference" <> brackets (text $ toLabel ident) <> - braces empty <> "%") $$ contents - let align dir = blankline <> "\\startalignment[" <> dir <> "]" - $$ contents' $$ "\\stopalignment" <> blankline - return $ case lookup "dir" kvs of - Just "rtl" -> align "righttoleft" - Just "ltr" -> align "lefttoright" - _ -> contents' + let align dir txt = "\\startalignment[" <> dir <> "]" $$ txt $$ "\\stopalignment" + let wrapRef txt = if null ident + then txt + else ("\\reference" <> brackets (text $ toLabel ident) <> + braces empty <> "%") $$ txt + wrapDir = case lookup "dir" kvs of + Just "rtl" -> align "righttoleft" + Just "ltr" -> align "lefttoright" + _ -> id + wrapLang txt = case lookup "lang" kvs of + Just lng -> "\\start\\language[" + <> text (fromBcp47' lng) <> "]" $$ txt $$ "\\stop" + Nothing -> txt + wrapBlank txt = blankline <> txt <> blankline + fmap (wrapBlank . wrapLang . wrapDir . wrapRef) $ blockListToConTeXt bs blockToConTeXt (BulletList lst) = do contents <- mapM listItemToConTeXt lst return $ ("\\startitemize" <> if isTightList lst @@ -306,9 +315,15 @@ inlineToConTeXt (RawInline "context" str) = return $ text str inlineToConTeXt (RawInline "tex" str) = return $ text str inlineToConTeXt (RawInline _ _) = return empty inlineToConTeXt (LineBreak) = return $ text "\\crlf" <> cr +inlineToConTeXt SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + return $ case wrapText of + WrapAuto -> space + WrapNone -> space + WrapPreserve -> cr inlineToConTeXt Space = return space -- Handle HTML-like internal document references to sections -inlineToConTeXt (Link txt (('#' : ref), _)) = do +inlineToConTeXt (Link _ txt (('#' : ref), _)) = do opts <- gets stOptions contents <- inlineListToConTeXt txt let ref' = toLabel $ stringToConTeXt opts ref @@ -316,7 +331,7 @@ inlineToConTeXt (Link txt (('#' : ref), _)) = do <> braces contents <> brackets (text ref') -inlineToConTeXt (Link txt (src, _)) = do +inlineToConTeXt (Link _ txt (src, _)) = do let isAutolink = txt == [Str (unEscapeString src)] st <- get let next = stNextRef st @@ -331,11 +346,29 @@ inlineToConTeXt (Link txt (src, _)) = do else brackets empty <> brackets contents) <> "\\from" <> brackets (text ref) -inlineToConTeXt (Image _ (src, _)) = do - let src' = if isURI src +inlineToConTeXt (Image attr@(_,cls,_) _ (src, _)) = do + opts <- gets stOptions + let showDim dir = let d = text (show dir) <> "=" + in case (dimension dir attr) of + Just (Pixel a) -> + [d <> text (showInInch opts (Pixel a)) <> "in"] + Just (Percent a) -> + [d <> text (showFl (a / 100)) <> "\\textwidth"] + Just dim -> + [d <> text (show dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else brackets $ cat (intersperse "," dimList) + clas = if null cls + then empty + else brackets $ text $ toLabel $ head cls + src' = if isURI src then src else unEscapeString src - return $ braces $ "\\externalfigure" <> brackets (text src') + return $ braces $ "\\externalfigure" <> brackets (text src') <> dims <> clas inlineToConTeXt (Note contents) = do contents' <- blockListToConTeXt contents let codeBlock x@(CodeBlock _ _) = [x] @@ -346,11 +379,15 @@ inlineToConTeXt (Note contents) = do else text "\\startbuffer " <> nest 2 contents' <> text "\\stopbuffer\\footnote{\\getbuffer}" inlineToConTeXt (Span (_,_,kvs) ils) = do - contents <- inlineListToConTeXt ils - return $ case lookup "dir" kvs of - Just "rtl" -> braces $ "\\righttoleft " <> contents - Just "ltr" -> braces $ "\\lefttoright " <> contents - _ -> contents + let wrapDir txt = case lookup "dir" kvs of + Just "rtl" -> braces $ "\\righttoleft " <> txt + Just "ltr" -> braces $ "\\lefttoright " <> txt + _ -> txt + wrapLang txt = case lookup "lang" kvs of + Just lng -> "\\start\\language[" <> text (fromBcp47' lng) + <> "]" <> txt <> "\\stop " + Nothing -> txt + fmap (wrapLang . wrapDir) $ inlineListToConTeXt ils -- | Craft the section header, inserting the secton reference, if supplied. sectionHeader :: Attr @@ -377,6 +414,9 @@ sectionHeader (ident,classes,_) hdrLevel lst = do then char '\\' <> chapter <> braces contents else contents <> blankline +fromBcp47' :: String -> String +fromBcp47' = fromBcp47 . splitBy (=='-') + -- Takes a list of the constituents of a BCP 47 language code -- and irons out ConTeXt's exceptions -- https://tools.ietf.org/html/bcp47#section-2.1 diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 8b7dde3e5..9671fc05b 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -222,7 +222,7 @@ blockToCustom _ Null = return "" blockToCustom lua (Plain inlines) = callfunc lua "Plain" inlines -blockToCustom lua (Para [Image txt (src,tit)]) = +blockToCustom lua (Para [Image _ txt (src,tit)]) = callfunc lua "CaptionedImage" src tit txt blockToCustom lua (Para inlines) = callfunc lua "Para" inlines @@ -276,6 +276,8 @@ inlineToCustom lua (Str str) = callfunc lua "Str" str inlineToCustom lua Space = callfunc lua "Space" +inlineToCustom lua SoftBreak = callfunc lua "SoftBreak" + inlineToCustom lua (Emph lst) = callfunc lua "Emph" lst inlineToCustom lua (Strong lst) = callfunc lua "Strong" lst @@ -308,11 +310,11 @@ inlineToCustom lua (RawInline format str) = inlineToCustom lua (LineBreak) = callfunc lua "LineBreak" -inlineToCustom lua (Link txt (src,tit)) = - callfunc lua "Link" txt src tit +inlineToCustom lua (Link attr txt (src,tit)) = + callfunc lua "Link" txt src tit (attrToMap attr) -inlineToCustom lua (Image alt (src,tit)) = - callfunc lua "Image" alt src tit +inlineToCustom lua (Image attr alt (src,tit)) = + callfunc lua "Image" alt src tit (attrToMap attr) inlineToCustom lua (Note contents) = callfunc lua "Note" contents diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 8f9eecea8..2aaebf99f 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -42,6 +42,7 @@ import Data.Char ( toLower ) import Data.Monoid ( Any(..) ) import Text.Pandoc.Highlighting ( languages, languagesByExtension ) import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import qualified Text.Pandoc.Builder as B import Text.TeXMath import qualified Text.XML.Light as Xml @@ -51,7 +52,7 @@ import Data.Generics (everywhere, mkT) authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines authorToDocbook opts name' = let name = render Nothing $ inlinesToDocbook opts name' - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing in B.rawInline "docbook" $ render colwidth $ @@ -75,7 +76,7 @@ authorToDocbook opts name' = writeDocbook :: WriterOptions -> Pandoc -> String writeDocbook opts (Pandoc meta blocks) = let elements = hierarchicalize blocks - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing render' = render colwidth @@ -150,6 +151,15 @@ listItemToDocbook :: WriterOptions -> [Block] -> Doc listItemToDocbook opts item = inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item +imageToDocbook :: WriterOptions -> Attr -> String -> Doc +imageToDocbook _ attr src = selfClosingTag "imagedata" $ + ("fileref", src) : idAndRole attr ++ dims + where + dims = go Width "width" ++ go Height "depth" + go dir dstr = case (dimension dir attr) of + Just a -> [(dstr, show a)] + Nothing -> [] + -- | Convert a Pandoc block element to Docbook. blockToDocbook :: WriterOptions -> Block -> Doc blockToDocbook _ Null = empty @@ -165,7 +175,7 @@ blockToDocbook opts (Div _ bs) = blocksToDocbook opts $ map plainToPara bs blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst -- title beginning with fig: indicates that the image is a figure -blockToDocbook opts (Para [Image txt (src,'f':'i':'g':':':_)]) = +blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = let alt = inlinesToDocbook opts txt capt = if null txt then empty @@ -174,7 +184,7 @@ blockToDocbook opts (Para [Image txt (src,'f':'i':'g':':':_)]) = capt $$ (inTagsIndented "mediaobject" $ (inTagsIndented "imageobject" - (selfClosingTag "imagedata" [("fileref",src)])) $$ + (imageToDocbook opts attr src)) $$ inTagsSimple "textobject" (inTagsSimple "phrase" alt)) blockToDocbook opts (Para lst) | hasLineBreaks lst = flush $ nowrap $ inTagsSimple "literallayout" $ inlinesToDocbook opts lst @@ -321,7 +331,9 @@ inlineToDocbook _ (RawInline f x) | f == "html" || f == "docbook" = text x | otherwise = empty inlineToDocbook _ LineBreak = text "\n" inlineToDocbook _ Space = space -inlineToDocbook opts (Link txt (src, _)) +-- because we use \n for LineBreak, we can't do soft breaks: +inlineToDocbook _ SoftBreak = space +inlineToDocbook opts (Link attr txt (src, _)) | Just email <- stripPrefix "mailto:" src = let emailLink = inTagsSimple "email" $ text $ escapeStringForXML $ email @@ -331,19 +343,30 @@ inlineToDocbook opts (Link txt (src, _)) char '(' <> emailLink <> char ')' | otherwise = (if isPrefixOf "#" src - then inTags False "link" [("linkend", drop 1 src)] - else inTags False "ulink" [("url", src)]) $ + then inTags False "link" $ ("linkend", drop 1 src) : idAndRole attr + else inTags False "ulink" $ ("url", src) : idAndRole attr ) $ inlinesToDocbook opts txt -inlineToDocbook _ (Image _ (src, tit)) = +inlineToDocbook opts (Image attr _ (src, tit)) = let titleDoc = if null tit then empty else inTagsIndented "objectinfo" $ inTagsIndented "title" (text $ escapeStringForXML tit) in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $ - titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] + titleDoc $$ imageToDocbook opts attr src inlineToDocbook opts (Note contents) = inTagsIndented "footnote" $ blocksToDocbook opts contents isMathML :: HTMLMathMethod -> Bool isMathML (MathML _) = True isMathML _ = False + +idAndRole :: Attr -> [(String, String)] +idAndRole (id',cls,_) = ident ++ role + where + ident = if null id' + then [] + else [("id", id')] + role = if null cls + then [] + else [("role", unwords cls)] + diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 639818f2e..827d32620 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -60,6 +60,7 @@ import Data.Unique (hashUnique, newUnique) import System.Random (randomRIO) import Text.Printf (printf) import qualified Control.Exception as E +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef, extensionFromMimeType) import Control.Applicative ((<|>)) @@ -244,7 +245,7 @@ writeDocx opts doc@(Pandoc meta _) = do let tocTitle = fromMaybe (stTocTitle defaultWriterState) $ metaValueToInlines <$> lookupMeta "toc-title" meta - ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc') + ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = WrapNone} doc') defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime , stPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth) @@ -535,7 +536,6 @@ styleToOpenXml sm style = , mknode "w:link" [("w:val","VerbatimChar")] () , mknode "w:pPr" [] $ mknode "w:wordWrap" [("w:val","off")] () - : mknode "w:noProof" [] () : ( maybe [] (\col -> [mknode "w:shd" [("w:val","clear"),("w:fill",drop 1 $ fromColor col)] ()]) $ backgroundColor style ) ] @@ -751,7 +751,7 @@ blockToOpenXML opts (Header lev (ident,_,_) lst) = do blockToOpenXML opts (Plain lst) = withParaProp (pCustomStyle "Compact") $ blockToOpenXML opts (Para lst) -- title beginning with fig: indicates that the image is a figure -blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do +blockToOpenXML opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do setFirstPara pushParaProp $ pCustomStyle $ if null alt @@ -759,7 +759,7 @@ blockToOpenXML opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do else "FigureWithCaption" paraProps <- getParaProps False popParaProp - contents <- inlinesToOpenXML opts [Image alt (src,tit)] + contents <- inlinesToOpenXML opts [Image attr alt (src,tit)] captionNode <- withParaProp (pCustomStyle "ImageCaption") $ blockToOpenXML opts (Para alt) return $ mknode "w:p" [] (paraProps ++ contents) : captionNode @@ -981,6 +981,7 @@ setFirstPara = modify $ \s -> s { stFirstPara = True } inlineToOpenXML :: WriterOptions -> Inline -> WS [Element] inlineToOpenXML _ (Str str) = formattedString str inlineToOpenXML opts Space = inlineToOpenXML opts (Str " ") +inlineToOpenXML opts SoftBreak = inlineToOpenXML opts (Str " ") inlineToOpenXML opts (Span (_,classes,kvs) ils) | "insertion" `elem` classes = do defaultAuthor <- gets stChangesAuthor @@ -1069,8 +1070,8 @@ inlineToOpenXML opts (Note bs) = do [ mknode "w:rPr" [] footnoteStyle , mknode "w:footnoteRef" [] () ] let notemarkerXml = RawInline (Format "openxml") $ ppElement notemarker - let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : ils) : xs - insertNoteRef (Para ils : xs) = Para (notemarkerXml : ils) : xs + let insertNoteRef (Plain ils : xs) = Plain (notemarkerXml : Space : ils) : xs + insertNoteRef (Para ils : xs) = Para (notemarkerXml : Space : ils) : xs insertNoteRef xs = Para [notemarkerXml] : xs oldListLevel <- gets stListLevel oldParaProperties <- gets stParaProperties @@ -1086,11 +1087,11 @@ inlineToOpenXML opts (Note bs) = do [ mknode "w:rPr" [] footnoteStyle , mknode "w:footnoteReference" [("w:id", notenum)] () ] ] -- internal link: -inlineToOpenXML opts (Link txt ('#':xs,_)) = do +inlineToOpenXML opts (Link _ txt ('#':xs,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt return [ mknode "w:hyperlink" [("w:anchor",xs)] contents ] -- external link: -inlineToOpenXML opts (Link txt (src,_)) = do +inlineToOpenXML opts (Link _ txt (src,_)) = do contents <- withTextPropM (rStyleM "Hyperlink") $ inlinesToOpenXML opts txt extlinks <- gets stExternalLinks id' <- case M.lookup src extlinks of @@ -1101,7 +1102,7 @@ inlineToOpenXML opts (Link txt (src,_)) = do M.insert src i extlinks } return i return [ mknode "w:hyperlink" [("r:id",id')] contents ] -inlineToOpenXML opts (Image alt (src, tit)) = do +inlineToOpenXML opts (Image attr alt (src, tit)) = do -- first, check to see if we've already done this image pageWidth <- gets stPrintWidth imgs <- gets stImages @@ -1117,13 +1118,8 @@ inlineToOpenXML opts (Image alt (src, tit)) = do inlinesToOpenXML opts alt Right (img, mt) -> do ident <- ("rId"++) `fmap` getUniqueId - (xpt,ypt) <- case imageSize img of - Right size -> return $ sizeInPoints size - Left msg -> do - liftIO $ warn $ - "Could not determine image size in `" ++ - src ++ "': " ++ msg - return (120,120) + let (xpt,ypt) = desiredSizeInPoints opts attr + (either (const def) id (imageSize img)) -- 12700 emu = 1 pt let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) (pageWidth * 12700) let cNvPicPr = mknode "pic:cNvPicPr" [] $ @@ -1210,11 +1206,9 @@ parseXml refArchive distArchive relpath = -- | Scales the image to fit the page -- sizes are passed in emu -fitToPage :: (Integer, Integer) -> Integer -> (Integer, Integer) +fitToPage :: (Double, Double) -> Integer -> (Integer, Integer) fitToPage (x, y) pageWidth -- Fixes width to the page width and scales the height - | x > pageWidth = - (pageWidth, round $ - ((fromIntegral pageWidth) / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y)) - | otherwise = (x, y) - + | x > fromIntegral pageWidth = + (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y) + | otherwise = (floor x, floor y) diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index b68c46c7e..f1088b158 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -43,10 +43,12 @@ import Text.Pandoc.Definition import Text.Pandoc.Options ( WriterOptions( writerTableOfContents , writerStandalone - , writerTemplate) ) + , writerTemplate + , writerWrapText), WrapOption(..) ) import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated , trimr, normalize, substitute ) import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) +import Text.Pandoc.ImageSize import Text.Pandoc.Templates ( renderTemplate' ) import Data.List ( intersect, intercalate, isPrefixOf, transpose ) import Data.Default (Default(..)) @@ -126,7 +128,7 @@ blockToDokuWiki opts (Plain inlines) = -- title beginning with fig: indicates that the image is a figure -- dokuwiki doesn't support captions - so combine together alt and caption into alt -blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToDokuWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" else (" " ++) `fmap` inlineListToDokuWiki opts txt @@ -135,7 +137,7 @@ blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do else "|" ++ if null tit then capt else tit ++ capt -- Relative links fail isURI and receive a colon prefix = if isURI src then "" else ":" - return $ "{{" ++ prefix ++ src ++ opt ++ "}}\n" + return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n" blockToDokuWiki opts (Para inlines) = do indent <- stIndent <$> ask @@ -460,20 +462,26 @@ inlineToDokuWiki _ (RawInline f str) inlineToDokuWiki _ (LineBreak) = return "\\\\\n" +inlineToDokuWiki opts SoftBreak = + case writerWrapText opts of + WrapNone -> return " " + WrapAuto -> return " " + WrapPreserve -> return "\n" + inlineToDokuWiki _ Space = return " " -inlineToDokuWiki opts (Link txt (src, _)) = do +inlineToDokuWiki opts (Link _ txt (src, _)) = do label <- inlineListToDokuWiki opts txt case txt of [Str s] | "mailto:" `isPrefixOf` src -> return $ "<" ++ s ++ ">" | escapeURI s == src -> return src _ -> if isURI src - then return $ "[[" ++ src ++ "|" ++ label ++ "]]" + then return $ "[[" ++ src ++ "|" ++ label ++ "]]" else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" where src' = case src of '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToDokuWiki opts (Image alt (source, tit)) = do +inlineToDokuWiki opts (Image attr alt (source, tit)) = do alt' <- inlineListToDokuWiki opts alt let txt = case (tit, alt) of ("", []) -> "" @@ -481,10 +489,21 @@ inlineToDokuWiki opts (Image alt (source, tit)) = do (_ , _ ) -> "|" ++ tit -- Relative links fail isURI and receive a colon prefix = if isURI source then "" else ":" - return $ "{{" ++ prefix ++ source ++ txt ++ "}}" + return $ "{{" ++ prefix ++ source ++ imageDims opts attr ++ txt ++ "}}" inlineToDokuWiki opts (Note contents) = do contents' <- blockListToDokuWiki opts contents modify (\s -> s { stNotes = True }) return $ "((" ++ contents' ++ "))" -- note - may not work for notes with multiple blocks + +imageDims :: WriterOptions -> Attr -> String +imageDims opts attr = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + where + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = "?" ++ w + go (Just w) (Just h) = "?" ++ w ++ "x" ++ h + go Nothing (Just h) = "?0x" ++ h + go Nothing Nothing = "" diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 2843f8c74..64f94f41f 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -50,6 +50,7 @@ import Text.Pandoc.Shared ( renderTags', safeRead, uniqueIdent, trim import qualified Text.Pandoc.Shared as S (Element(..)) import Text.Pandoc.Builder (fromList, setMeta) import Text.Pandoc.Options ( WriterOptions(..) + , WrapOption(..) , HTMLMathMethod(..) , EPUBVersion(..) , ObfuscationMethod(NoObfuscation) ) @@ -350,7 +351,7 @@ writeEPUB opts doc@(Pandoc meta _) = do if epub3 then MathML Nothing else writerHTMLMathMethod opts - , writerWrapText = True } + , writerWrapText = WrapAuto } metadata <- getEPUBMetadata opts' meta -- cover page @@ -455,10 +456,10 @@ writeEPUB opts doc@(Pandoc meta _) = do chapters' [1..] let fixInternalReferences :: Inline -> Inline - fixInternalReferences (Link lab ('#':xs, tit)) = + fixInternalReferences (Link attr lab ('#':xs, tit)) = case lookup xs reftable of - Just ys -> Link lab (ys, tit) - Nothing -> Link lab ('#':xs, tit) + Just ys -> Link attr lab (ys, tit) + Nothing -> Link attr lab ('#':xs, tit) fixInternalReferences x = x -- internal reference IDs change when we chunk the file, @@ -816,7 +817,8 @@ transformTag :: WriterOptions -> Tag String -> IO (Tag String) transformTag opts mediaRef tag@(TagOpen name attr) - | name `elem` ["video", "source", "img", "audio"] = do + | name `elem` ["video", "source", "img", "audio"] && + lookup "data-external" attr == Nothing = do let src = fromAttrib "src" tag let poster = fromAttrib "poster" tag newsrc <- modifyMediaRef opts mediaRef src @@ -869,14 +871,14 @@ transformInline :: WriterOptions -> IORef [(FilePath, (FilePath, Maybe Entry))] -- ^ (oldpath, newpath) media -> Inline -> IO Inline -transformInline opts mediaRef (Image lab (src,tit)) = do +transformInline opts mediaRef (Image attr lab (src,tit)) = do newsrc <- modifyMediaRef opts mediaRef src - return $ Image lab (newsrc, tit) + return $ Image attr lab (newsrc, tit) transformInline opts mediaRef (x@(Math t m)) | WebTeX url <- writerHTMLMathMethod opts = do newsrc <- modifyMediaRef opts mediaRef (url ++ urlEncode m) let mathclass = if t == DisplayMath then "display" else "inline" - return $ Span ("",["math",mathclass],[]) [Image [x] (newsrc, "")] + return $ Span ("",["math",mathclass],[]) [Image nullAttr [x] (newsrc, "")] transformInline opts mediaRef (RawInline fmt raw) | fmt == Format "html" = do let tags = parseTags raw diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 31fa4bee8..80296e111 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -314,8 +314,8 @@ blockToXml :: Block -> FBM [Content] blockToXml (Plain ss) = cMapM toXml ss -- FIXME: can lead to malformed FB2 blockToXml (Para [Math DisplayMath formula]) = insertMath NormalImage formula -- title beginning with fig: indicates that the image is a figure -blockToXml (Para [Image alt (src,'f':'i':'g':':':tit)]) = - insertImage NormalImage (Image alt (src,tit)) +blockToXml (Para [Image atr alt (src,'f':'i':'g':':':tit)]) = + insertImage NormalImage (Image atr alt (src,tit)) blockToXml (Para ss) = liftM (list . el "p") $ cMapM toXml ss blockToXml (CodeBlock _ s) = return . spaceBeforeAfter . map (el "p" . el "code") . lines $ s @@ -439,10 +439,11 @@ toXml (Quoted DoubleQuote ss) = do toXml (Cite _ ss) = cMapM toXml ss -- FIXME: support citation styles toXml (Code _ s) = return [el "code" s] toXml Space = return [txt " "] +toXml SoftBreak = return [txt " "] toXml LineBreak = return [el "empty-line" ()] toXml (Math _ formula) = insertMath InlineImage formula toXml (RawInline _ _) = return [] -- raw TeX and raw HTML are suppressed -toXml (Link text (url,ttl)) = do +toXml (Link _ text (url,ttl)) = do fns <- footnotes `liftM` get let n = 1 + length fns let ln_id = linkID n @@ -459,7 +460,7 @@ toXml (Link text (url,ttl)) = do ( [ attr ("l","href") ('#':ln_id) , uattr "type" "note" ] , ln_ref) ] -toXml img@(Image _ _) = insertImage InlineImage img +toXml img@(Image _ _ _) = insertImage InlineImage img toXml (Note bs) = do fns <- footnotes `liftM` get let n = 1 + length fns @@ -478,12 +479,12 @@ insertMath immode formula = do WebTeX url -> do let alt = [Code nullAttr formula] let imgurl = url ++ urlEncode formula - let img = Image alt (imgurl, "") + let img = Image nullAttr alt (imgurl, "") insertImage immode img _ -> return [el "code" formula] insertImage :: ImageMode -> Inline -> FBM [Content] -insertImage immode (Image alt (url,ttl)) = do +insertImage immode (Image _ alt (url,ttl)) = do images <- imagesToFetch `liftM` get let n = 1 + length images let fname = "image" ++ show n @@ -569,11 +570,12 @@ plain (Quoted _ ss) = concat (map plain ss) plain (Cite _ ss) = concat (map plain ss) -- FIXME plain (Code _ s) = s plain Space = " " +plain SoftBreak = " " plain LineBreak = "\n" plain (Math _ s) = s plain (RawInline _ s) = s -plain (Link text (url,_)) = concat (map plain text ++ [" <", url, ">"]) -plain (Image alt _) = concat (map plain alt) +plain (Link _ text (url,_)) = concat (map plain text ++ [" <", url, ">"]) +plain (Image _ alt _) = concat (map plain alt) plain (Note _) = "" -- FIXME -- | Create an XML element. diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index d06bec89f..73a8906c3 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -31,9 +31,11 @@ Conversion of 'Pandoc' documents to HTML. -} module Text.Pandoc.Writers.HTML ( writeHtml , writeHtmlString ) where import Text.Pandoc.Definition +import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Options +import Text.Pandoc.ImageSize import Text.Pandoc.Templates import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Slides @@ -93,9 +95,9 @@ strToHtml [] = "" -- | Hard linebreak. nl :: WriterOptions -> Html -nl opts = if writerWrapText opts - then preEscapedString "\n" - else mempty +nl opts = if writerWrapText opts == WrapNone + then mempty + else preEscapedString "\n" -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String @@ -192,9 +194,6 @@ pandocToHtml opts (Pandoc meta blocks) = do defField "revealjs-url" ("reveal.js" :: String) $ defField "s5-url" ("s5/default" :: String) $ defField "html5" (writerHtml5 opts) $ - defField "center" (case lookupMeta "center" meta of - Just (MetaBool False) -> False - _ -> True) $ metadata return (thebody, context) @@ -307,11 +306,9 @@ elementToHtml slideLevel opts (Sec level num (id',classes,keyvals) title' elemen $ if titleSlide -- title slides have no content of their own then filter isSec elements - else if slide - then case splitBy isPause elements of - [] -> [] - (x:xs) -> x ++ concatMap inDiv xs - else elements + else case splitBy isPause elements of + [] -> [] + (x:xs) -> x ++ concatMap inDiv xs let inNl x = mconcat $ nl opts : intersperse (nl opts) x ++ [nl opts] let classes' = ["titleslide" | titleSlide] ++ ["slide" | slide] ++ ["section" | (slide || writerSectionDivs opts) && @@ -360,10 +357,10 @@ parseMailto s = do _ -> fail "not a mailto: URL" -- | Obfuscate a "mailto:" link. -obfuscateLink :: WriterOptions -> Html -> String -> Html -obfuscateLink opts txt s | writerEmailObfuscation opts == NoObfuscation = - H.a ! A.href (toValue s) $ txt -obfuscateLink opts (renderHtml -> txt) s = +obfuscateLink :: WriterOptions -> Attr -> Html -> String -> Html +obfuscateLink opts attr txt s | writerEmailObfuscation opts == NoObfuscation = + addAttrs opts attr $ H.a ! A.href (toValue s) $ txt +obfuscateLink opts attr (renderHtml -> txt) s = let meth = writerEmailObfuscation opts s' = map toLower (take 7 s) ++ drop 7 s in case parseMailto s' of @@ -389,7 +386,7 @@ obfuscateLink opts (renderHtml -> txt) s = linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) >> H.noscript (preEscapedString $ obfuscateString altText) _ -> error $ "Unknown obfuscation method: " ++ show meth - _ -> H.a ! A.href (toValue s) $ toHtml txt -- malformed email + _ -> addAttrs opts attr $ H.a ! A.href (toValue s) $ toHtml txt -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String @@ -405,11 +402,33 @@ obfuscateString = concatMap obfuscateChar . fromEntities addAttrs :: WriterOptions -> Attr -> Html -> Html addAttrs opts attr h = foldl (!) h (attrsToHtml opts attr) +toAttrs :: [(String, String)] -> [Attribute] +toAttrs kvs = map (\(x,y) -> customAttribute (fromString x) (toValue y)) kvs + attrsToHtml :: WriterOptions -> Attr -> [Attribute] attrsToHtml opts (id',classes',keyvals) = [prefixedId opts id' | not (null id')] ++ - [A.class_ (toValue $ unwords classes') | not (null classes')] ++ - map (\(x,y) -> customAttribute (fromString x) (toValue y)) keyvals + [A.class_ (toValue $ unwords classes') | not (null classes')] ++ toAttrs keyvals + +imgAttrsToHtml :: WriterOptions -> Attr -> [Attribute] +imgAttrsToHtml opts attr = + attrsToHtml opts (ident,cls,kvs') ++ + toAttrs (dimensionsToAttrList opts attr) + where + (ident,cls,kvs) = attr + kvs' = filter isNotDim kvs + isNotDim ("width", _) = False + isNotDim ("height", _) = False + isNotDim _ = True + +dimensionsToAttrList :: WriterOptions -> Attr -> [(String, String)] +dimensionsToAttrList opts attr = (go Width) ++ (go Height) + where + go dir = case (dimension dir attr) of + (Just (Percent a)) -> [("style", show dir ++ ":" ++ show (Percent a))] + (Just dim) -> [(show dir, showInPixel opts dim)] + _ -> [] + imageExts :: [String] imageExts = [ "art", "bmp", "cdr", "cdt", "cpt", "cr2", "crw", "djvu", "erf", @@ -430,8 +449,8 @@ blockToHtml :: WriterOptions -> Block -> State WriterState Html blockToHtml _ Null = return mempty blockToHtml opts (Plain lst) = inlineListToHtml opts lst -- title beginning with fig: indicates that the image is a figure -blockToHtml opts (Para [Image txt (s,'f':'i':'g':':':tit)]) = do - img <- inlineToHtml opts (Image txt (s,tit)) +blockToHtml opts (Para [Image attr txt (s,'f':'i':'g':':':tit)]) = do + img <- inlineToHtml opts (Image attr txt (s,tit)) let tocapt = if writerHtml5 opts then H5.figcaption else H.p ! A.class_ "caption" @@ -543,6 +562,9 @@ blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do let attribs = (if startnum /= 1 then [A.start $ toValue startnum] else []) ++ + (if numstyle == Example + then [A.class_ "example"] + else []) ++ (if numstyle /= DefaultStyle then if writerHtml5 opts then [A.type_ $ @@ -593,8 +615,15 @@ blockToHtml opts (Table capt aligns widths headers rows') = do return $ H.thead (nl opts >> contents) >> nl opts body' <- liftM (\x -> H.tbody (nl opts >> mconcat x)) $ zipWithM (tableRowToHtml opts aligns) [1..] rows' - return $ H.table $ nl opts >> captionDoc >> coltags >> head' >> - body' >> nl opts + let tbl = H.table $ + nl opts >> captionDoc >> coltags >> head' >> body' >> nl opts + let totalWidth = sum widths + -- When widths of columns are < 100%, we need to set width for the whole + -- table, or some browsers give us skinny columns with lots of space between: + return $ if totalWidth == 0 || totalWidth == 1 + then tbl + else tbl ! A.style (toValue $ "width:" ++ + show (round (totalWidth * 100) :: Int) ++ "%;") tableRowToHtml :: WriterOptions -> [Alignment] @@ -668,6 +697,10 @@ inlineToHtml opts inline = case inline of (Str str) -> return $ strToHtml str (Space) -> return $ strToHtml " " + (SoftBreak) -> return $ case writerWrapText opts of + WrapNone -> preEscapedString " " + WrapAuto -> preEscapedString " " + WrapPreserve -> preEscapedString "\n" (LineBreak) -> return $ (if writerHtml5 opts then H5.br else H.br) <> strToHtml "\n" (Span (id',classes,kvs) ils) @@ -786,10 +819,10 @@ inlineToHtml opts inline = _ -> return mempty | f == Format "html" -> return $ preEscapedString str | otherwise -> return mempty - (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do + (Link attr txt (s,_)) | "mailto:" `isPrefixOf` s -> do linkText <- inlineListToHtml opts txt - return $ obfuscateLink opts linkText s - (Link txt (s,tit)) -> do + return $ obfuscateLink opts attr linkText s + (Link attr txt (s,tit)) -> do linkText <- inlineListToHtml opts txt let s' = case s of '#':xs | writerSlideVariant opts == @@ -799,19 +832,23 @@ inlineToHtml opts inline = let link' = if txt == [Str (unEscapeString s)] then link ! A.class_ "uri" else link + let link'' = addAttrs opts attr link' return $ if null tit - then link' - else link' ! A.title (toValue tit) - (Image txt (s,tit)) | treatAsImage s -> do + then link'' + else link'' ! A.title (toValue tit) + (Image attr txt (s,tit)) | treatAsImage s -> do + let alternate' = stringify txt let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] ++ - [A.alt $ toValue $ stringify txt] + [A.title $ toValue tit | not (null tit)] ++ + [A.alt $ toValue alternate' | not (null txt)] ++ + imgAttrsToHtml opts attr let tag = if writerHtml5 opts then H5.img else H.img return $ foldl (!) tag attributes -- note: null title included, as in Markdown.pl - (Image _ (s,tit)) -> do + (Image attr _ (s,tit)) -> do let attributes = [A.src $ toValue s] ++ - [A.title $ toValue tit | not $ null tit] + [A.title $ toValue tit | not (null tit)] ++ + imgAttrsToHtml opts attr return $ foldl (!) H5.embed attributes -- note: null title included, as in Markdown.pl (Note contents) @@ -849,7 +886,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 = [Link [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] + let backlink = [Link nullAttr [Str "↩"] ("#" ++ writerIdentifierPrefix opts ++ "fnref" ++ ref,[])] blocks' = if null blocks then [] else let lastBlock = last blocks diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 14f398da9..2e5f2dd08 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -57,7 +57,7 @@ writeHaddock opts document = -- | Return haddock representation of document. pandocToHaddock :: WriterOptions -> Pandoc -> State WriterState String pandocToHaddock opts (Pandoc meta blocks) = do - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing body <- blockListToHaddock opts blocks @@ -103,8 +103,8 @@ blockToHaddock opts (Plain inlines) = do contents <- inlineListToHaddock opts inlines return $ contents <> cr -- title beginning with fig: indicates figure -blockToHaddock opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = - blockToHaddock opts (Para [Image alt (src,tit)]) +blockToHaddock opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = + blockToHaddock opts (Para [Image attr alt (src,tit)]) blockToHaddock opts (Para inlines) = -- TODO: if it contains linebreaks, we need to use a @...@ block (<> blankline) `fmap` blockToHaddock opts (Plain inlines) @@ -325,18 +325,23 @@ inlineToHaddock _ (RawInline f str) | otherwise = return empty -- no line break in haddock (see above on CodeBlock) inlineToHaddock _ (LineBreak) = return cr +inlineToHaddock opts SoftBreak = + case writerWrapText opts of + WrapAuto -> return space + WrapNone -> return space + WrapPreserve -> return cr inlineToHaddock _ Space = return space inlineToHaddock opts (Cite _ lst) = inlineListToHaddock opts lst -inlineToHaddock opts (Link txt (src, _)) = do - linktext <- inlineListToHaddock opts txt +inlineToHaddock _ (Link _ txt (src, _)) = do + let linktext = text $ escapeString $ stringify txt let useAuto = isURI src && case txt of [Str s] | escapeURI s == src -> True _ -> False return $ nowrap $ "<" <> text src <> (if useAuto then empty else space <> linktext) <> ">" -inlineToHaddock opts (Image alternate (source, tit)) = do - linkhaddock <- inlineToHaddock opts (Link alternate (source, tit)) +inlineToHaddock opts (Image attr alternate (source, tit)) = do + linkhaddock <- inlineToHaddock opts (Link attr alternate (source, tit)) return $ "<" <> linkhaddock <> ">" -- haddock doesn't have notes, but we can fake it: inlineToHaddock opts (Note contents) = do diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index ae068a94f..57a61178e 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -16,12 +16,14 @@ into InDesign with File -> Place. module Text.Pandoc.Writers.ICML (writeICML) where import Text.Pandoc.Definition import Text.Pandoc.XML +import Text.Pandoc.Readers.TeXMath (texMathToInlines) import Text.Pandoc.Writers.Shared -import Text.Pandoc.Shared (splitBy) +import Text.Pandoc.Shared (splitBy, fetchItem, warn) import Text.Pandoc.Options import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Pretty -import Data.List (isPrefixOf, isInfixOf, stripPrefix) +import Text.Pandoc.ImageSize +import Data.List (isPrefixOf, isInfixOf, stripPrefix, intersperse) import Data.Text as Text (breakOnAll, pack) import Control.Monad.State import Network.URI (isURI) @@ -38,7 +40,7 @@ data WriterState = WriterState{ , maxListDepth :: Int } -type WS a = State WriterState a +type WS a = StateT WriterState IO a defaultWriterState :: WriterState defaultWriterState = WriterState{ @@ -69,6 +71,8 @@ linkName = "Link" -- block element names (appear in InDesign's paragraph styles pane) paragraphName :: String +figureName :: String +imgCaptionName :: String codeBlockName :: String blockQuoteName :: String orderedListName :: String @@ -90,7 +94,10 @@ lowerAlphaName :: String upperAlphaName :: String subListParName :: String footnoteName :: String +citeName :: String paragraphName = "Paragraph" +figureName = "Figure" +imgCaptionName = "Caption" codeBlockName = "CodeBlock" blockQuoteName = "Blockquote" orderedListName = "NumList" @@ -112,30 +119,31 @@ lowerAlphaName = "lowerAlpha" upperAlphaName = "upperAlpha" subListParName = "subParagraph" footnoteName = "Footnote" +citeName = "Cite" -- | Convert Pandoc document to string in ICML format. -writeICML :: WriterOptions -> Pandoc -> String -writeICML opts (Pandoc meta blocks) = - let colwidth = if writerWrapText opts +writeICML :: WriterOptions -> Pandoc -> IO String +writeICML opts (Pandoc meta blocks) = do + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing render' = render colwidth - renderMeta f s = Just $ render' $ fst $ runState (f opts [] s) defaultWriterState - Just metadata = metaToJSON opts - (renderMeta blocksToICML) - (renderMeta inlinesToICML) - meta - (doc, st) = runState (blocksToICML opts [] blocks) defaultWriterState - main = render' doc + renderMeta f s = liftM (render' . fst) $ runStateT (f opts [] s) defaultWriterState + metadata <- metaToJSON opts + (renderMeta blocksToICML) + (renderMeta inlinesToICML) + meta + (doc, st) <- runStateT (blocksToICML opts [] blocks) defaultWriterState + let main = render' doc context = defField "body" main $ defField "charStyles" (render' $ charStylesToDoc st) $ defField "parStyles" (render' $ parStylesToDoc st) $ defField "hyperlinks" (render' $ hyperlinksToDoc $ links st) $ metadata - in if writerStandalone opts - then renderTemplate' (writerTemplate opts) context - else main + return $ if writerStandalone opts + then renderTemplate' (writerTemplate opts) context + else main -- | Auxilary functions for parStylesToDoc and charStylesToDoc. contains :: String -> (String, (String, String)) -> [(String, String)] @@ -276,11 +284,18 @@ hyperlinksToDoc (x:xs) = hyp x $$ hyperlinksToDoc xs -- | Convert a list of Pandoc blocks to ICML. blocksToICML :: WriterOptions -> Style -> [Block] -> WS Doc -blocksToICML opts style lst = vcat `fmap` mapM (blockToICML opts style) lst +blocksToICML opts style lst = do + docs <- mapM (blockToICML opts style) lst + return $ intersperseBrs docs -- | Convert a Pandoc block element to ICML. blockToICML :: WriterOptions -> Style -> Block -> WS Doc blockToICML opts style (Plain lst) = parStyle opts style lst +-- title beginning with fig: indicates that the image is a figure +blockToICML opts style (Para img@[Image _ txt (_,'f':'i':'g':':':_)]) = do + figure <- parStyle opts (figureName:style) img + caption <- parStyle opts (imgCaptionName:style) txt + return $ intersperseBrs [figure, caption] blockToICML opts style (Para lst) = parStyle opts (paragraphName:style) lst blockToICML opts style (CodeBlock _ str) = parStyle opts (codeBlockName:style) $ [Str str] blockToICML _ _ (RawBlock f str) @@ -289,7 +304,7 @@ blockToICML _ _ (RawBlock f str) blockToICML opts style (BlockQuote blocks) = blocksToICML opts (blockQuoteName:style) blocks blockToICML opts style (OrderedList attribs lst) = listItemsToICML opts orderedListName style (Just attribs) lst blockToICML opts style (BulletList lst) = listItemsToICML opts bulletListName style Nothing lst -blockToICML opts style (DefinitionList lst) = vcat `fmap` mapM (definitionListItemToICML opts style) lst +blockToICML opts style (DefinitionList lst) = intersperseBrs `fmap` mapM (definitionListItemToICML opts style) lst blockToICML opts style (Header lvl _ lst) = let stl = (headerName ++ show lvl):style in parStyle opts stl lst @@ -354,7 +369,7 @@ listItemsToICML opts listType style attribs (first:rest) = do s <- get let maxD = max (maxListDepth s) (listDepth s) put s{ listDepth = 1, maxListDepth = maxD } - return $ vcat docs + return $ intersperseBrs docs -- | Convert a list of blocks to ICML list items. listItemToICML :: WriterOptions -> Style -> Bool-> Maybe ListAttributes -> [Block] -> WS Doc @@ -380,15 +395,15 @@ listItemToICML opts style isFirst attribs item = let insertTab (Para lst) = blockToICML opts (subListParName:style) $ Para $ (Str "\t"):lst insertTab block = blockToICML opts style block f <- blockToICML opts stl' $ head item - r <- fmap vcat $ mapM insertTab $ tail item - return $ f $$ r + r <- mapM insertTab $ tail item + return $ intersperseBrs (f : r) else blocksToICML opts stl' item definitionListItemToICML :: WriterOptions -> Style -> ([Inline],[[Block]]) -> WS Doc definitionListItemToICML opts style (term,defs) = do term' <- parStyle opts (defListTermName:style) term - defs' <- vcat `fmap` mapM (blocksToICML opts (defListDefName:style)) defs - return $ term' $$ defs' + defs' <- mapM (blocksToICML opts (defListDefName:style)) defs + return $ intersperseBrs $ (term' : defs') -- | Convert a list of inline elements to ICML. @@ -406,15 +421,21 @@ inlineToICML opts style (Subscript lst) = inlinesToICML opts (subscriptName:styl inlineToICML opts style (SmallCaps lst) = inlinesToICML opts (smallCapsName:style) lst inlineToICML opts style (Quoted SingleQuote lst) = inlinesToICML opts style $ [Str "‘"] ++ lst ++ [Str "’"] inlineToICML opts style (Quoted DoubleQuote lst) = inlinesToICML opts style $ [Str "“"] ++ lst ++ [Str "”"] -inlineToICML opts style (Cite _ lst) = inlinesToICML opts style lst +inlineToICML opts style (Cite _ lst) = inlinesToICML opts (citeName:style) lst inlineToICML _ style (Code _ str) = charStyle (codeName:style) $ text $ escapeStringForXML str inlineToICML _ style Space = charStyle style space +inlineToICML opts style SoftBreak = + case writerWrapText opts of + WrapAuto -> charStyle style space + WrapNone -> charStyle style space + WrapPreserve -> charStyle style cr inlineToICML _ style LineBreak = charStyle style $ text lineSeparator -inlineToICML _ style (Math _ str) = charStyle style $ text $ escapeStringForXML str --InDesign doesn't really do math +inlineToICML opts style (Math mt str) = + cat <$> mapM (inlineToICML opts style) (texMathToInlines mt str) inlineToICML _ _ (RawInline f str) | f == Format "icml" = return $ text str | otherwise = return empty -inlineToICML opts style (Link lst (url, title)) = do +inlineToICML opts style (Link _ lst (url, title)) = do content <- inlinesToICML opts (linkName:style) lst state $ \st -> let ident = if null $ links st @@ -424,7 +445,7 @@ inlineToICML opts style (Link lst (url, title)) = do cont = inTags True "HyperlinkTextSource" [("Self","htss-"++show ident), ("Name",title), ("Hidden","false")] content in (cont, newst) -inlineToICML opts style (Image alt target) = imageICML opts style alt target +inlineToICML opts style (Image attr _ target) = imageICML opts style attr target inlineToICML opts style (Note lst) = footnoteToICML opts style lst inlineToICML opts style (Span _ lst) = inlinesToICML opts style lst @@ -439,16 +460,26 @@ footnoteToICML opts style lst = inTags True "CharacterStyleRange" [] $ inTagsSimple "Content" "<?ACE 4?>" return $ inTags True "CharacterStyleRange" [("AppliedCharacterStyle","$ID/NormalCharacterStyle"), ("Position","Superscript")] - $ inTags True "Footnote" [] $ number $$ vcat contents + $ inTags True "Footnote" [] $ number $$ intersperseBrs contents -- | Auxiliary function to merge Space elements into the adjacent Strs. mergeSpaces :: [Inline] -> [Inline] -mergeSpaces ((Str s):(Space:((Str s'):xs))) = mergeSpaces $ Str(s++" "++s') : xs -mergeSpaces (Space:((Str s):xs)) = mergeSpaces $ Str (" "++s) : xs -mergeSpaces ((Str s):(Space:xs)) = mergeSpaces $ Str (s++" ") : xs +mergeSpaces ((Str s):(x:((Str s'):xs))) | isSp x = + mergeSpaces $ Str(s++" "++s') : xs +mergeSpaces (x:((Str s):xs)) | isSp x = mergeSpaces $ Str (" "++s) : xs +mergeSpaces ((Str s):(x:xs)) | isSp x = mergeSpaces $ Str (s++" ") : xs mergeSpaces (x:xs) = x : (mergeSpaces xs) mergeSpaces [] = [] +isSp :: Inline -> Bool +isSp Space = True +isSp SoftBreak = True +isSp _ = False + +-- | Intersperse line breaks +intersperseBrs :: [Doc] -> Doc +intersperseBrs = vcat . intersperse (selfClosingTag "Br" []) . filter (not . isEmpty) + -- | Wrap a list of inline elements in an ICML Paragraph Style parStyle :: WriterOptions -> Style -> [Inline] -> WS Doc parStyle opts style lst = @@ -470,8 +501,7 @@ parStyle opts style lst = else [attrs] in do content <- inlinesToICML opts [] lst - let cont = inTags True "ParagraphStyleRange" attrs' - $ mappend content $ selfClosingTag "Br" [] + let cont = inTags True "ParagraphStyleRange" attrs' content state $ \st -> (cont, st{ blockStyles = Set.insert stlStr $ blockStyles st }) -- | Wrap a Doc in an ICML Character Style. @@ -497,39 +527,48 @@ styleToStrAttr style = in (stlStr, attrs) -- | Assemble an ICML Image. -imageICML :: WriterOptions -> Style -> [Inline] -> Target -> WS Doc -imageICML _ style _ (linkURI, _) = - let imgWidth = 300::Int --TODO: set width, height dynamically as in Docx.hs - imgHeight = 200::Int - scaleFact = show (1::Double) --TODO: set scaling factor so image is scaled exactly to imgWidth x imgHeight - hw = show $ imgWidth `div` 2 - hh = show $ imgHeight `div` 2 - qw = show $ imgWidth `div` 4 - qh = show $ imgHeight `div` 4 - uriPrefix = if isURI linkURI then "" else "file:" +imageICML :: WriterOptions -> Style -> Attr -> Target -> WS Doc +imageICML opts style attr (src, _) = do + res <- liftIO $ fetchItem (writerSourceURL opts) src + imgS <- case res of + Left (_) -> do + liftIO $ warn $ "Could not find image `" ++ src ++ "', skipping..." + return def + Right (img, _) -> do + case imageSize img of + Right size -> return size + Left msg -> do + return $ warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return def + let (ow, oh) = sizeInPoints imgS + (imgWidth, imgHeight) = desiredSizeInPoints opts attr imgS + hw = showFl $ ow / 2 + hh = showFl $ oh / 2 + scale = showFl (imgWidth / ow) ++ " 0 0 " ++ showFl (imgHeight / oh) + src' = if isURI src then src else "file:" ++ src (stlStr, attrs) = styleToStrAttr style props = inTags True "Properties" [] $ inTags True "PathGeometry" [] $ inTags True "GeometryPathType" [("PathOpen","false")] $ inTags True "PathPointArray" [] $ vcat [ - selfClosingTag "PathPointType" [("Anchor", "-"++qw++" -"++qh), - ("LeftDirection", "-"++qw++" -"++qh), ("RightDirection", "-"++qw++" -"++qh)] - , selfClosingTag "PathPointType" [("Anchor", "-"++qw++" "++qh), - ("LeftDirection", "-"++qw++" "++qh), ("RightDirection", "-"++qw++" "++qh)] - , selfClosingTag "PathPointType" [("Anchor", qw++" "++qh), - ("LeftDirection", qw++" "++qh), ("RightDirection", qw++" "++qh)] - , selfClosingTag "PathPointType" [("Anchor", qw++" -"++qh), - ("LeftDirection", qw++" -"++qh), ("RightDirection", qw++" -"++qh)] + selfClosingTag "PathPointType" [("Anchor", "-"++hw++" -"++hh), + ("LeftDirection", "-"++hw++" -"++hh), ("RightDirection", "-"++hw++" -"++hh)] + , selfClosingTag "PathPointType" [("Anchor", "-"++hw++" "++hh), + ("LeftDirection", "-"++hw++" "++hh), ("RightDirection", "-"++hw++" "++hh)] + , selfClosingTag "PathPointType" [("Anchor", hw++" "++hh), + ("LeftDirection", hw++" "++hh), ("RightDirection", hw++" "++hh)] + , selfClosingTag "PathPointType" [("Anchor", hw++" -"++hh), + ("LeftDirection", hw++" -"++hh), ("RightDirection", hw++" -"++hh)] ] image = inTags True "Image" - [("Self","ue6"), ("ItemTransform", scaleFact++" 0 0 "++scaleFact++" -"++qw++" -"++qh)] + [("Self","ue6"), ("ItemTransform", scale++" -"++hw++" -"++hh)] $ vcat [ inTags True "Properties" [] $ inTags True "Profile" [("type","string")] $ text "$ID/Embedded" - $$ selfClosingTag "GraphicBounds" [("Left","0"), ("Top","0"), ("Right", hw), ("Bottom", hh)] - , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", uriPrefix++linkURI)] + , selfClosingTag "Link" [("Self", "ueb"), ("LinkResourceURI", src')] ] doc = inTags True "CharacterStyleRange" attrs - $ inTags True "Rectangle" [("Self","uec"), ("ItemTransform", "1 0 0 1 "++qw++" -"++qh)] + $ inTags True "Rectangle" [("Self","uec"), ("StrokeWeight", "0"), + ("ItemTransform", scale++" "++hw++" -"++hh)] $ (props $$ image) - in do - state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) + state $ \st -> (doc, st{ inlineStyles = Set.insert stlStr $ inlineStyles st } ) diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 15982736c..648b09c2c 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -38,15 +38,16 @@ import Text.Pandoc.Options import Text.Pandoc.Templates import Text.Printf ( printf ) import Network.URI ( isURI, unEscapeString ) -import Data.Aeson ( object, (.=), FromJSON ) -import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse ) +import Data.Aeson (object, (.=)) +import Data.List ( (\\), isInfixOf, stripPrefix, intercalate, intersperse, nub, nubBy ) import Data.Char ( toLower, isPunctuation, isAscii, isLetter, isDigit, ord ) -import Data.Maybe ( fromMaybe ) +import Data.Maybe ( fromMaybe, isJust ) import qualified Data.Text as T import Control.Applicative ((<|>)) import Control.Monad.State import qualified Text.Parsec as P import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Text.Pandoc.Slides import Text.Pandoc.Highlighting (highlight, styleToLaTeX, formatLaTeXInline, formatLaTeXBlock, @@ -99,12 +100,12 @@ pandocToLaTeX options (Pandoc meta blocks) = do _ -> blocks else blocks -- see if there are internal links - let isInternalLink (Link _ ('#':xs,_)) = [xs] - isInternalLink _ = [] + let isInternalLink (Link _ _ ('#':xs,_)) = [xs] + isInternalLink _ = [] modify $ \s -> s{ stInternalLinks = query isInternalLink blocks' } let template = writerTemplate options -- set stBook depending on documentclass - let colwidth = if writerWrapText options + let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options @@ -150,6 +151,8 @@ pandocToLaTeX options (Pandoc meta blocks) = do st <- get titleMeta <- stringToLaTeX TextString $ stringify $ docTitle meta authorsMeta <- mapM (stringToLaTeX TextString . stringify) $ docAuthors meta + let docLangs = nub $ query (extract "lang") blocks + let hasStringValue x = isJust (getField x metadata :: Maybe String) let context = defField "toc" (writerTableOfContents options) $ defField "toc-depth" (show (writerTOCDepth options - if stBook st @@ -184,18 +187,50 @@ pandocToLaTeX options (Pandoc meta blocks) = do Biblatex -> defField "biblio-title" biblioTitle . defField "biblatex" True _ -> id) $ + -- set lang to something so polyglossia/babel is included + defField "lang" (if null docLangs then ""::String else "en") $ + defField "otherlangs" docLangs $ + defField "colorlinks" (any hasStringValue + ["citecolor", "urlcolor", "linkcolor", "toccolor"]) $ + defField "dir" (if (null $ query (extract "dir") blocks) + then ""::String + else "ltr") $ metadata let toPolyObj lang = object [ "name" .= T.pack name , "options" .= T.pack opts ] where (name, opts) = toPolyglossia lang let lang = maybe [] (splitBy (=='-')) $ getField "lang" context + otherlangs = maybe [] (map $ splitBy (=='-')) $ getField "otherlangs" context let context' = defField "babel-lang" (toBabel lang) + $ defField "babel-otherlangs" (map toBabel otherlangs) + $ defField "babel-newcommands" (concatMap (\(poly, babel) -> + -- \textspanish and \textgalician are already used by babel + -- save them as \oritext... and let babel use that + if poly `elem` ["spanish", "galician"] + then "\\let\\oritext" ++ poly ++ "\\text" ++ poly ++ "\n" ++ + "\\AddBabelHook{" ++ poly ++ "}{beforeextras}" ++ + "{\\renewcommand{\\text" ++ poly ++ "}{\\oritext" + ++ poly ++ "}}\n" ++ + "\\AddBabelHook{" ++ poly ++ "}{afterextras}" ++ + "{\\renewcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" + ++ poly ++ "}{##2}}}\n" + else "\\newcommand{\\text" ++ poly ++ "}[2][]{\\foreignlanguage{" + ++ babel ++ "}{#2}}\n" ++ + "\\newenvironment{" ++ poly ++ "}[1]{\\begin{otherlanguage}{" + ++ babel ++ "}}{\\end{otherlanguage}}\n" + ) + -- eliminate duplicates that have same polyglossia name + $ nubBy (\a b -> fst a == fst b) + -- find polyglossia and babel names of languages used in the document + $ map (\l -> + let lng = splitBy (=='-') l + in (fst $ toPolyglossia lng, toBabel lng) + ) + docLangs ) $ defField "polyglossia-lang" (toPolyObj lang) - $ defField "polyglossia-otherlangs" - (maybe [] (map $ toPolyObj . splitBy (=='-')) $ - getField "otherlangs" context) + $ defField "polyglossia-otherlangs" (map toPolyObj otherlangs) $ defField "latex-dir-rtl" (case (getField "dir" context)::Maybe String of Just "rtl" -> True _ -> False) @@ -299,12 +334,8 @@ elementToBeamer slideLevel (Sec lvl _num (ident,classes,kvs) tit elts) hasCodeBlock _ = [] let hasCode (Code _ _) = [True] hasCode _ = [] - opts <- gets stOptions let fragile = "fragile" `elem` classes || - not (null $ query hasCodeBlock elts ++ - if writerListings opts - then query hasCode elts - else []) + not (null $ query hasCodeBlock elts ++ query hasCode elts) let frameoptions = ["allowdisplaybreaks", "allowframebreaks", "b", "c", "t", "environment", "label", "plain", "shrink"] @@ -331,6 +362,7 @@ isListBlock _ = False isLineBreakOrSpace :: Inline -> Bool isLineBreakOrSpace LineBreak = True +isLineBreakOrSpace SoftBreak = True isLineBreakOrSpace Space = True isLineBreakOrSpace _ = False @@ -343,29 +375,48 @@ blockToLaTeX (Div (identifier,classes,kvs) bs) = do ref <- toLabel identifier let linkAnchor = if null identifier then empty - else "\\hyperdef{}" <> braces (text ref) <> - braces ("\\label" <> braces (text ref)) - contents' <- blockListToLaTeX bs - let align dir = inCmd "begin" dir $$ contents' $$ inCmd "end" dir - let contents = case lookup "dir" kvs of - Just "rtl" -> align "RTL" - Just "ltr" -> align "LTR" - _ -> contents' - if beamer && "notes" `elem` classes -- speaker notes - then return $ "\\note" <> braces contents - else return (linkAnchor $$ contents) + else "\\hypertarget" <> braces (text ref) <> + braces empty + let align dir txt = inCmd "begin" dir $$ txt $$ inCmd "end" dir + let wrapDir = case lookup "dir" kvs of + Just "rtl" -> align "RTL" + Just "ltr" -> align "LTR" + _ -> id + wrapLang txt = case lookup "lang" kvs of + Just lng -> let (l, o) = toPolyglossiaEnv lng + ops = if null o + then "" + else brackets $ text o + in inCmd "begin" (text l) <> ops + $$ blankline <> txt <> blankline + $$ inCmd "end" (text l) + Nothing -> txt + wrapNotes txt = if beamer && "notes" `elem` classes + then "\\note" <> braces txt -- speaker notes + else linkAnchor $$ txt + fmap (wrapDir . wrapLang . wrapNotes) $ blockListToLaTeX bs blockToLaTeX (Plain lst) = inlineListToLaTeX $ dropWhile isLineBreakOrSpace lst -- title beginning with fig: indicates that the image is a figure -blockToLaTeX (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToLaTeX (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do inNote <- gets stInNote + modify $ \st -> st{ stInMinipage = True, stNotes = [] } capt <- inlineListToLaTeX txt - img <- inlineToLaTeX (Image txt (src,tit)) + notes <- gets stNotes + modify $ \st -> st{ stInMinipage = False, stNotes = [] } + -- We can't have footnotes in the list of figures, so remove them: + captForLof <- if null notes + then return empty + else brackets <$> inlineListToLaTeX (walk deNote txt) + img <- inlineToLaTeX (Image attr txt (src,tit)) + let footnotes = notesToLaTeX notes return $ if inNote -- can't have figures in notes then "\\begin{center}" $$ img $+$ capt $$ "\\end{center}" else "\\begin{figure}[htbp]" $$ "\\centering" $$ img $$ - ("\\caption" <> braces capt) $$ "\\end{figure}" + ("\\caption" <> captForLof <> braces capt) $$ + "\\end{figure}" $$ + footnotes -- . . . indicates pause in beamer slides blockToLaTeX (Para [Str ".",Space,Str ".",Space,Str "."]) = do beamer <- writerBeamer `fmap` gets stOptions @@ -394,7 +445,7 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do ref <- toLabel identifier let linkAnchor = if null identifier then empty - else "\\hyperdef{}" <> braces (text ref) <> + else "\\hypertarget" <> braces (text ref) <> braces ("\\label" <> braces (text ref)) let lhsCodeBlock = do modify $ \s -> s{ stLHS = True } @@ -607,19 +658,21 @@ tableCellToLaTeX header (width, align, blocks) = do return $ ("\\begin{minipage}" <> valign <> braces (text (printf "%.2f\\columnwidth" width)) <> (halign <> "\\strut" <> cr <> cellContents <> cr) <> - "\\strut\\end{minipage}") - $$ case notes of - [] -> empty - ns -> (case length ns of + "\\strut\\end{minipage}") $$ + notesToLaTeX notes + +notesToLaTeX :: [Doc] -> Doc +notesToLaTeX [] = empty +notesToLaTeX ns = (case length ns of n | n > 1 -> "\\addtocounter" <> braces "footnote" <> braces (text $ show $ 1 - n) | otherwise -> empty) - $$ - vcat (intersperse - ("\\addtocounter" <> braces "footnote" <> braces "1") - $ map (\x -> "\\footnotetext" <> braces x) - $ reverse ns) + $$ + vcat (intersperse + ("\\addtocounter" <> braces "footnote" <> braces "1") + $ map (\x -> "\\footnotetext" <> braces x) + $ reverse ns) listItemToLaTeX :: [Block] -> State WriterState Doc listItemToLaTeX lst @@ -636,8 +689,8 @@ defListItemToLaTeX (term, defs) = do term' <- inlineListToLaTeX term -- put braces around term if it contains an internal link, -- since otherwise we get bad bracket interactions: \item[\hyperref[..] - let isInternalLink (Link _ ('#':_,_)) = True - isInternalLink _ = False + let isInternalLink (Link _ _ ('#':_,_)) = True + isInternalLink _ = False let term'' = if any isInternalLink term then braces term' else term' @@ -681,8 +734,7 @@ sectionHeader unnumbered ref level lst = do let level' = if book || writerChapters opts then level - 1 else level internalLinks <- gets stInternalLinks let refLabel x = (if ref `elem` internalLinks - then text "\\hyperdef" - <> braces empty + then text "\\hypertarget" <> braces lab <> braces x else x) @@ -756,17 +808,20 @@ inlineToLaTeX (Span (id',classes,kvs) ils) = do ref <- toLabel id' let linkAnchor = if null id' then empty - else "\\protect\\hyperdef{}" <> braces (text ref) <> - braces ("\\label" <> braces (text ref)) + else "\\protect\\hypertarget" <> braces (text ref) <> + braces empty fmap (linkAnchor <>) ((if noEmph then inCmd "textup" else id) . (if noStrong then inCmd "textnormal" else id) . (if noSmallCaps then inCmd "textnormal" else id) . (if rtl then inCmd "RL" else id) . (if ltr then inCmd "LR" else id) . - (if not (noEmph || noStrong || noSmallCaps || rtl || ltr) - then braces - else id)) `fmap` inlineListToLaTeX ils + (case lookup "lang" kvs of + Just lng -> let (l, o) = toPolyglossia $ splitBy (=='-') lng + ops = if null o then "" else brackets (text o) + in \c -> char '\\' <> "text" <> text l <> ops <> braces c + Nothing -> id) + ) `fmap` inlineListToLaTeX ils inlineToLaTeX (Emph lst) = inlineListToLaTeX lst >>= return . inCmd "emph" inlineToLaTeX (Strong lst) = @@ -847,12 +902,18 @@ inlineToLaTeX (RawInline f str) = return $ text str | otherwise = return empty inlineToLaTeX (LineBreak) = return $ "\\\\" <> cr +inlineToLaTeX SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapAuto -> return space + WrapNone -> return space + WrapPreserve -> return cr inlineToLaTeX Space = return space -inlineToLaTeX (Link txt ('#':ident, _)) = do +inlineToLaTeX (Link _ txt ('#':ident, _)) = do contents <- inlineListToLaTeX txt lab <- toLabel ident - return $ text "\\hyperref" <> brackets (text lab) <> braces contents -inlineToLaTeX (Link txt (src, _)) = + return $ text "\\protect\\hyperlink" <> braces (text lab) <> braces contents +inlineToLaTeX (Link _ txt (src, _)) = case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stUrl = True } @@ -869,16 +930,31 @@ inlineToLaTeX (Link txt (src, _)) = src' <- stringToLaTeX URLString (escapeURI src) return $ text ("\\href{" ++ src' ++ "}{") <> contents <> char '}' -inlineToLaTeX (Image _ (source, _)) = do +inlineToLaTeX (Image attr _ (source, _)) = do modify $ \s -> s{ stGraphics = True } - let source' = if isURI source + opts <- gets stOptions + let showDim dir = let d = text (show dir) <> "=" + in case (dimension dir attr) of + Just (Pixel a) -> + [d <> text (showInInch opts (Pixel a)) <> "in"] + Just (Percent a) -> + [d <> text (showFl (a / 100)) <> "\\textwidth"] + Just dim -> + [d <> text (show dim)] + Nothing -> + [] + dimList = showDim Width ++ showDim Height + dims = if null dimList + then empty + else brackets $ cat (intersperse "," dimList) + source' = if isURI source then source else unEscapeString source source'' <- stringToLaTeX URLString (escapeURI source') inHeading <- gets stInHeading return $ - (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") - <> braces (text source'') + (if inHeading then "\\protect\\includegraphics" else "\\includegraphics") <> + dims <> braces (text source'') inlineToLaTeX (Note contents) = do inMinipage <- gets stInMinipage modify (\s -> s{stInNote = True}) @@ -1007,6 +1083,30 @@ getListingsLanguage :: [String] -> Maybe String getListingsLanguage [] = Nothing getListingsLanguage (x:xs) = toListingsLanguage x <|> getListingsLanguage xs +-- Extract a key from divs and spans +extract :: String -> Block -> [String] +extract key (Div attr _) = lookKey key attr +extract key (Plain ils) = concatMap (extractInline key) ils +extract key (Para ils) = concatMap (extractInline key) ils +extract key (Header _ _ ils) = concatMap (extractInline key) ils +extract _ _ = [] + +-- Extract a key from spans +extractInline :: String -> Inline -> [String] +extractInline key (Span attr _) = lookKey key attr +extractInline _ _ = [] + +-- Look up a key in an attribute and give a list of its values +lookKey :: String -> Attr -> [String] +lookKey key (_,_,kvs) = maybe [] words $ lookup key kvs + +-- In environments \Arabic instead of \arabic is used +toPolyglossiaEnv :: String -> (String, String) +toPolyglossiaEnv l = + case toPolyglossia $ (splitBy (=='-')) l of + ("arabic", o) -> ("Arabic", o) + x -> x + -- Takes a list of the constituents of a BCP 47 language code and -- converts it to a Polyglossia (language, options) tuple -- http://mirrors.concertpass.com/tex-archive/macros/latex/contrib/polyglossia/polyglossia.pdf @@ -1024,10 +1124,11 @@ toPolyglossia ("ar":"TN":_) = ("arabic", "locale=tunisia") toPolyglossia ("de":"1901":_) = ("german", "spelling=old") toPolyglossia ("de":"AT":"1901":_) = ("german", "variant=austrian, spelling=old") toPolyglossia ("de":"AT":_) = ("german", "variant=austrian") +toPolyglossia ("de":"CH":"1901":_) = ("german", "variant=swiss, spelling=old") toPolyglossia ("de":"CH":_) = ("german", "variant=swiss") toPolyglossia ("de":_) = ("german", "") toPolyglossia ("dsb":_) = ("lsorbian", "") -toPolyglossia ("el":"poly":_) = ("greek", "variant=poly") +toPolyglossia ("el":"polyton":_) = ("greek", "variant=poly") toPolyglossia ("en":"AU":_) = ("english", "variant=australian") toPolyglossia ("en":"CA":_) = ("english", "variant=canadian") toPolyglossia ("en":"GB":_) = ("english", "variant=british") @@ -1049,7 +1150,7 @@ toBabel ("de":"AT":"1901":_) = "austrian" toBabel ("de":"AT":_) = "naustrian" toBabel ("de":_) = "ngerman" toBabel ("dsb":_) = "lowersorbian" -toBabel ("el":"poly":_) = "polutonikogreek" +toBabel ("el":"polyton":_) = "polutonikogreek" toBabel ("en":"AU":_) = "australian" toBabel ("en":"CA":_) = "canadian" toBabel ("en":"GB":_) = "british" @@ -1147,3 +1248,7 @@ commonFromBcp47 x = fromIso $ head x fromIso "ur" = "urdu" fromIso "vi" = "vietnamese" fromIso _ = "" + +deNote :: Inline -> Inline +deNote (Note _) = RawInline (Format "latex") "" +deNote x = x diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 6b1e42394..5c7d760ac 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -54,7 +54,7 @@ writeMan opts document = evalState (pandocToMan opts document) (WriterState [] F -- | Return groff man representation of document. pandocToMan :: WriterOptions -> Pandoc -> State WriterState String pandocToMan opts (Pandoc meta blocks) = do - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let render' = render colwidth @@ -146,6 +146,7 @@ breakSentence xs = [] -> (as, []) [c] -> (as ++ [c], []) (c:Space:cs) -> (as ++ [c], cs) + (c:SoftBreak:cs) -> (as ++ [c], cs) (Str ".":Str (')':ys):cs) -> (as ++ [Str ".", Str (')':ys)], cs) (x@(Str ('.':')':_)):cs) -> (as ++ [x], cs) (LineBreak:x@(Str ('.':_)):cs) -> (as ++[LineBreak], x:cs) @@ -343,8 +344,9 @@ inlineToMan _ (RawInline f str) | otherwise = return empty inlineToMan _ (LineBreak) = return $ cr <> text ".PD 0" $$ text ".P" $$ text ".PD" <> cr +inlineToMan _ SoftBreak = return space inlineToMan _ Space = return space -inlineToMan opts (Link txt (src, _)) = do +inlineToMan opts (Link _ txt (src, _)) = do linktext <- inlineListToMan opts txt let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) return $ case txt of @@ -352,12 +354,12 @@ inlineToMan opts (Link txt (src, _)) = do | escapeURI s == srcSuffix -> char '<' <> text srcSuffix <> char '>' _ -> linktext <> text " (" <> text src <> char ')' -inlineToMan opts (Image alternate (source, tit)) = do +inlineToMan opts (Image attr alternate (source, tit)) = do let txt = if (null alternate) || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] else alternate - linkPart <- inlineToMan opts (Link txt (source, tit)) + linkPart <- inlineToMan opts (Link attr txt (source, tit)) return $ char '[' <> text "IMAGE: " <> linkPart <> char ']' inlineToMan _ (Note contents) = do -- add to notes in state diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index cd9c26289..79a2dddf9 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -55,7 +55,8 @@ import qualified Data.Vector as V import qualified Data.Text as T type Notes = [[Block]] -type Refs = [([Inline], Target)] +type Ref = ([Inline], Target, Attr) +type Refs = [Ref] data WriterState = WriterState { stNotes :: Notes , stRefs :: Refs , stRefShortcutable :: Bool @@ -70,8 +71,9 @@ instance Default WriterState writeMarkdown :: WriterOptions -> Pandoc -> String writeMarkdown opts document = evalState (pandocToMarkdown opts{ - writerWrapText = writerWrapText opts && - not (isEnabled Ext_hard_line_breaks opts) } + writerWrapText = if isEnabled Ext_hard_line_breaks opts + then WrapNone + else writerWrapText opts } document) def -- | Convert Pandoc to plain text (like markdown, but without links, @@ -125,7 +127,8 @@ jsonToYaml (Object hashmap) = | otherwise -> (k' <> ":") $$ x (k', Object _, x) -> (k' <> ":") $$ nest 2 x (_, String "", _) -> empty - (k', _, x) -> k' <> ":" <> space <> hang 2 "" x) + (k', _, x) | k == "meta-json" -> empty + | otherwise -> k' <> ":" <> space <> hang 2 "" x) $ sortBy (comparing fst) $ H.toList hashmap jsonToYaml (Array vec) = vcat $ map (\v -> hang 2 "- " (jsonToYaml v)) $ V.toList vec @@ -142,7 +145,7 @@ jsonToYaml _ = empty -- | Return markdown representation of document. pandocToMarkdown :: WriterOptions -> Pandoc -> State WriterState String pandocToMarkdown opts (Pandoc meta blocks) = do - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing isPlain <- gets stPlain @@ -200,15 +203,16 @@ refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat -- | Return markdown representation of a reference key. keyToMarkdown :: WriterOptions - -> ([Inline], (String, String)) + -> Ref -> State WriterState Doc -keyToMarkdown opts (label, (src, tit)) = do +keyToMarkdown opts (label, (src, tit), attr) = do label' <- inlineListToMarkdown opts label let tit' = if null tit then empty else space <> "\"" <> text tit <> "\"" return $ nest 2 $ hang 2 ("[" <> label' <> "]:" <> space) (text src <> tit') + <> linkAttributes opts attr -- | Return markdown representation of notes. notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc @@ -264,7 +268,7 @@ elementToListItem opts (Sec lev _nums (ident,_,_) headerText subsecs) not (null subsecs) && lev < writerTOCDepth opts ] where headerLink = if null ident then headerText - else [Link headerText ('#':ident, "")] + else [Link nullAttr headerText ('#':ident, "")] elementToListItem _ (Blk _) = [] attrsToMarkdown :: Attr -> Doc @@ -283,6 +287,12 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys] map (\(k,v) -> text k <> "=\"" <> text v <> "\"") ks +linkAttributes :: WriterOptions -> Attr -> Doc +linkAttributes opts attr = + if isEnabled Ext_link_attributes opts && attr /= nullAttr + then attrsToMarkdown attr + else empty + -- | Ordered list start parser for use in Para below. olMarker :: Parser [Char] ParserState Char olMarker = do (start, style', delim) <- anyOrderedListMarker @@ -315,7 +325,7 @@ blockToMarkdown opts (Plain inlines) = do contents <- inlineListToMarkdown opts inlines -- escape if para starts with ordered list marker st <- get - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let rendered = render colwidth contents @@ -328,8 +338,8 @@ blockToMarkdown opts (Plain inlines) = do else contents return $ contents' <> cr -- title beginning with fig: indicates figure -blockToMarkdown opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = - blockToMarkdown opts (Para [Image alt (src,tit)]) +blockToMarkdown opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = + blockToMarkdown opts (Para [Image attr alt (src,tit)]) blockToMarkdown opts (Para inlines) = (<> blankline) `fmap` blockToMarkdown opts (Plain inlines) blockToMarkdown opts (RawBlock f str) @@ -668,21 +678,21 @@ blockListToMarkdown opts blocks = -- | Get reference for target; if none exists, create unique one and return. -- Prefer label if possible; otherwise, generate a unique key. -getReference :: [Inline] -> Target -> State WriterState [Inline] -getReference label (src, tit) = do +getReference :: Attr -> [Inline] -> Target -> State WriterState [Inline] +getReference attr label target = do st <- get - case find ((== (src, tit)) . snd) (stRefs st) of - Just (ref, _) -> return ref + case find (\(_,t,a) -> t == target && a == attr) (stRefs st) of + Just (ref, _, _) -> return ref Nothing -> do - let label' = case find ((== label) . fst) (stRefs st) of + let label' = case find (\(l,_,_) -> l == label) (stRefs st) of Just _ -> -- label is used; generate numerical label case find (\n -> notElem [Str (show n)] - (map fst (stRefs st))) + (map (\(l,_,_) -> l) (stRefs st))) [1..(10000 :: Integer)] of Just x -> [Str (show x)] Nothing -> error "no unique label" Nothing -> label - modify (\s -> s{ stRefs = (label', (src,tit)) : stRefs st }) + modify (\s -> s{ stRefs = (label', target, attr) : stRefs st }) return label' -- | Convert list of Pandoc inline elements to markdown. @@ -692,13 +702,17 @@ inlineListToMarkdown opts lst = do go (if inlist then avoidBadWrapsInList lst else lst) where go [] = return empty go (i:is) = case i of - (Link _ _) -> case is of + (Link _ _ _) -> case is of -- If a link is followed by another link or '[' we don't shortcut - (Link _ _):_ -> unshortcutable - Space:(Link _ _):_ -> unshortcutable + (Link _ _ _):_ -> unshortcutable + Space:(Link _ _ _):_ -> unshortcutable Space:(Str('[':_)):_ -> unshortcutable Space:(RawInline _ ('[':_)):_ -> unshortcutable Space:(Cite _ _):_ -> unshortcutable + SoftBreak:(Link _ _ _):_ -> unshortcutable + SoftBreak:(Str('[':_)):_ -> unshortcutable + SoftBreak:(RawInline _ ('[':_)):_ -> unshortcutable + SoftBreak:(Cite _ _):_ -> unshortcutable (Cite _ _):_ -> unshortcutable Str ('[':_):_ -> unshortcutable (RawInline _ ('[':_)):_ -> unshortcutable @@ -712,18 +726,25 @@ inlineListToMarkdown opts lst = do modify (\s -> s {stRefShortcutable = True }) fmap (iMark <>) (go is) +isSp :: Inline -> Bool +isSp Space = True +isSp SoftBreak = True +isSp _ = False + avoidBadWrapsInList :: [Inline] -> [Inline] avoidBadWrapsInList [] = [] -avoidBadWrapsInList (Space:Str ('>':cs):xs) = +avoidBadWrapsInList (s:Str ('>':cs):xs) | isSp s = Str (' ':'>':cs) : avoidBadWrapsInList xs -avoidBadWrapsInList (Space:Str [c]:[]) - | c `elem` ['-','*','+'] = Str [' ', c] : [] -avoidBadWrapsInList (Space:Str [c]:Space:xs) - | c `elem` ['-','*','+'] = Str [' ', c] : Space : avoidBadWrapsInList xs -avoidBadWrapsInList (Space:Str cs:Space:xs) - | isOrderedListMarker cs = Str (' ':cs) : Space : avoidBadWrapsInList xs -avoidBadWrapsInList (Space:Str cs:[]) - | isOrderedListMarker cs = Str (' ':cs) : [] +avoidBadWrapsInList (s:Str [c]:[]) + | isSp s && c `elem` ['-','*','+'] = Str [' ', c] : [] +avoidBadWrapsInList (s:Str [c]:Space:xs) + | isSp s && c `elem` ['-','*','+'] = + Str [' ', c] : Space : avoidBadWrapsInList xs +avoidBadWrapsInList (s:Str cs:Space:xs) + | isSp s && isOrderedListMarker cs = + Str (' ':cs) : Space : avoidBadWrapsInList xs +avoidBadWrapsInList (s:Str cs:[]) + | isSp s && isOrderedListMarker cs = Str (' ':cs) : [] avoidBadWrapsInList (x:xs) = x : avoidBadWrapsInList xs isOrderedListMarker :: String -> Bool @@ -738,6 +759,7 @@ isRight (Left _) = False escapeSpaces :: Inline -> Inline escapeSpaces (Str s) = Str $ substitute " " "\\ " s escapeSpaces Space = Str "\\ " +escapeSpaces SoftBreak = Str "\\ " escapeSpaces x = x -- | Convert Pandoc inline element to markdown. @@ -867,6 +889,11 @@ inlineToMarkdown opts (LineBreak) = do then "\\" <> cr else " " <> cr inlineToMarkdown _ Space = return space +inlineToMarkdown opts SoftBreak = return $ + case writerWrapText opts of + WrapNone -> space + WrapAuto -> space + WrapPreserve -> cr inlineToMarkdown opts (Cite [] lst) = inlineListToMarkdown opts lst inlineToMarkdown opts (Cite (c:cs) lst) | not (isEnabled Ext_citations opts) = inlineListToMarkdown opts lst @@ -897,7 +924,12 @@ inlineToMarkdown opts (Cite (c:cs) lst) return $ pdoc <+> r modekey SuppressAuthor = "-" modekey _ = "" -inlineToMarkdown opts (Link txt (src, tit)) = do +inlineToMarkdown opts lnk@(Link attr txt (src, tit)) + | isEnabled Ext_raw_html opts && + not (isEnabled Ext_link_attributes opts) && + attr /= nullAttr = -- use raw HTML + return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]] + | otherwise = do plain <- gets stPlain linktext <- inlineListToMarkdown opts txt let linktitle = if null tit @@ -912,7 +944,7 @@ inlineToMarkdown opts (Link txt (src, tit)) = do shortcutable <- gets stRefShortcutable let useShortcutRefLinks = shortcutable && isEnabled Ext_shortcut_reference_links opts - ref <- if useRefLinks then getReference txt (src, tit) else return [] + ref <- if useRefLinks then getReference attr txt (src, tit) else return [] reftext <- inlineListToMarkdown opts ref return $ if useAuto then if plain @@ -929,14 +961,20 @@ inlineToMarkdown opts (Link txt (src, tit)) = do else if plain then linktext else "[" <> linktext <> "](" <> - text src <> linktitle <> ")" -inlineToMarkdown opts (Image alternate (source, tit)) = do + text src <> linktitle <> ")" <> + linkAttributes opts attr +inlineToMarkdown opts img@(Image attr alternate (source, tit)) + | isEnabled Ext_raw_html opts && + not (isEnabled Ext_link_attributes opts) && + attr /= nullAttr = -- use raw HTML + return $ text $ trim $ writeHtmlString def $ Pandoc nullMeta [Plain [img]] + | otherwise = do plain <- gets stPlain let txt = if null alternate || alternate == [Str source] -- to prevent autolinks then [Str ""] else alternate - linkPart <- inlineToMarkdown opts (Link txt (source, tit)) + linkPart <- inlineToMarkdown opts (Link attr txt (source, tit)) return $ if plain then "[" <> linkPart <> "]" else "!" <> linkPart diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 2b7c47e24..d14865612 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared import Text.Pandoc.Pretty (render) +import Text.Pandoc.ImageSize import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intersect, intercalate ) @@ -44,6 +45,7 @@ import Control.Monad.State data WriterState = WriterState { stNotes :: Bool -- True if there are notes + , stOptions :: WriterOptions -- writer options } data WriterReader = WriterReader { @@ -57,7 +59,7 @@ type MediaWikiWriter = ReaderT WriterReader (State WriterState) -- | Convert Pandoc to MediaWiki. writeMediaWiki :: WriterOptions -> Pandoc -> String writeMediaWiki opts document = - let initialState = WriterState { stNotes = False } + let initialState = WriterState { stNotes = False, stOptions = opts } env = WriterReader { options = opts, listLevel = [], useTags = False } in evalState (runReaderT (pandocToMediaWiki document) env) initialState @@ -100,14 +102,15 @@ blockToMediaWiki (Plain inlines) = inlineListToMediaWiki inlines -- title beginning with fig: indicates that the image is a figure -blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToMediaWiki (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return "" else ("|caption " ++) `fmap` inlineListToMediaWiki txt + img <- imageToMediaWiki attr let opt = if null txt then "" else "|alt=" ++ if null tit then capt else tit ++ capt - return $ "[[File:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" + return $ "[[File:" ++ src ++ "|frame|none" ++ img ++ opt ++ "]]\n" blockToMediaWiki (Para inlines) = do tags <- asks useTags @@ -312,6 +315,23 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" +imageToMediaWiki :: Attr -> MediaWikiWriter String +imageToMediaWiki attr = do + opts <- gets stOptions + let (_, cls, _) = attr + toPx = fmap (showInPixel opts) . checkPct + checkPct (Just (Percent _)) = Nothing + checkPct maybeDim = maybeDim + go (Just w) Nothing = '|':w ++ "px" + go (Just w) (Just h) = '|':w ++ "x" ++ h ++ "px" + go Nothing (Just h) = "|x" ++ h ++ "px" + go Nothing Nothing = "" + dims = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) + classes = if null cls + then "" + else "|class=" ++ unwords cls + return $ dims ++ classes + -- | Convert list of Pandoc block elements to MediaWiki. blockListToMediaWiki :: [Block] -- ^ List of block elements -> MediaWikiWriter String @@ -377,9 +397,16 @@ inlineToMediaWiki (RawInline f str) inlineToMediaWiki (LineBreak) = return "<br />\n" +inlineToMediaWiki SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapAuto -> return " " + WrapNone -> return " " + WrapPreserve -> return "\n" + inlineToMediaWiki Space = return " " -inlineToMediaWiki (Link txt (src, _)) = do +inlineToMediaWiki (Link _ txt (src, _)) = do label <- inlineListToMediaWiki txt case txt of [Str s] | isURI src && escapeURI s == src -> return src @@ -390,14 +417,15 @@ inlineToMediaWiki (Link txt (src, _)) = do '/':xs -> xs -- with leading / it's a _ -> src -- link to a help page -inlineToMediaWiki (Image alt (source, tit)) = do +inlineToMediaWiki (Image attr alt (source, tit)) = do + img <- imageToMediaWiki attr alt' <- inlineListToMediaWiki alt let txt = if null tit then if null alt then "" else '|' : alt' else '|' : tit - return $ "[[File:" ++ source ++ txt ++ "]]" + return $ "[[File:" ++ source ++ img ++ txt ++ "]]" inlineToMediaWiki (Note contents) = do contents' <- blockListToMediaWiki contents diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 2343ff1a8..fc96e3e3c 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -34,7 +34,7 @@ metadata. -} module Text.Pandoc.Writers.Native ( writeNative ) where -import Text.Pandoc.Options ( WriterOptions(..) ) +import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) ) import Data.List ( intersperse ) import Text.Pandoc.Definition import Text.Pandoc.Pretty @@ -70,7 +70,7 @@ prettyBlock block = text $ show block -- | Prettyprint Pandoc document. writeNative :: WriterOptions -> Pandoc -> String writeNative opts (Pandoc meta blocks) = - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing withHead = if writerStandalone opts diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index 922a3a785..ce4d456a3 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -37,10 +37,10 @@ import Text.TeXMath import qualified Data.ByteString.Lazy as B import Text.Pandoc.UTF8 ( fromStringLazy ) import Codec.Archive.Zip -import Text.Pandoc.Options ( WriterOptions(..) ) +import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..) ) import Text.Pandoc.Shared ( stringify, fetchItem', warn, getDefaultReferenceODT ) -import Text.Pandoc.ImageSize ( imageSize, sizeInPoints ) +import Text.Pandoc.ImageSize import Text.Pandoc.MIME ( getMimeType, extensionFromMimeType ) import Text.Pandoc.Definition import Text.Pandoc.Walk @@ -67,7 +67,7 @@ writeODT opts doc@(Pandoc meta _) = do -- handle formulas and pictures picEntriesRef <- newIORef ([] :: [Entry]) doc' <- walkM (transformPicMath opts picEntriesRef) $ walk fixDisplayMath doc - let newContents = writeOpenDocument opts{writerWrapText = False} doc' + let newContents = writeOpenDocument opts{writerWrapText = WrapNone} doc' epochtime <- floor `fmap` getPOSIXTime let contentEntry = toEntry "content.xml" epochtime $ fromStringLazy newContents @@ -125,21 +125,36 @@ writeODT opts doc@(Pandoc meta _) = do $ addEntryToArchive metaEntry archive' return $ fromArchive archive'' +-- | transform both Image and Math elements transformPicMath :: WriterOptions -> IORef [Entry] -> Inline -> IO Inline -transformPicMath opts entriesRef (Image lab (src,t)) = do +transformPicMath opts entriesRef (Image attr@(id', cls, _) lab (src,t)) = do res <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case res of Left (_ :: E.SomeException) -> do warn $ "Could not find image `" ++ src ++ "', skipping..." return $ Emph lab Right (img, mbMimeType) -> do - (w,h) <- case imageSize img of - Right size -> return $ sizeInPoints size - Left msg -> do - warn $ "Could not determine image size in `" ++ - src ++ "': " ++ msg - return (0,0) - let tit' = show w ++ "x" ++ show h + (ptX, ptY) <- case imageSize img of + Right s -> return $ sizeInPoints s + Left msg -> do + warn $ "Could not determine image size in `" ++ + src ++ "': " ++ msg + return (100, 100) + let dims = + case (getDim Width, getDim Height) of + (Just w, Just h) -> [("width", show w), ("height", show h)] + (Just w@(Percent _), Nothing) -> [("width", show w), ("style:rel-height", "scale")] + (Nothing, Just h@(Percent _)) -> [("style:rel-width", "scale"), ("height", show h)] + (Just w@(Inch i), Nothing) -> [("width", show w), ("height", show (i / ratio) ++ "in")] + (Nothing, Just h@(Inch i)) -> [("width", show (i * ratio) ++ "in"), ("height", show h)] + _ -> [("width", show ptX ++ "pt"), ("height", show ptY ++ "pt")] + where + ratio = ptX / ptY + getDim dir = case (dimension dir attr) of + Just (Percent i) -> Just $ Percent i + Just dim -> Just $ Inch $ inInch opts dim + Nothing -> Nothing + let newattr = (id', cls, dims) entries <- readIORef entriesRef let extension = fromMaybe (takeExtension $ takeWhile (/='?') src) (mbMimeType >>= extensionFromMimeType) @@ -148,9 +163,7 @@ transformPicMath opts entriesRef (Image lab (src,t)) = do epochtime <- floor `fmap` getPOSIXTime let entry = toEntry newsrc epochtime $ toLazy img modifyIORef entriesRef (entry:) - let fig | "fig:" `isPrefixOf` t = "fig:" - | otherwise = "" - return $ Image lab (newsrc, fig++tit') + return $ Image newattr lab (newsrc, t) transformPicMath _ entriesRef (Math t math) = do entries <- readIORef entriesRef let dt = if t == InlineMath then DisplayInline else DisplayBlock diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index 519136861..5770c3c6f 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -45,7 +45,7 @@ import qualified Text.Pandoc.Builder as B writeOPML :: WriterOptions -> Pandoc -> String writeOPML opts (Pandoc meta blocks) = let elements = hierarchicalize blocks - colwidth = if writerWrapText opts + colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing meta' = B.setMeta "date" (B.str $ convertDate $ docDate meta) meta diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index ebe678dc0..e0434c630 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -39,7 +39,7 @@ import Text.Pandoc.Pretty import Text.Printf ( printf ) import Control.Arrow ( (***), (>>>) ) import Control.Monad.State hiding ( when ) -import Data.Char (chr, isDigit) +import Data.Char (chr) import qualified Data.Map as Map import Text.Pandoc.Writers.Shared @@ -175,7 +175,7 @@ handleSpaces s -- | Convert Pandoc document to string in OpenDocument format. writeOpenDocument :: WriterOptions -> Pandoc -> String writeOpenDocument opts (Pandoc meta blocks) = - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing render' = render colwidth @@ -191,8 +191,7 @@ writeOpenDocument opts (Pandoc meta blocks) = listStyle (n,l) = inTags True "text:list-style" [("style:name", "L" ++ show n)] (vcat l) listStyles = map listStyle (stListStyles s) - automaticStyles = inTagsIndented "office:automatic-styles" $ vcat $ - reverse $ styles ++ listStyles + automaticStyles = vcat $ reverse $ styles ++ listStyles context = defField "body" body $ defField "automatic-styles" (render' automaticStyles) $ metadata @@ -287,8 +286,8 @@ blockToOpenDocument o bs | Plain b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b - | Para [Image c (s,'f':'i':'g':':':t)] <- bs - = figure c s t + | Para [Image attr c (s,'f':'i':'g':':':t)] <- bs + = figure attr c s t | Para b <- bs = if null b then return empty else inParagraphTags =<< inlinesToOpenDocument o b @@ -343,10 +342,10 @@ blockToOpenDocument o bs return $ inTags True "table:table" [ ("table:name" , name) , ("table:style-name", name) ] (vcat columns $$ th $$ vcat tr) $$ captionDoc - figure caption source title | null caption = - withParagraphStyle o "Figure" [Para [Image caption (source,title)]] + figure attr caption source title | null caption = + withParagraphStyle o "Figure" [Para [Image attr caption (source,title)]] | otherwise = do - imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image caption (source,title)]] + imageDoc <- withParagraphStyle o "FigureWithCaption" [Para [Image attr caption (source,title)]] captionDoc <- withParagraphStyle o "FigureCaption" [Para caption] return $ imageDoc $$ captionDoc @@ -375,38 +374,48 @@ inlinesToOpenDocument o l = hcat <$> mapM (inlineToOpenDocument o) l -- | Convert an inline element to OpenDocument. inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc inlineToOpenDocument o ils - | Space <- ils = inTextStyle space - | Span _ xs <- ils = inlinesToOpenDocument o xs - | LineBreak <- ils = return $ selfClosingTag "text:line-break" [] - | Str s <- ils = inTextStyle $ handleSpaces $ escapeStringForXML s - | Emph l <- ils = withTextStyle Italic $ inlinesToOpenDocument o l - | Strong l <- ils = withTextStyle Bold $ inlinesToOpenDocument o l - | Strikeout l <- ils = withTextStyle Strike $ inlinesToOpenDocument o l - | Superscript l <- ils = withTextStyle Sup $ inlinesToOpenDocument o l - | Subscript l <- ils = withTextStyle Sub $ inlinesToOpenDocument o l - | SmallCaps l <- ils = withTextStyle SmallC $ inlinesToOpenDocument o l - | Quoted t l <- ils = inQuotes t <$> inlinesToOpenDocument o l - | Code _ s <- ils = withTextStyle Pre $ inTextStyle $ preformatted s - | Math t s <- ils = inlinesToOpenDocument o (texMathToInlines t s) - | Cite _ l <- ils = inlinesToOpenDocument o l - | RawInline f s <- ils = if f == Format "opendocument" - then return $ text s - else return empty - | Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l - | Image _ (s,t) <- ils = mkImg s t - | Note l <- ils = mkNote l - | otherwise = return empty + = case ils of + Space -> inTextStyle space + SoftBreak + | writerWrapText o == WrapPreserve + -> inTextStyle (preformatted "\n") + | otherwise -> inTextStyle space + Span _ xs -> inlinesToOpenDocument o xs + LineBreak -> return $ selfClosingTag "text:line-break" [] + Str s -> inTextStyle $ handleSpaces $ escapeStringForXML s + Emph l -> withTextStyle Italic $ inlinesToOpenDocument o l + Strong l -> withTextStyle Bold $ inlinesToOpenDocument o l + Strikeout l -> withTextStyle Strike $ inlinesToOpenDocument o l + Superscript l -> withTextStyle Sup $ inlinesToOpenDocument o l + Subscript l -> withTextStyle Sub $ inlinesToOpenDocument o l + SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l + Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l + Code _ s -> withTextStyle Pre $ inTextStyle $ preformatted s + Math t s -> inlinesToOpenDocument o (texMathToInlines t s) + Cite _ l -> inlinesToOpenDocument o l + RawInline f s -> if f == Format "opendocument" + then return $ text s + else return empty + Link _ l (s,t) -> mkLink s t <$> inlinesToOpenDocument o l + Image attr _ (s,t) -> mkImg attr s t + Note l -> mkNote l where preformatted s = handleSpaces $ escapeStringForXML s mkLink s t = inTags False "text:a" [ ("xlink:type" , "simple") , ("xlink:href" , s ) , ("office:name", t ) ] . inSpanTags "Definition" - mkImg s t = do + mkImg (_, _, kvs) s _ = do id' <- gets stImageId modify (\st -> st{ stImageId = id' + 1 }) + let getDims [] = [] + getDims (("width", w) :xs) = ("svg:width", w) : getDims xs + getDims (("height", h):xs) = ("svg:height", h) : getDims xs + getDims (x@("style:rel-width", _) :xs) = x : getDims xs + getDims (x@("style:rel-height", _):xs) = x : getDims xs + getDims (_:xs) = getDims xs return $ inTags False "draw:frame" - (("draw:name", "img" ++ show id'):attrsFromTitle t) $ + (("draw:name", "img" ++ show id') : getDims kvs) $ selfClosingTag "draw:image" [ ("xlink:href" , s ) , ("xlink:type" , "simple") , ("xlink:show" , "embed" ) @@ -422,17 +431,6 @@ inlineToOpenDocument o ils addNote nn return nn --- a title of the form "120x140" will be interpreted as image --- size in points. -attrsFromTitle :: String -> [(String,String)] -attrsFromTitle s = if null xs || null ys - then [] - else [("svg:width",xs ++ "pt"),("svg:height",ys ++ "pt")] - where (xs,rest) = span isDigit s - ys = case rest of - ('x':zs) | all isDigit zs -> zs - _ -> "" - bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc])) bulletListStyle l = let doStyles i = inTags True "text:list-level-style-bullet" diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 1b0ab387f..d843d2efd 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -61,7 +61,7 @@ writeOrg opts document = pandocToOrg :: Pandoc -> State WriterState String pandocToOrg (Pandoc meta blocks) = do opts <- liftM stOptions get - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing metadata <- metaToJSON opts @@ -116,12 +116,12 @@ blockToOrg (Div attrs bs) = do nest 2 endTag $$ "#+END_HTML" $$ blankline blockToOrg (Plain inlines) = inlineListToOrg inlines -- title beginning with fig: indicates that the image is a figure -blockToOrg (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToOrg (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return empty else (\c -> "#+CAPTION: " <> c <> blankline) `fmap` inlineListToOrg txt - img <- inlineToOrg (Image txt (src,tit)) + img <- inlineToOrg (Image attr txt (src,tit)) return $ capt <> img blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines @@ -275,7 +275,13 @@ inlineToOrg (RawInline f str) | f == "tex" || f == "latex" = return $ text str inlineToOrg (RawInline _ _) = return empty inlineToOrg (LineBreak) = return (text "\\\\" <> cr) inlineToOrg Space = return space -inlineToOrg (Link txt (src, _)) = do +inlineToOrg SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapPreserve -> return cr + WrapAuto -> return space + WrapNone -> return space +inlineToOrg (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do modify $ \s -> s{ stLinks = True } @@ -283,7 +289,7 @@ inlineToOrg (Link txt (src, _)) = do _ -> do contents <- inlineListToOrg txt modify $ \s -> s{ stLinks = True } return $ "[[" <> text src <> "][" <> contents <> "]]" -inlineToOrg (Image _ (source, _)) = do +inlineToOrg (Image _ _ (source, _)) = do modify $ \s -> s{ stImages = True } return $ "[[" <> text source <> "]]" inlineToOrg (Note contents) = do diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 334619880..3b44a6cb0 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -35,6 +35,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.Shared +import Text.Pandoc.ImageSize import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Builder (deleteMeta) import Data.Maybe (fromMaybe) @@ -49,7 +50,7 @@ type Refs = [([Inline], Target)] data WriterState = WriterState { stNotes :: [[Block]] , stLinks :: Refs - , stImages :: [([Inline], (String, String, Maybe String))] + , stImages :: [([Inline], (Attr, String, String, Maybe String))] , stHasMath :: Bool , stHasRawTeX :: Bool , stOptions :: WriterOptions @@ -69,7 +70,7 @@ writeRST opts document = pandocToRST :: Pandoc -> State WriterState String pandocToRST (Pandoc meta blocks) = do opts <- liftM stOptions get - let colwidth = if writerWrapText opts + let colwidth = if writerWrapText opts == WrapAuto then Just $ writerColumns opts else Nothing let subtit = case lookupMeta "subtitle" meta of @@ -138,17 +139,22 @@ noteToRST num note = do return $ nowrap $ marker $$ nest 3 contents -- | Return RST representation of picture reference table. -pictRefsToRST :: [([Inline], (String, String, Maybe String))] +pictRefsToRST :: [([Inline], (Attr, String, String, Maybe String))] -> State WriterState Doc pictRefsToRST refs = mapM pictToRST refs >>= return . vcat -- | Return RST representation of a picture substitution reference. -pictToRST :: ([Inline], (String, String,Maybe String)) +pictToRST :: ([Inline], (Attr, String, String, Maybe String)) -> State WriterState Doc -pictToRST (label, (src, _, mbtarget)) = do +pictToRST (label, (attr, src, _, mbtarget)) = do label' <- inlineListToRST label + dims <- imageDimsToRST attr + let (_, cls, _) = attr + classes = if null cls + then empty + else ":class: " <> text (unwords cls) return $ nowrap - $ ".. |" <> label' <> "| image:: " <> text src + $ ".. |" <> label' <> "| image:: " <> text src $$ hang 3 empty (classes $$ dims) $$ case mbtarget of Nothing -> empty Just t -> " :target: " <> text t @@ -183,11 +189,16 @@ blockToRST (Div attr bs) = do return $ blankline <> startTag $+$ contents $+$ endTag $$ blankline blockToRST (Plain inlines) = inlineListToRST inlines -- title beginning with fig: indicates that the image is a figure -blockToRST (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToRST (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- inlineListToRST txt + dims <- imageDimsToRST attr let fig = "figure:: " <> text src - let alt = ":alt: " <> if null tit then capt else text tit - return $ hang 3 ".. " (fig $$ alt $+$ capt) $$ blankline + alt = ":alt: " <> if null tit then capt else text tit + (_,cls,_) = attr + classes = if null cls + then empty + else ":figclass: " <> text (unwords cls) + return $ hang 3 ".. " (fig $$ alt $$ classes $$ dims $+$ capt) $$ blankline blockToRST (Para inlines) | LineBreak `elem` inlines = do -- use line block if LineBreaks lns <- mapM inlineListToRST $ splitBy (==LineBreak) inlines @@ -367,11 +378,13 @@ inlineListToRST lst = surroundComplex _ _ = False okAfterComplex :: Inline -> Bool okAfterComplex Space = True + okAfterComplex SoftBreak = True okAfterComplex LineBreak = True okAfterComplex (Str (c:_)) = isSpace c || c `elem` ("-.,:;!?\\/'\")]}>–—" :: String) okAfterComplex _ = False okBeforeComplex :: Inline -> Bool okBeforeComplex Space = True + okBeforeComplex SoftBreak = True okBeforeComplex LineBreak = True okBeforeComplex (Str (c:_)) = isSpace c || c `elem` ("-:/'\"<([{–—" :: String) okBeforeComplex _ = False @@ -382,8 +395,8 @@ inlineListToRST lst = isComplex (Strikeout _) = True isComplex (Superscript _) = True isComplex (Subscript _) = True - isComplex (Link _ _) = True - isComplex (Image _ _) = True + isComplex (Link _ _ _) = True + isComplex (Image _ _ _) = True isComplex (Code _ _) = True isComplex (Math _ _) = True isComplex (Cite _ (x:_)) = isComplex x @@ -435,18 +448,24 @@ inlineToRST (RawInline f x) | otherwise = return empty inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para) inlineToRST Space = return space +inlineToRST SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapPreserve -> return cr + WrapAuto -> return space + WrapNone -> return space -- autolink -inlineToRST (Link [Str str] (src, _)) +inlineToRST (Link _ [Str str] (src, _)) | isURI src && if "mailto:" `isPrefixOf` src then src == escapeURI ("mailto:" ++ str) else src == escapeURI str = do let srcSuffix = fromMaybe src (stripPrefix "mailto:" src) return $ text srcSuffix -inlineToRST (Link [Image alt (imgsrc,imgtit)] (src, _tit)) = do - label <- registerImage alt (imgsrc,imgtit) (Just src) +inlineToRST (Link _ [Image attr alt (imgsrc,imgtit)] (src, _tit)) = do + label <- registerImage attr alt (imgsrc,imgtit) (Just src) return $ "|" <> label <> "|" -inlineToRST (Link txt (src, tit)) = do +inlineToRST (Link _ txt (src, tit)) = do useReferenceLinks <- get >>= return . writerReferenceLinks . stOptions linktext <- inlineListToRST $ normalizeSpaces txt if useReferenceLinks @@ -461,8 +480,8 @@ inlineToRST (Link txt (src, tit)) = do modify $ \st -> st { stLinks = (txt,(src,tit)):refs } return $ "`" <> linktext <> "`_" else return $ "`" <> linktext <> " <" <> text src <> ">`__" -inlineToRST (Image alternate (source, tit)) = do - label <- registerImage alternate (source,tit) Nothing +inlineToRST (Image attr alternate (source, tit)) = do + label <- registerImage attr alternate (source,tit) Nothing return $ "|" <> label <> "|" inlineToRST (Note contents) = do -- add to notes in state @@ -471,16 +490,33 @@ inlineToRST (Note contents) = do let ref = show $ (length notes) + 1 return $ " [" <> text ref <> "]_" -registerImage :: [Inline] -> Target -> Maybe String -> State WriterState Doc -registerImage alt (src,tit) mbtarget = do +registerImage :: Attr -> [Inline] -> Target -> Maybe String -> State WriterState Doc +registerImage attr alt (src,tit) mbtarget = do pics <- get >>= return . stImages txt <- case lookup alt pics of - Just (s,t,mbt) | (s,t,mbt) == (src,tit,mbtarget) -> return alt + Just (a,s,t,mbt) | (a,s,t,mbt) == (attr,src,tit,mbtarget) + -> return alt _ -> do let alt' = if null alt || alt == [Str ""] then [Str $ "image" ++ show (length pics)] else alt modify $ \st -> st { stImages = - (alt', (src,tit, mbtarget)):stImages st } + (alt', (attr,src,tit, mbtarget)):stImages st } return alt' inlineListToRST txt + +imageDimsToRST :: Attr -> State WriterState Doc +imageDimsToRST attr = do + let (ident, _, _) = attr + name = if null ident + then empty + else ":name: " <> text ident + showDim dir = let cols d = ":" <> text (show dir) <> ": " <> text (show d) + in case (dimension dir attr) of + Just (Percent a) -> + case dir of + Height -> empty + Width -> cols (Percent a) + Just dim -> cols dim + Nothing -> empty + return $ cr <> name $$ showDim Width $$ showDim Height diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 9eb02ad02..79a28c880 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -46,7 +46,7 @@ import Text.Pandoc.ImageSize -- or a MediaBag, or the internet. -- If file not found or filetype not jpeg or png, leave the inline unchanged. rtfEmbedImage :: WriterOptions -> Inline -> IO Inline -rtfEmbedImage opts x@(Image _ (src,_)) = do +rtfEmbedImage opts x@(Image attr _ (src,_)) = do result <- fetchItem' (writerMediaBag opts) (writerSourceURL opts) src case result of Right (imgdata, Just mime) @@ -63,12 +63,12 @@ rtfEmbedImage opts x@(Image _ (src,_)) = do return "" Right sz -> return $ "\\picw" ++ show xpx ++ "\\pich" ++ show ypx ++ - "\\picwgoal" ++ show (xpt * 20) - ++ "\\pichgoal" ++ show (ypt * 20) + "\\picwgoal" ++ show (floor (xpt * 20) :: Integer) + ++ "\\pichgoal" ++ show (floor (ypt * 20) :: Integer) -- twip = 1/1440in = 1/20pt where (xpx, ypx) = sizeInPixels sz - (xpt, ypt) = sizeInPoints sz - let raw = "{\\pict" ++ filetype ++ sizeSpec ++ " " ++ + (xpt, ypt) = desiredSizeInPoints opts attr sz + let raw = "{\\pict" ++ filetype ++ sizeSpec ++ "\\bin " ++ concat bytes ++ "}" return $ if B.null imgdata then x @@ -349,11 +349,12 @@ inlineToRTF (RawInline f str) | f == Format "rtf" = str | otherwise = "" inlineToRTF (LineBreak) = "\\line " +inlineToRTF SoftBreak = " " inlineToRTF Space = " " -inlineToRTF (Link text (src, _)) = +inlineToRTF (Link _ text (src, _)) = "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n" -inlineToRTF (Image _ (source, _)) = +inlineToRTF (Image _ _ (source, _)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}" inlineToRTF (Note contents) = "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index d94dbac46..865d10123 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -45,7 +45,8 @@ import Text.Pandoc.Options (WriterOptions(..)) import qualified Data.HashMap.Strict as H import qualified Data.Map as M import qualified Data.Text as T -import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..)) +import Data.Aeson (FromJSON(..), fromJSON, ToJSON (..), Value(Object), Result(..), encode) +import Text.Pandoc.UTF8 (toStringLazy) import qualified Data.Traversable as Traversable import Data.List ( groupBy ) @@ -67,7 +68,8 @@ metaToJSON opts blockWriter inlineWriter (Meta metamap) renderedMap <- Traversable.mapM (metaValueToJSON blockWriter inlineWriter) metamap - return $ M.foldWithKey defField baseContext renderedMap + let metadata = M.foldWithKey defField baseContext renderedMap + return $ defField "meta-json" (toStringLazy $ encode metadata) metadata | otherwise = return (Object H.empty) metaValueToJSON :: Monad m diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 2325d1425..1aefaa678 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -40,6 +40,7 @@ import Data.Ord ( comparing ) import Data.Char ( chr, ord ) import Control.Monad.State import Text.Pandoc.Pretty +import Text.Pandoc.ImageSize import Network.URI ( isURI, unEscapeString ) import System.FilePath @@ -49,6 +50,7 @@ data WriterState = , stSubscript :: Bool -- document contains subscript , stEscapeComma :: Bool -- in a context where we need @comma , stIdentifiers :: [String] -- header ids used already + , stOptions :: WriterOptions -- writer options } {- TODO: @@ -61,7 +63,8 @@ writeTexinfo :: WriterOptions -> Pandoc -> String writeTexinfo options document = evalState (pandocToTexinfo options $ wrapTop document) $ WriterState { stStrikeout = False, stSuperscript = False, - stEscapeComma = False, stSubscript = False, stIdentifiers = [] } + stEscapeComma = False, stSubscript = False, + stIdentifiers = [], stOptions = options} -- | Add a "Top" node around the document, needed by Texinfo. wrapTop :: Pandoc -> Pandoc @@ -72,7 +75,7 @@ pandocToTexinfo :: WriterOptions -> Pandoc -> State WriterState String pandocToTexinfo options (Pandoc meta blocks) = do let titlePage = not $ all null $ docTitle meta : docDate meta : docAuthors meta - let colwidth = if writerWrapText options + let colwidth = if writerWrapText options == WrapAuto then Just $ writerColumns options else Nothing metadata <- metaToJSON options @@ -130,12 +133,12 @@ blockToTexinfo (Plain lst) = inlineListToTexinfo lst -- title beginning with fig: indicates that the image is a figure -blockToTexinfo (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToTexinfo (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- if null txt then return empty else (\c -> text "@caption" <> braces c) `fmap` inlineListToTexinfo txt - img <- inlineToTexinfo (Image txt (src,tit)) + img <- inlineToTexinfo (Image attr txt (src,tit)) return $ text "@float" $$ img $$ capt $$ text "@end float" blockToTexinfo (Para lst) = @@ -422,13 +425,19 @@ inlineToTexinfo (RawInline f str) | f == "texinfo" = return $ text str | otherwise = return empty inlineToTexinfo (LineBreak) = return $ text "@*" <> cr +inlineToTexinfo SoftBreak = do + wrapText <- gets (writerWrapText . stOptions) + case wrapText of + WrapAuto -> return space + WrapNone -> return space + WrapPreserve -> return cr inlineToTexinfo Space = return space -inlineToTexinfo (Link txt (src@('#':_), _)) = do +inlineToTexinfo (Link _ txt (src@('#':_), _)) = do contents <- escapeCommas $ inlineListToTexinfo txt return $ text "@ref" <> braces (text (stringToTexinfo src) <> text "," <> contents) -inlineToTexinfo (Link txt (src, _)) = do +inlineToTexinfo (Link _ txt (src, _)) = do case txt of [Str x] | escapeURI x == src -> -- autolink do return $ text $ "@url{" ++ x ++ "}" @@ -437,10 +446,16 @@ inlineToTexinfo (Link txt (src, _)) = do return $ text ("@uref{" ++ src1 ++ ",") <> contents <> char '}' -inlineToTexinfo (Image alternate (source, _)) = do +inlineToTexinfo (Image attr alternate (source, _)) = do content <- escapeCommas $ inlineListToTexinfo alternate - return $ text ("@image{" ++ base ++ ",,,") <> content <> text "," <> - text (ext ++ "}") + opts <- gets stOptions + let showDim dim = case (dimension dim attr) of + (Just (Pixel a)) -> showInInch opts (Pixel a) ++ "in" + (Just (Percent _)) -> "" + (Just d) -> show d + Nothing -> "" + return $ text ("@image{" ++ base ++ ',':(showDim Width) ++ ',':(showDim Height) ++ ",") + <> content <> text "," <> text (ext ++ "}") where ext = drop 1 $ takeExtension source' base = dropExtension source' diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index df632adc6..98f9157fb 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Pretty (render) +import Text.Pandoc.ImageSize import Text.Pandoc.Writers.Shared import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.XML ( escapeStringForXML ) @@ -44,6 +45,7 @@ import Data.Char ( isSpace ) data WriterState = WriterState { stNotes :: [String] -- Footnotes , stListLevel :: [Char] -- String at beginning of list items, e.g. "**" + , stStartNum :: Maybe Int -- Start number if first list item , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list } @@ -51,7 +53,8 @@ data WriterState = WriterState { writeTextile :: WriterOptions -> Pandoc -> String writeTextile opts document = evalState (pandocToTextile opts document) - WriterState { stNotes = [], stListLevel = [], stUseTags = False } + WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing, + stUseTags = False } -- | Return Textile representation of document. pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String @@ -114,9 +117,9 @@ blockToTextile opts (Plain inlines) = inlineListToTextile opts inlines -- title beginning with fig: indicates that the image is a figure -blockToTextile opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do +blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- blockToTextile opts (Para txt) - im <- inlineToTextile opts (Image txt (src,tit)) + im <- inlineToTextile opts (Image attr txt (src,tit)) return $ im ++ "\n" ++ capt blockToTextile opts (Para inlines) = do @@ -218,7 +221,7 @@ blockToTextile opts x@(BulletList items) = do modify $ \s -> s { stListLevel = init (stListLevel s) } return $ vcat contents ++ (if level > 1 then "" else "\n") -blockToTextile opts x@(OrderedList attribs items) = do +blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do oldUseTags <- liftM stUseTags get let useTags = oldUseTags || not (isSimpleList x) if useTags @@ -227,10 +230,14 @@ blockToTextile opts x@(OrderedList attribs items) = do return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++ "\n</ol>\n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ "#" } + modify $ \s -> s { stListLevel = stListLevel s ++ "#" + , stStartNum = if start > 1 + then Just start + else Nothing } level <- get >>= return . length . stListLevel contents <- mapM (listItemToTextile opts) items - modify $ \s -> s { stListLevel = init (stListLevel s) } + modify $ \s -> s { stListLevel = init (stListLevel s), + stStartNum = Nothing } return $ vcat contents ++ (if level > 1 then "" else "\n") blockToTextile opts (DefinitionList items) = do @@ -258,8 +265,13 @@ listItemToTextile opts items = do if useTags then return $ "<li>" ++ contents ++ "</li>" else do - marker <- get >>= return . stListLevel - return $ marker ++ " " ++ contents + marker <- gets stListLevel + mbstart <- gets stStartNum + case mbstart of + Just n -> do + modify $ \s -> s{ stStartNum = Nothing } + return $ marker ++ show n ++ " " ++ contents + Nothing -> return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to Textile. definitionListItemToTextile :: WriterOptions @@ -276,8 +288,8 @@ isSimpleList :: Block -> Bool isSimpleList x = case x of BulletList items -> all isSimpleListItem items - OrderedList (num, sty, _) items -> all isSimpleListItem items && - num == 1 && sty `elem` [DefaultStyle, Decimal] + OrderedList (_, sty, _) items -> all isSimpleListItem items && + sty `elem` [DefaultStyle, Decimal] _ -> False -- | True if list item can be handled with the simple wiki syntax. False if @@ -422,25 +434,43 @@ inlineToTextile opts (RawInline f str) inlineToTextile _ (LineBreak) = return "\n" +inlineToTextile _ SoftBreak = return " " + inlineToTextile _ Space = return " " -inlineToTextile opts (Link txt (src, _)) = do +inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do + let classes = if null cls + then "" + else "(" ++ unwords cls ++ ")" label <- case txt of [Code _ s] | s == src -> return "$" [Str s] | s == src -> return "$" _ -> inlineListToTextile opts txt - return $ "\"" ++ label ++ "\":" ++ src + return $ "\"" ++ classes ++ label ++ "\":" ++ src -inlineToTextile opts (Image alt (source, tit)) = do +inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do alt' <- inlineListToTextile opts alt let txt = if null tit then if null alt' then "" else "(" ++ alt' ++ ")" else "(" ++ tit ++ ")" - return $ "!" ++ source ++ txt ++ "!" + classes = if null cls + then "" + else "(" ++ unwords cls ++ ")" + showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" + in case (dimension dir attr) of + Just (Percent a) -> toCss $ show (Percent a) + Just dim -> toCss $ showInPixel opts dim ++ "px" + Nothing -> Nothing + styles = case (showDim Width, showDim Height) of + (Just w, Just h) -> "{" ++ w ++ h ++ "}" + (Just w, Nothing) -> "{" ++ w ++ "height:auto;}" + (Nothing, Just h) -> "{" ++ "width:auto;" ++ h ++ "}" + (Nothing, Nothing) -> "" + return $ "!" ++ classes ++ styles ++ source ++ txt ++ "!" inlineToTextile opts (Note contents) = do curNotes <- liftM stNotes get |