X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FWiki%2FInterpreter%2FImage.hs;h=00a55de056191ae9fb53b6713907bd2b75bc1b23;hb=fcddebcc3cc02ae8d1904b9338334d538019e74a;hp=97ffc8e1fafebc738a0818af3820548f417ac882;hpb=65c7f9f0643c7e8884e4a02567b77c169167c093;p=Rakka.git
diff --git a/Rakka/Wiki/Interpreter/Image.hs b/Rakka/Wiki/Interpreter/Image.hs
index 97ffc8e..00a55de 100644
--- a/Rakka/Wiki/Interpreter/Image.hs
+++ b/Rakka/Wiki/Interpreter/Image.hs
@@ -3,8 +3,6 @@ module Rakka.Wiki.Interpreter.Image
)
where
-import Control.Monad
-import Data.Maybe
import Network.URI
import Rakka.Page
import Rakka.SystemConfig
@@ -18,6 +16,12 @@ interpreters = [ imageInterp
]
+--
-- 空æååã®å ´åã¯ãªã³ã¯ç¡ã
+
--
--
--
@@ -26,22 +30,30 @@ imageInterp
= InlineCommandInterpreter {
iciName = "img"
, iciInterpret
- = \ ctx (InlineCommand _ attrs inside) ->
+ = \ ctx (InlineCommand _ attrs _) ->
do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
- let pageName = case lookup "src" attrs of
+ let name = case lookup "src" attrs of
Just x -> x
Nothing -> error "\"src\" attribute is missing"
- hrefAttr = ("href", uriToString id (mkPageURI baseURI pageName) "")
+ 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]
-
- return (Anchor anchorAttrs [Image (Right pageName) alt])
+ 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
}
@@ -63,20 +75,28 @@ imgFrameInterp
= \ ctx (BlockCommand _ attrs inside) ->
do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
- let pageName = case lookup "src" attrs of
+ let name = case lookup "src" attrs of
Just x -> x
Nothing -> error "\"src\" attribute is missing"
- hrefAttr = ("href", uriToString id (mkPageURI baseURI pageName) "")
+ 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]
[ Block (Div [("class", "imageData")]
- [ Inline (Anchor [hrefAttr]
- [ Image (Right pageName) Nothing ]) ])
+ [ Inline image ])
, Block (Div [("class", "imageCaption")]
[ Block x | x <- inside ])
]