diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -83,6 +83,30 @@ You can also use `autoSectionLabels` variable to automatically prepend all section labels (automatically generated with pandoc included) with "sec:". Bear in mind that references can't contain periods, commas etc, so some auto-generated labels will still be unusable. +### Section reference labels + +***Not currently supported with LaTeX output*** + +If you want to reference some section by a pre-defined label instead of by number, you can specify section attribute `label`, like this: + +```markdown +# Section {label="Custom Label"} +``` + +This label will be used instead of section number in `chapters` output and when referencing section directly (with `@sec:section`). + +Note that with `chapters` output with depth>1, only given section will be referenced by custom label, e.g. with + +```markdown +# Chapter 1. + +## Section with custom label {#sec:scl label="SCL"} + +![](figure.png){#fig:figure} +``` + +`@sec:scl` will translate into `sec. 1.SCL`, and `@fig:figure` into `fig. 1.SCL.1` + ### Code Block labels There are a couple options to add code block labels. Those work only if code block id starts with `lst:`, e.g. `{#lst:label}` diff --git a/pandoc-crossref.cabal b/pandoc-crossref.cabal --- a/pandoc-crossref.cabal +++ b/pandoc-crossref.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: pandoc-crossref -version: 0.1.5.2 +version: 0.1.5.3 synopsis: Pandoc filter for cross-references description: pandoc-crossref is a pandoc filter for numbering figures, equations, tables and cross-references to them. license: GPL-2 @@ -23,7 +23,7 @@ source-repository this type: git location: https://github.com/lierdakil/pandoc-crossref - tag: v0.1.5.2 + tag: v0.1.5.3 library exposed-modules: Text.Pandoc.CrossRef @@ -51,7 +51,6 @@ , yaml >= 0.8 && <0.9 , data-default >= 0.4 && <0.6 , bytestring >=0.9 && <0.11 - , template-haskell hs-source-dirs: src Ghc-Options: -Wall default-language: Haskell2010 @@ -86,6 +85,5 @@ , hspec , process >=1 && <1.3 , pandoc-crossref - , template-haskell Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind -threaded Default-Language: Haskell2010 diff --git a/src/Text/Pandoc/CrossRef/References/Blocks.hs b/src/Text/Pandoc/CrossRef/References/Blocks.hs --- a/src/Text/Pandoc/CrossRef/References/Blocks.hs +++ b/src/Text/Pandoc/CrossRef/References/Blocks.hs @@ -23,42 +23,43 @@ unless ("unnumbered" `elem` cls) $ do modify $ \r@References{curChap=cc} -> let ln = length cc - inc l = init l ++ [last l + 1] + cl = lookup "label" attrs + inc l = init l ++ [(fst (last l) + 1, cl)] cc' | ln > n = inc $ take n cc | ln == n = inc cc - | otherwise = cc ++ take (n-ln) [1,1..] + | otherwise = cc ++ take (n-ln-1) (zip [1,1..] $ repeat Nothing) ++ [(1,cl)] in r{curChap=cc'} when ("sec:" `isPrefixOf` label') $ replaceAttrSec label' text' secRefs' return $ Header n (label', cls, attrs) text' -replaceBlocks opts (Div (label,_,_) [Plain [Image alt img]]) +replaceBlocks opts (Div (label,_,attrs) [Plain [Image alt img]]) | "fig:" `isPrefixOf` label = do - idxStr <- replaceAttr opts label alt imgRefs' + idxStr <- replaceAttr opts label (lookup "label" attrs) alt imgRefs' let alt' = case outFormat opts of f | isFormat "latex" f -> RawInline (Format "tex") ("\\label{"++label++"}") : alt _ -> applyTemplate idxStr alt $ figureTemplate opts return $ Para [Image alt' (fst img,"fig:")] -replaceBlocks opts (Div (label,_,_) [Plain [Math DisplayMath eq]]) +replaceBlocks opts (Div (label,_,attrs) [Plain [Math DisplayMath eq]]) | "eq:" `isPrefixOf` label = case outFormat opts of f | isFormat "latex" f -> let eqn = "\\begin{equation}"++eq++"\\label{"++label++"}\\end{equation}" in return $ Para [RawInline (Format "tex") eqn] _ -> do - idxStr <- replaceAttr opts label [] eqnRefs' + idxStr <- replaceAttr opts label (lookup "label" attrs) [] eqnRefs' let eq' = eq++"\\qquad("++stringify idxStr++")" return $ Para [Math DisplayMath eq'] -replaceBlocks opts (Div (label,_,_) [Table title align widths header cells]) +replaceBlocks opts (Div (label,_,attrs) [Table title align widths header cells]) | not $ null title , "tbl:" `isPrefixOf` label = do - idxStr <- replaceAttr opts label (init title) tblRefs' + idxStr <- replaceAttr opts label (lookup "label" attrs) title tblRefs' let title' = case outFormat opts of f | isFormat "latex" f -> - RawInline (Format "tex") ("\\label{"++label++"}") : init title - _ -> applyTemplate idxStr (init title) $ tableTemplate opts + RawInline (Format "tex") ("\\label{"++label++"}") : title + _ -> applyTemplate idxStr title $ tableTemplate opts return $ Table title' align widths header cells replaceBlocks opts cb@(CodeBlock (label, classes, attrs) code) | not $ null label @@ -78,7 +79,7 @@ ] _ -> do let cap = toList $ text caption - idxStr <- replaceAttr opts label cap lstRefs' + idxStr <- replaceAttr opts label (lookup "label" attrs) cap lstRefs' let caption' = applyTemplate idxStr cap $ listingTemplate opts return $ Div (label, "listing":classes, []) [ Para caption' @@ -103,7 +104,7 @@ , RawBlock (Format "tex") "\\end{codelisting}" ] _ -> do - idxStr <- replaceAttr opts label caption lstRefs' + idxStr <- replaceAttr opts label (lookup "label" attrs) caption lstRefs' let caption' = applyTemplate idxStr caption $ listingTemplate opts return $ Div (label, "listing":classes, []) [ Para caption' @@ -118,10 +119,10 @@ divBlocks (Para (math@(Math DisplayMath _eq):c)) | Just label <- getRefLabel "eq" c = Div (label,[],[]) [Plain [math]] -divBlocks (table@(Table title _align _widths _header _cells)) +divBlocks (Table title align widths header cells) | not $ null title , Just label <- getRefLabel "tbl" [last title] - = Div (label,[],[]) [table] + = Div (label,[],[]) [Table (init title) align widths header cells] divBlocks x = x getRefLabel :: String -> [Inline] -> Maybe String @@ -134,23 +135,24 @@ = init `fmap` stripPrefix "{#" attr getRefLabel _ _ = Nothing -replaceAttr :: Options -> String -> [Inline] -> Accessor References RefMap -> WS [Inline] -replaceAttr o label title prop +replaceAttr :: Options -> String -> Maybe String -> [Inline] -> Accessor References RefMap -> WS [Inline] +replaceAttr o label refLabel title prop = do chap <- take (chapDepth o) `fmap` gets curChap - index <- (1+) `fmap` gets (M.size . M.filter ((==chap) . fst . refIndex) . getProp prop) + i <- (1+) `fmap` gets (M.size . M.filter ((==chap) . init . refIndex) . getProp prop) + let index = chap ++ [(i, refLabel)] modify $ modifyProp prop $ M.insert label RefRec { - refIndex=(chap,index) + refIndex= index , refTitle=normalizeSpaces title } - return $ chapPrefix (chapDelim o) chap index + return $ chapPrefix (chapDelim o) index replaceAttrSec :: String -> [Inline] -> Accessor References RefMap -> WS () replaceAttrSec label title prop = do - chap <- gets curChap + index <- gets curChap modify $ modifyProp prop $ M.insert label RefRec { - refIndex=(init chap,last chap) + refIndex=index , refTitle=normalizeSpaces title } return () diff --git a/src/Text/Pandoc/CrossRef/References/List.hs b/src/Text/Pandoc/CrossRef/References/List.hs --- a/src/Text/Pandoc/CrossRef/References/List.hs +++ b/src/Text/Pandoc/CrossRef/References/List.hs @@ -33,5 +33,5 @@ compare' (_,RefRec{refIndex=i}) (_,RefRec{refIndex=j}) = compare i j item = (:[]) . Plain . refTitle . snd itemChap = Para . uncurry ((. (Space :)) . (++)) . (numWithChap . refIndex &&& refTitle) . snd - numWithChap = uncurry $ chapPrefix (chapDelim opts) + numWithChap = chapPrefix (chapDelim opts) style = (1,DefaultStyle,DefaultDelim) diff --git a/src/Text/Pandoc/CrossRef/References/Refs.hs b/src/Text/Pandoc/CrossRef/References/Refs.hs --- a/src/Text/Pandoc/CrossRef/References/Refs.hs +++ b/src/Text/Pandoc/CrossRef/References/Refs.hs @@ -108,31 +108,35 @@ replaceRefsOther prefix opts cits = do indices <- mapM (getRefIndex prefix) cits let - indices' = groupBy ((==) `on` (fmap fst . fst)) (sort indices) + indices' = groupBy ((==) `on` (fmap init . fst)) (sort indices) cap = maybe False isFirstUpper $ getLabelPrefix . citationId . head $ cits return $ normalizeInlines $ getRefPrefix opts prefix cap (length cits - 1) ++ intercalate [Str ",", Space] (makeIndices opts `map` indices') -getRefIndex :: String -> Citation -> WS (Maybe ([Int], Int), [Inline]) +getRefIndex :: String -> Citation -> WS (Maybe Index, [Inline]) getRefIndex prefix Citation{citationId=cid,citationSuffix=suf} = (\x -> (x,suf)) `fmap` gets (fmap refIndex . M.lookup lab . getProp prop) where prop = lookupUnsafe prefix accMap lab = prefix ++ getLabelWithoutPrefix cid -makeIndices :: Options -> [(Maybe ([Int], Int), [Inline])] -> [Inline] +makeIndices :: Options -> [(Maybe Index, [Inline])] -> [Inline] makeIndices _ s | any (isNothing . fst) s = [Strong [Str "??"]] makeIndices o s = intercalate sep $ reverse $ map f $ foldl' f2 [] $ map (A.first fromJust) $ filter (isJust . fst) s where + f2 :: [[(Index, [Inline])]] -> (Index, [Inline]) -> [[(Index, [Inline])]] f2 [] (i,suf) = [[(i,suf)]] f2 ([]:xs) (i,suf) = [(i,suf)]:xs - f2 l@(x@(((_,hx),sufp):_):xs) (i@(_,ni),suf) + f2 l@(x@((ix,sufp):_):xs) (i,suf) | not (null suf) || not (null sufp) = [(i,suf)]:l | ni-hx == 0 = l -- remove duplicates | ni-hx == 1 = ((i,[]):x):xs -- group sequental | otherwise = [(i,[])]:l -- new group + where + hx = fst $ last ix + ni = fst $ last i f [] = [] -- drop empty lists f [w] = show' w -- single value f [w1,w2] = show' w2 ++ sep ++ show' w1 -- two values f (x:xs) = show' (last xs) ++ rangeDelim o ++ show' x -- shorten more than two values sep = [Str ",", Space] - show' ((c,n),suf) = chapPrefix (chapDelim o) c n ++ suf + show' (i,suf) = chapPrefix (chapDelim o) i ++ suf diff --git a/src/Text/Pandoc/CrossRef/References/Types.hs b/src/Text/Pandoc/CrossRef/References/Types.hs --- a/src/Text/Pandoc/CrossRef/References/Types.hs +++ b/src/Text/Pandoc/CrossRef/References/Types.hs @@ -2,6 +2,7 @@ , WS , RefRec(..) , RefMap + , Index , def ) where @@ -10,7 +11,9 @@ import Control.Monad.State import Data.Default -data RefRec = RefRec { refIndex :: ([Int], Int) +type Index = [(Int, Maybe String)] + +data RefRec = RefRec { refIndex :: Index , refTitle :: [Inline] } deriving (Show, Eq) @@ -22,7 +25,7 @@ , tblRefs :: RefMap , lstRefs :: RefMap , secRefs :: RefMap - , curChap :: [Int] + , curChap :: Index } deriving (Show, Eq) --state monad diff --git a/src/Text/Pandoc/CrossRef/Util/Settings/Gen.hs b/src/Text/Pandoc/CrossRef/Util/Settings/Gen.hs --- a/src/Text/Pandoc/CrossRef/Util/Settings/Gen.hs +++ b/src/Text/Pandoc/CrossRef/Util/Settings/Gen.hs @@ -1,31 +1,61 @@ -{-# LANGUAGE TemplateHaskell #-} - module Text.Pandoc.CrossRef.Util.Settings.Gen where -import Text.Pandoc -import qualified Data.Map as M - import Text.Pandoc.CrossRef.Util.Settings.Template import Text.Pandoc.Builder -$(concat `fmap` mapM genSetting - [ "figureTitle" - , "tableTitle" - , "listingTitle" - , "titleDelim" - , "chapDelim" - , "rangeDelim" - , "figPrefix" - , "eqnPrefix" - , "tblPrefix" - , "lstPrefix" - , "secPrefix" - , "lofTitle" - , "lotTitle" - , "lolTitle" - , "figureTemplate" - , "tableTemplate" - , "listingTemplate" - , "crossrefYaml" - , "chaptersDepth" - ]) +figureTitle :: ToMetaValue a => a -> Meta +figureTitle = template "figureTitle" + +tableTitle :: ToMetaValue a => a -> Meta +tableTitle = template "tableTitle" + +listingTitle :: ToMetaValue a => a -> Meta +listingTitle = template "listingTitle" + +titleDelim :: ToMetaValue a => a -> Meta +titleDelim = template "titleDelim" + +chapDelim :: ToMetaValue a => a -> Meta +chapDelim = template "chapDelim" + +rangeDelim :: ToMetaValue a => a -> Meta +rangeDelim = template "rangeDelim" + +figPrefix :: ToMetaValue a => a -> Meta +figPrefix = template "figPrefix" + +eqnPrefix :: ToMetaValue a => a -> Meta +eqnPrefix = template "eqnPrefix" + +tblPrefix :: ToMetaValue a => a -> Meta +tblPrefix = template "tblPrefix" + +lstPrefix :: ToMetaValue a => a -> Meta +lstPrefix = template "lstPrefix" + +secPrefix :: ToMetaValue a => a -> Meta +secPrefix = template "secPrefix" + +lofTitle :: ToMetaValue a => a -> Meta +lofTitle = template "lofTitle" + +lotTitle :: ToMetaValue a => a -> Meta +lotTitle = template "lotTitle" + +lolTitle :: ToMetaValue a => a -> Meta +lolTitle = template "lolTitle" + +figureTemplate :: ToMetaValue a => a -> Meta +figureTemplate = template "figureTemplate" + +tableTemplate :: ToMetaValue a => a -> Meta +tableTemplate = template "tableTemplate" + +listingTemplate :: ToMetaValue a => a -> Meta +listingTemplate = template "listingTemplate" + +crossrefYaml :: ToMetaValue a => a -> Meta +crossrefYaml = template "crossrefYaml" + +chaptersDepth :: ToMetaValue a => a -> Meta +chaptersDepth = template "chaptersDepth" diff --git a/src/Text/Pandoc/CrossRef/Util/Settings/Template.hs b/src/Text/Pandoc/CrossRef/Util/Settings/Template.hs --- a/src/Text/Pandoc/CrossRef/Util/Settings/Template.hs +++ b/src/Text/Pandoc/CrossRef/Util/Settings/Template.hs @@ -1,20 +1,8 @@ -{-# LANGUAGE QuasiQuotes, TemplateHaskell, RankNTypes, FlexibleInstances #-} module Text.Pandoc.CrossRef.Util.Settings.Template where -import Language.Haskell.TH -import Text.Pandoc +import Text.Pandoc.Definition import Text.Pandoc.Builder +import qualified Data.Map as M -genSetting :: String -> Q [Dec] -genSetting name = do - sig <- [t| forall a. ToMetaValue a => a -> Meta |] - return - [ SigD func sig - , FunD func [Clause [VarP value] (NormalB - (AppE (ConE $ mkName "Meta") - (AppE (AppE (VarE (mkName "M.singleton")) (LitE (StringL name))) - (AppE (VarE (mkName "toMetaValue")) (VarE value)))) - ) []]] - where - func = mkName name - value = mkName "value" +template :: ToMetaValue a => String -> a -> Meta +template name = Meta . M.singleton name . toMetaValue diff --git a/src/Text/Pandoc/CrossRef/Util/Util.hs b/src/Text/Pandoc/CrossRef/Util/Util.hs --- a/src/Text/Pandoc/CrossRef/Util/Util.hs +++ b/src/Text/Pandoc/CrossRef/Util/Util.hs @@ -1,8 +1,10 @@ module Text.Pandoc.CrossRef.Util.Util where +import Text.Pandoc.CrossRef.References.Types import Text.Pandoc.Definition import Data.Char (toUpper, toLower, isUpper) import Data.List (intercalate) +import Data.Maybe (fromMaybe) isFormat :: String -> Maybe Format -> Bool isFormat fmt (Just (Format f)) = takeWhile (`notElem` "+-") f == fmt @@ -20,5 +22,5 @@ isFirstUpper (x:_) = isUpper x isFirstUpper [] = False -chapPrefix :: [Inline] -> [Int] -> Int -> [Inline] -chapPrefix delim chap index = intercalate delim (map (return . Str . show) (chap++[index])) +chapPrefix :: [Inline] -> Index -> [Inline] +chapPrefix delim index = intercalate delim (map (return . Str . uncurry (fromMaybe . show)) index) diff --git a/test-pandoc-crossref.hs b/test-pandoc-crossref.hs --- a/test-pandoc-crossref.hs +++ b/test-pandoc-crossref.hs @@ -48,7 +48,7 @@ testBlocks (section "Section Header" 1 "section") (section "Section Header" 1 "section", def{secRefs=M.fromList $ refRec' "sec:section" 1 "Section Header", - curChap=[1]}) + curChap=[(1,Nothing)]}) describe "References.Refs.replaceRefs" $ do it "References one image" $ @@ -147,13 +147,13 @@ refGen' p l1 l2 = M.fromList $ mconcat $ zipWith refRec''' (((uncapitalizeFirst p++) . show) `map` l1) l2 refRec' :: String -> Int -> String -> [(String, RefRec)] -refRec' ref i tit = [(ref, RefRec{refIndex=([],i),refTitle=toList $ text tit})] +refRec' ref i tit = [(ref, RefRec{refIndex=[(i,Nothing)],refTitle=toList $ text tit})] refRec'' :: String -> Int -> [(String, RefRec)] refRec'' ref i = refRec' ref i [] refRec''' :: String -> (Int, Int) -> [(String, RefRec)] -refRec''' ref (c,i) = [(ref, RefRec{refIndex=([c],i),refTitle=toList $ text []})] +refRec''' ref (c,i) = [(ref, RefRec{refIndex=[(c,Nothing), (i,Nothing)],refTitle=toList $ text []})] testRefs' :: String -> [Int] -> [Int] -> Accessor References (M.Map String RefRec) -> String -> Expectation testRefs' p l1 l2 prop res = testRefs (para $ citeGen p l1) (setProp prop (refGen p l1 l2) def) (para $ text res)