From: pho <pho@cielonegro.org>
Date: Tue, 25 Mar 2008 03:03:22 +0000 (+0900)
Subject: More flexible <img> and <imgsrc> command
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=commitdiff_plain;h=d72f26d01168e88e6afa1d00bcda8a0f81e9a91d

More flexible <img> and <imgsrc> command

darcs-hash:20080325030322-62b54-1e0dfe9d908aa9e74a5492382af1e2598aa4cb18.gz
---

diff --git a/Rakka/Wiki/Interpreter/Image.hs b/Rakka/Wiki/Interpreter/Image.hs
index 9b6ff74..80cd6c3 100644
--- a/Rakka/Wiki/Interpreter/Image.hs
+++ b/Rakka/Wiki/Interpreter/Image.hs
@@ -18,6 +18,12 @@ interpreters = [ imageInterp
                ]
 
 
+-- <img src="[PageName]"
+--      alt="[Alternative]"   -- 省略可能
+--      link="[PageName]"     -- 省略可能、省略時は画像そのものへのリンク
+--      link="[Absolute URI]" -- 絶對 URI の場合はその URI へのリンク
+--      link="" />            -- 空文字列の場合はリンク無し
+
 -- <a href="..." class="inlineImage ...">
 --   <img src="..." alt="..." />
 -- </a>
@@ -32,16 +38,24 @@ imageInterp
                let name        = case lookup "src" attrs of
                                    Just x  -> x
                                    Nothing -> error "\"src\" attribute is missing"
-                   hrefAttr    = ("href", uriToString id (mkPageURI baseURI name) "")
+                   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 name) 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
       }
 
 
@@ -66,17 +80,25 @@ imgFrameInterp
                let name        = case lookup "src" attrs of
                                    Just x  -> x
                                    Nothing -> error "\"src\" attribute is missing"
-                   hrefAttr    = ("href", uriToString id (mkPageURI baseURI name) "")
+                   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 name) Nothing ]) ])
+                                        [ Inline image ])
                        , Block (Div [("class", "imageCaption")]
                                         [ Block x | x <- inside ])
                        ]