]
+-- <img src="[PageName]"
+-- alt="[Alternative]" -- 省略可能
+-- link="[PageName]" -- 省略可能、省略時は画像そのものへのリンク
+-- link="[Absolute URI]" -- 絶對 URI の場合はその URI へのリンク
+-- link="" /> -- 空文字列の場合はリンク無し
+
-- <a href="..." class="inlineImage ...">
-- <img src="..." alt="..." />
-- </a>
= InlineCommandInterpreter {
iciName = "img"
, iciInterpret
- = \ ctx (InlineCommand _ attrs inside) ->
- do BaseURI baseURI <- getSysConf (ctxSysConf ctx) (BaseURI undefined)
-
- let pageName = lookup "src" attrs
- when (pageName == Nothing)
- $ fail "\"src\" attribute is missing"
+ = \ ctx (InlineCommand _ attrs _) ->
+ do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
- let hrefAttr = ("href", uriToString id (mkPageURI baseURI (fromJust pageName)) "")
- srcAttr = ("src" , uriToString id (mkObjectURI baseURI (fromJust pageName)) "")
- altAttr = do alt <- lookup "alt" attrs
- return ("alt", alt)
+ let name = case lookup "src" attrs of
+ Just x -> x
+ Nothing -> error "\"src\" attribute is missing"
+ link = case lookup "link" attrs of
+ Just "" -> Nothing
+ Just x -> if isURI x then
+ Just x
+ else
+ Just (uriToString id (mkPageURI baseURI x) "")
+ Nothing -> Just (uriToString id (mkPageURI baseURI name) "")
+ alt = lookup "alt" attrs
classAttr = case lookup "float" attrs of
- Nothing -> ("class", "inlineImage")
- Just "left" -> ("class", "inlineImage leftFloat")
- Just "right" -> ("class", "inlineImage rightFloat")
+ Nothing -> "inlineImage"
+ Just "left" -> "inlineImage leftFloat"
+ Just "right" -> "inlineImage rightFloat"
Just others -> error ("unknown \"float\" attribute: " ++ others)
- anchorAttrs = [hrefAttr, classAttr]
- imgAttrs = catMaybes [Just srcAttr, altAttr]
-
- return (Anchor anchorAttrs [Image imgAttrs])
+ result = case link of
+ Nothing -> Span [("class", classAttr)] [Image (Right name) alt]
+ Just x -> Anchor [ ("class", classAttr)
+ , ("href" , x ) ] [Image (Right name) alt]
+ return result
}
-- <div class="imageFrame ...">
-- <div class="imageData">
--- <p>
--- <a href="...">
--- <img src="..." />
--- </a>
--- </p>
+-- <a href="...">
+-- <img src="..." />
+-- </a>
-- </div>
-- <div class="imageCaption">
-- ...
bciName = "imgframe"
, bciInterpret
= \ ctx (BlockCommand _ attrs inside) ->
- do BaseURI baseURI <- getSysConf (ctxSysConf ctx) (BaseURI undefined)
-
- let pageName = lookup "src" attrs
- when (pageName == Nothing)
- $ fail "\"src\" attribute is missing"
+ do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
- let hrefAttr = ("href", uriToString id (mkPageURI baseURI (fromJust pageName)) "")
- srcAttr = ("src" , uriToString id (mkObjectURI baseURI (fromJust pageName)) "")
+ let name = case lookup "src" attrs of
+ Just x -> x
+ Nothing -> error "\"src\" attribute is missing"
+ link = case lookup "link" attrs of
+ Just "" -> Nothing
+ Just x -> if isURI x then
+ Just x
+ else
+ Just (uriToString id (mkPageURI baseURI x) "")
+ Nothing -> Just (uriToString id (mkPageURI baseURI name) "")
classAttr = case lookup "float" attrs of
Nothing -> ("class", "imageFrame")
Just "left" -> ("class", "imageFrame leftFloat")
Just "right" -> ("class", "imageFrame rightFloat")
Just others -> error ("unknown \"float\" attribute: " ++ others)
+ image = case link of
+ Nothing -> Image (Right name) Nothing
+ Just x -> Anchor [("href" , x)] [Image (Right name) Nothing]
return (Div [classAttr]
- [ Div [("class", "imageData")]
- [ Paragraph [ Anchor [hrefAttr]
- [ Image [srcAttr] ] ]
- ]
- , Div [("class", "imageCaption")] inside
+ [ Block (Div [("class", "imageData")]
+ [ Inline image ])
+ , Block (Div [("class", "imageCaption")]
+ [ Block x | x <- inside ])
]
)
}