Manual merge of old patch:

Sat Apr 21 04:36:43 CEST 2007  Roberto Zunino <zunrob@users.sf.net>
  * URL expansion for %%, %L, %{LINE}

3 files changed, 28 insertions, 8 deletions

diff --git a/doc/haddock.xml b/doc/haddock.xml
index c36b707b..2328bf13 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -512,6 +512,17 @@
 	      '<literal>v</literal>' or a type '<literal>t</literal>'. This is
 	      only valid for the <option>--source-entity</option> option.</para>
 	    </listitem>
+	    <listitem>
+	      <para>The string <literal>%L</literal> or <literal>%{LINE}</literal>
+	      is replaced by the number of the line where the exported value or
+	      type is defined. This is only valid for the
+	      <option>--source-entity</option> option.</para>
+	    </listitem>
+	    <listitem>
+	      <para>The string <literal>%%</literal> is replaced by
+	      <literal>%</literal>.</para>
+      </listitem>
+
 	  </itemizedlist>
 
 	  <para>For example, if your sources are online under some directory,
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 52a80096..bf0a9dd0 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -157,14 +157,15 @@ srcButton (Just src_base_url, _, _) Nothing =
 
 srcButton (_, Just src_module_url, _) (Just iface) =
   let url = spliceURL (Just $ ifaceOrigFilename iface)
-                      (Just $ ifaceMod iface) Nothing src_module_url
+                      (Just $ ifaceMod iface) Nothing Nothing src_module_url
    in topButBox (anchor ! [href url] << toHtml "Source code")
 
 srcButton _ _ =
   Html.emptyTable
  
-spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> String -> String
-spliceURL maybe_file maybe_mod maybe_name url = run url
+spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> 
+             Maybe SrcSpan -> String -> String
+spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url
  where
   file = fromMaybe "" maybe_file
   mod = case maybe_mod of
@@ -177,11 +178,17 @@ spliceURL maybe_file maybe_mod maybe_name url = run url
       Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v")
              | otherwise -> (escapeStr (getOccString n), "t")
 
+  line = case maybe_loc of
+    Nothing -> ""
+    Just span -> show $ srcSpanStartLine span
+
   run "" = ""
   run ('%':'M':rest) = mod ++ run rest
   run ('%':'F':rest) = file ++ run rest
   run ('%':'N':rest) = name ++ run rest
   run ('%':'K':rest) = kind ++ run rest
+  run ('%':'L':rest) = line ++ run rest
+  run ('%':'%':rest) = "%" ++ run rest
 
   run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mod ++ run rest
   run ('%':'{':'F':'I':'L':'E':'}':rest)         = file ++ run rest
@@ -194,6 +201,8 @@ spliceURL maybe_file maybe_mod maybe_name url = run url
   run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) =
     map (\x -> if x == '/' then c else x) file ++ run rest
 
+  run ('%':'{':'L':'I':'N':'E':'}':rest)         = line ++ run rest
+
   run (c:rest) = c : run rest
   
 wikiButton :: WikiURLs -> Maybe Module -> HtmlTable
@@ -201,7 +210,7 @@ wikiButton (Just wiki_base_url, _, _) Nothing =
   topButBox (anchor ! [href wiki_base_url] << toHtml "User Comments")
 
 wikiButton (_, Just wiki_module_url, _) (Just mod) =
-  let url = spliceURL Nothing (Just mod) Nothing wiki_module_url
+  let url = spliceURL Nothing (Just mod) Nothing Nothing wiki_module_url
    in topButBox (anchor ! [href url] << toHtml "User Comments")
 
 wikiButton _ _ =
@@ -1433,14 +1442,14 @@ topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface)
             Nothing  -> Html.emptyTable
             Just url -> tda [theclass "declbut"] <<
                           let url' = spliceURL (Just fname) (Just mod)
-                                               (Just name) url
+                                               (Just name) (Just loc) url
                            in anchor ! [href url'] << toHtml "Source"
         wikiLink =
           case maybe_wiki_url of
             Nothing  -> Html.emptyTable
             Just url -> tda [theclass "declbut"] <<
                           let url' = spliceURL (Just fname) (Just mod)
-                                               (Just name) url
+                                               (Just name) (Just loc) url
                            in anchor ! [href url'] << toHtml "Comments"
   
         mod = ifaceMod iface
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 9770f37d..5b710c1f 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -115,13 +115,13 @@ options backwardsCompat =
         (ReqArg Flag_SourceModuleURL "URL")
 	"URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)",
     Option []  ["source-entity"]  (ReqArg Flag_SourceEntityURL "URL") 
-	"URL for a source code link for each entity\n(using the %{FILE}, %{MODULE} or %{NAME} vars)",
+  "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
     Option []  ["comments-base"]   (ReqArg Flag_WikiBaseURL "URL")
 	"URL for a comments link on the contents\nand index pages",
     Option []  ["comments-module"]  (ReqArg Flag_WikiModuleURL "URL") 
 	"URL for a comments link for each module\n(using the %{MODULE} var)",
     Option []  ["comments-entity"]  (ReqArg Flag_WikiEntityURL "URL") 
-	"URL for a comments link for each entity\n(using the %{FILE}, %{MODULE} or %{NAME} vars)",
+  "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)",
     Option ['c']  ["css"]         (ReqArg Flag_CSS "FILE") 
 	"the CSS file to use for HTML output",
     Option ['p']  ["prologue"] (ReqArg Flag_Prologue "FILE")