X-Git-Url: http://git.megacz.com/?p=wix.git;a=blobdiff_plain;f=src%2FHtml.lhs;h=a3ff54f19c3f0780bf5debf114110aa991bc5a5e;hp=e244bca664128e32a4363ff54af6af11ca82a5f5;hb=78e11871be7fa7677a0e3822b6e08b3beca1c4b7;hpb=3c96b1336f651fa3689e975f4793b55c43591d21 diff --git a/src/Html.lhs b/src/Html.lhs index e244bca..a3ff54f 100644 --- a/src/Html.lhs +++ b/src/Html.lhs @@ -1,7 +1,11 @@ \begin{code} +-- Copyright 2008 the Contributors, as shown in the revision logs. +-- Licensed under the Apache Public Source License 2.0 ("the License"). +-- You may not use this file except in compliance with the License. + module Html where -import SBP +import Edu_Berkeley_Sbp_Haskell_SBP import FromTree import Doc import List(isSuffixOf,isPrefixOf) @@ -27,7 +31,7 @@ style = " LI { margin-top: 5px; }\n"++ " body { color: #333333; }\n"++ " blockquote { font-style: italic; width: 100% }\n"++ - " div.warn { border: 1px solid red; background-color: #fbb; color: white; }\n"++ + " div.warn { border: 1px solid #f44; border-top: 5px solid #f44; background-color: #fbb; color: white; }\n"++ " td.warn { color: black; }\n"++ " div.announce { border: 1px solid green; background-color: #bfb; color: white; }\n"++ " td.announce { color: black; }\n"++ @@ -43,18 +47,18 @@ style = " a:hover { text-decoration: none; border-bottom:1px solid; }\n"++ " table.footer { border-top: silver solid 1px; }\n"++ " span.signature { color: #bbb; }\n"++ - " .signature a:link { color: #bbb; }\n"++ - " .signature a:visited { color: #bbb; }\n"++ + " .signature a:link { color: #aaf; }\n"++ + " .signature a:visited { color: #faa; }\n"++ " .signature a:hover { color: blue; border-bottom: 1px solid blue; }\n"++ " span.highlight { background: yellow; color: black; padding: 3px }\n"++ " div.pre {\n"++ " text-align: left;\n"++ " font-family: monospace;\n"++ - " border-style: solid;\n"++ + " border-style: none;\n"++ " border-width: 2px 2px 2px 2px;\n"++ " border-color: #6666aa;\n"++ " color: #FFFFFF;\n"++ - " background-color: #000000;\n"++ + " background-color: #333333;\n"++ " margin-right: 25px;\n"++ " margin-left: 25px;\n"++ " padding: 10px;\n"++ @@ -83,13 +87,81 @@ instance ToHtml Doc where (toHtml secs) ++ "

\n"++ ""++ + ""++ "\n"++ "\n"++ "" +quoteIconBase64 = + "data:image/png;base64," + ++"iVBORw0KGgoAAAANSUhEUgAAABAAAAAVCAYAAABPPm7SAAAABmJLR0QA/wD/AP+gvaeTAAAA" + ++"CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1wQPAx0rP5obpAAAAWJJREFUOMvdlKFvg0AU" + ++"xr8tVZ1cbU+04lUuwc2WypMX9AxiomoJ/RNYqmaaYKpb5kBys1UkWBCdKLqVs8zwFnrQmYol" + ++"+xLC8X55H/e+wAENhWGoPM/zT6eThQ4lSWJf5EEQuAAqAJXv+95vXCkVtpwZuq4bmM1pmlrM" + ++"LctKWzuwbTsBUNX3lph3Njfd6/WZ9vv9iHkYhsrkPa21zQ9aa9v3fRsAFovFK9cMPgIApdT7" + ++"eDz+RB1Y1XEBwEVe54ZbXKm/N7haNwCQ5zmtVqtnE0op49lspgFgPp+/dfF/EGIPAAaDgZBS" + ++"xgBwPB7vd7vdIwD0+/2v5ry8juNYmgY/P1GWZQ9sQER3XOcwD4fDkA2IqGiNwN8+ERVNY/Pt" + ++"RFQIIcozg+Vy+VKW5dDcMmuz2ThFURAATKfTj7MQ1+v1Ezc7jrMVQpTmocOjOY6znUwmRSvR" + ++"KIpknud0KfEoimSWZQ/N2jfhtb1AvGklDQAAAABJRU5ErkJggg==" + +warnIconBase64 = + "data:image/png;base64," + ++"iVBORw0KGgoAAAANSUhEUgAAABQAAAAREAYAAACN1FD9AAAABmJLR0QA/wD/AP+gvaeTAAAA" + ++"CXBIWXMAAABIAAAASABGyWs+AAAACXZwQWcAAAAUAAAAEQDeTN6UAAAD/ElEQVRIx8WUbUyV" + ++"ZRjHf+chxDi8yZcDa0mKh/wSuNE5eNYHZBiRwoespayEkdgx22hmjB1glTlenDYlMccAX1cb" + ++"CDFlg+aQ1JGEazGWpixdbbweDucctPF2PNxXX3pw00gL09+X59m1+77+v+d+nueCBRJ+ECAs" + ++"78dnAPp2nLEDtMdpPwMYZhfaf8GU1gLsixwdBRDRr7lRAHmxT0zs+UKAuKmhXgDfGleAYZVh" + ++"lXynC/Z1AYyeX+IFiLjw+MwWAxDQuBqgNVsX+iNta/nWcnV0vD+9Ir1CndDre68AfDH42PzW" + ++"2QDW79UFxkxh6WHp8o5a5lznXCfJ/nPX867nSYArO7AssEyOjOwE8GfGZwC84Pu3edrDLgzK" + ++"AFj06q7DAPt/1evBK4szizMlpXy4tqO2g/MHa9sm2ibwP23M78zvFE0rBAg4U24DqFpieAqA" + ++"6kd+cjuiAAqu6Sfn/n55/fJ6CZOc6YHpATmkNWgNWoOIZtSMmlFE1d9ae2utvDt21ZRiSpHV" + ++"+r43LwFkBT4ysehigKgDvxcC3P5QD5qxNtU11anj8hfhg+GD4YMixipjlbFK5pjyHok8Enn3" + ++"m7yyG2DAEdIFYLy9YMHDLoBjK/WA8fhkb7JXtcqMnJbT4tJFYlpiWmJaRKJio2KjYu8KSp9K" + ++"UAly2ZtpSbWkql/0PrsuAJR3/2cx65cA1qujRgBV6HpWy9fy5dydOz2JPYlqQO4hwZ/gT/CL" + ++"mB1mh9kh93Enq2tP1x7V4wo0pBnS5KehVwBmPjA7AcxtDy2mBQIYPmk/B/CDb26MxGw5teWU" + ++"+krmIdWaak21iiR2JHYkdsi83G7KtmRb1HG9b+PHAK2lJAEQ9EDBt88C5BybGyOLQgtCC8Su" + ++"gkesI1axzRd8Mvdk7slckeoN1RuqN8wvODsyVDNUIxaXP0SFKHlfz8l4GSDTfd+B6Tdh5QCh" + ++"hUUvAlR8o9eDI4qSipLkJcOEqdvUzaX5HmzSNGmaNMFN+037TTvgxInzb96QKTovOo/LRmuJ" + ++"r8QnFr3+2esAB/IX9wAEjd+3cfc+gD2euTFSv2zzss0SIdnTG6c3SqU8AFulrdJWKRJSElIS" + ++"UiLia/Y1+5r/YcNHM9tntku1e2KFZ4VHAvXcwnyAksY5MfNvAOYdQ+8BzHytL5warDtRd2I2" + ++"QjWNh46HqjR11LvGu0aVqUOei56LYlD7PRWeCmlWpe4p95R87h66Yb9hV+7+o71BvUHKoWyj" + ++"jlGHSlbPOTc5N6kkFTqybWSbeksxfHb4rGqd9Q3nDOdI5lRHTXtNu6rWc/vfAJjoXHoNYOl6" + ++"Q70CaFEpYwAZhof+m/5nvv0UoDFLW/UagCXuSQvdSzwAiTv/BGXg1AxNKyCeAAAAAElFTkSu" + ++"QmCC" + +printIconBase64 = + "data:image/png;base64," + ++"iVBORw0KGgoAAAANSUhEUgAAAA8AAAAOCAMAAADHVLbdAAAALHRFWHRDcmVhdGlvbiBUaW1l" + ++"AEZyaSAxOSBTZXAgMjAwMyAxODozOTozMiAtMDAwME2jAt8AAAAHdElNRQfTCRMRKABXeznM" + ++"AAAACXBIWXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAACRQTFRF////AAAA7+/v" + ++"3t7ezs7OtbW1ra2tlJSUnJycEBAQKSkphISEbGtEogAAAAF0Uk5TAEDm2GYAAABLSURBVHja" + ++"nY1BEsAgCAMDKm31//81qB3l6h4Y4mYQQNvAmXNv7W/gytcTRj6pppQHNWoW6JWS13Ix86yr" + ++"O7MEPkDWuWLPK/7hoYEOxksDsk8eppEAAAAASUVORK5CYII=" + + +emailIconBase64 = + "data:image/png;base64," + ++"iVBORw0KGgoAAAANSUhEUgAAABUAAAAOCAMAAAD32Kf8AAAALHRFWHRDcmVhdGlvbiBUaW1l" + ++"AEZyaSAxOSBTZXAgMjAwMyAxODo0MjowOSAtMDAwMBDwv7IAAAAHdElNRQfTCRMRKhqYL6I0" + ++"AAAACXBIWXMAAAsSAAALEgHS3X78AAAABGdBTUEAALGPC/xhBQAAADBQTFRF////AAAAhISE" + ++"9/fv9/f3////CAgI7+/v1tbOxsa9tbWtpaWclJSMlJSUe3t7a2trxDv8WgAAAAF0Uk5TAEDm" + ++"2GYAAABiSURBVHjabc9JEoAgDETRpNOKs/e/rSEYF8jfhHpQFAi6JHpHBg5VOdIj+KeXkgO9" + ++"tUj/Bldo3WdRnktt3fbjgoWKK5EKsunkyryCn86Oxsj/UZqKEkFmNF+mvieFdSK16wFr7QK5" + ++"tASqkwAAAABJRU5ErkJggg==" + +pdfIconBase64 = + "data:image/png;base64," + ++"iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAMAAAAoLQ9TAAAAK3RFWHRDcmVhdGlvbiBUaW1l" + ++"AFRodSA2IE5vdiAyMDAzIDE1OjMwOjAwIC0wMDAwSwt8PwAAAAd0SU1FB9MLBg8fD1x8/t4A" + ++"AAAJcEhZcwAACxIAAAsSAdLdfvwAAAAEZ0FNQQAAsY8L/GEFAAAAQlBMVEX///9zc3Nra2uE" + ++"hITGxsaUlJScnJx7e3uMjIz////39/fv7+/n5+fe3t69vb1jY2OlpaXW1ta1tbVaWlqtra3O" + ++"zs5w48BYAAAAAXRSTlMAQObYZgAAAIdJREFUeNpNz1ESBBEMBNCRwSCJMOT+V10WW9vKz6uO" + ++"iusa0R137ShxjImwHsnSMCbEX6dPiIje+SUKC6hav8CbAQlZD/RmJ1Tdz6oTwETMfAByK0hT" + ++"1kgH7E1phFfjdvS2JlJpN8RAyEHMhgJgaexJTBPyA1JiGoD0BXgg2H8wcFs3/jDvPB+sOwir" + ++"+o6iKQAAAABJRU5ErkJggg==" + instance ToHtml Section where toHtml (Section level header paragraphs) = "\n\n"++ @@ -101,7 +173,7 @@ tag t body = "<"++t++">"++body++"" instance ToHtml Paragraph where toHtml (Blockquote t) = "\n\n" - ++"\n" + ++"\n" ++"
\n" ++(toHtml t) ++"
\n" @@ -111,10 +183,11 @@ instance ToHtml Paragraph where toHtml (P t) = stag "p" $ toHtml t -link ref body = ""++icon++body++"" +link ref body = ""++icon++body++"" where - icon = if ".pdf" `isSuffixOf` ref then " " - else if "mailto:" `isPrefixOf` ref then " " + urlify = toHtml + icon = if ".pdf" `isSuffixOf` ref then " " + else if "mailto:" `isPrefixOf` ref then " " else "" img = "style='vertical-align: text-bottom;' border=0 " -- margin-bottom: -2px; padding-bottom: 2px; border-bottom: 1px blue solid; @@ -127,6 +200,7 @@ instance ToHtml Text where toHtml (Quotes x) = "“"++(toHtml x)++"”" toHtml (Verbatim x) = pre x toHtml (Link t ref) = link (show ref) (toHtml t) + toHtml (Command "comment" y) = "" toHtml (Command "url" y) = ""++(link (toHtml y) (toHtml y))++"" toHtml (Command "WiX" y) = "WIX" toHtml (Command "TeX" y) = "TEX" @@ -163,10 +237,12 @@ instance ToHtml Text where toHtml (Command "green" y) = ""++(toHtml y)++"" toHtml (Command "sc" y) = ""++(toHtml y)++"" toHtml (Command "image" y) = "" + toHtml (Command "imagec" y) = "
" + toHtml (Command "image2" y) = "" toHtml (Command "image3" y) = "" toHtml (Command "image4" y) = "
" toHtml (Command "warn" y) = "\n
\n\n" - ++"\n" + ++"\n" ++"
\n" ++(toHtml y) ++"
\n" @@ -178,7 +254,13 @@ instance ToHtml Text where toHtml (Command "br" _) = "\n
\n" toHtml (Command "cent" _) = "½" toHtml (Command "euro" _) = "€" - toHtml (Command "ordinal" x) = (toHtml x)++""++"th"++"" + + -- gross hack + toHtml (Command "ordinal" x) | (last (toHtml x) == '1') = (toHtml x)++""++"st"++"" + | (last (toHtml x) == '2') = (toHtml x)++""++"nd"++"" + | (last (toHtml x) == '3') = (toHtml x)++""++"rd"++"" + | otherwise = (toHtml x)++""++"th"++"" + -- FIXME: use "unicode vulgar fractions" here toHtml (Command "fraction" [n,d]) = ""++(toHtml n)++""++"/"++""++(toHtml d)++"" toHtml (Command "rfc" x) = "RFC"++(toHtml x)++"" @@ -193,7 +275,7 @@ instance ToHtml Text where toHtml (GlyphText TradeMark) = "™" toHtml (GlyphText ServiceMark) = "™" toHtml (GlyphText Emdash) = "—" - toHtml (GlyphText Ellipsis) = "…" + toHtml (GlyphText Ellipsis) = "…" -- &cdots;? toHtml (GlyphText Cent) = "½" toHtml (GlyphText Daggar) = "†" toHtml (GlyphText DoubleDaggar) = "‡" @@ -203,7 +285,8 @@ instance ToHtml Text where toHtml (GlyphText Sharp) = "⋘" toHtml (GlyphText CheckMark) = "✓" toHtml (GlyphText XMark) = "✗" - toHtml (GlyphText LeftArrow) = "&#;" -- FIXME + toHtml (GlyphText LeftArrow) = "←" + toHtml (GlyphText RightArrow) = "→" toHtml (GlyphText DoubleLeftArrow) = "&#;" -- FIXME toHtml (GlyphText DoubleRightArrow) = "&#;" -- FIXME toHtml (GlyphText DoubleLeftRightArrow) = "&#;" -- FIXME @@ -223,18 +306,18 @@ instance ToHtml Text where instance ToHtml String where toHtml s = concatMap htmlEscapeChar s - where - htmlEscapeChar '<' = "<" - htmlEscapeChar '>' = ">" - htmlEscapeChar '&' = "&" - htmlEscapeChar '\'' = "'" - htmlEscapeChar '\"' = """ - htmlEscapeChar c = [c] - -pre x = "\n
"++ (pre' x) ++ "\n
\n" + +htmlEscapeChar '<' = "<" +htmlEscapeChar '>' = ">" +htmlEscapeChar '&' = "&" +htmlEscapeChar '\'' = "'" +htmlEscapeChar '\"' = """ +htmlEscapeChar c = [c] + +pre x = "\n
"++ (pre' x) ++ "\n
\n" where pre' (' ':b) = " "++(pre' b) pre' ('\n':b) = "
\n"++(pre' b) - pre' (a:b) = a:(pre' b) + pre' (a:b) = (htmlEscapeChar a)++(pre' b) pre' [] = [] \end{code}