Mercurial > urweb

comparison src/monoize.sml @ 606:5145181b02fa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use normal fields of ctextboxes
author Adam Chlipala <adamc@hcoop.net>
date Tue, 27 Jan 2009 09:53:51 -0500
parents b1064de2b1f9
children 0dd40b6bfdf3
comparison
equal deleted inserted replaced
605:1a9171e31fd1 606:5145181b02fa
1775 val (attrs, fm) = monoExp (env, st, fm) attrs 1775 val (attrs, fm) = monoExp (env, st, fm) attrs
1776 val attrs = case #1 attrs of 1776 val attrs = case #1 attrs of
1777 L'.ERecord xes => xes 1777 L'.ERecord xes => xes
1778 | _ => raise Fail "Non-record attributes!" 1778 | _ => raise Fail "Non-record attributes!"
1779 1779
1780 fun lowercaseFirst "" = ""
1781 | lowercaseFirst s = String.str (Char.toLower (String.sub (s, 0)))
1782 ^ String.extract (s, 1, NONE)
1783
1780 fun tagStart tag = 1784 fun tagStart tag =
1781 let 1785 let
1782 fun lowercaseFirst "" = ""
1783 | lowercaseFirst s = String.str (Char.toLower (String.sub (s, 0)))
1784 ^ String.extract (s, 1, NONE)
1785
1786 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc) 1786 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
1787 in 1787 in
1788 foldl (fn (("Action", _, _), acc) => acc 1788 foldl (fn (("Action", _, _), acc) => acc
1789 | (("Source", _, _), acc) => acc 1789 | (("Source", _, _), acc) => acc
1790 | ((x, e, t), (s, fm)) => 1790 | ((x, e, t), (s, fm)) =>
1895 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc), fm) 1895 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc), fm)
1896 else 1896 else
1897 normal () 1897 normal ()
1898 | _ => normal () 1898 | _ => normal ()
1899 end 1899 end
1900
1901 fun setAttrs jexp =
1902 let
1903 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
1904
1905 val assgns = List.mapPartial
1906 (fn ("Source", _, _) => NONE
1907 | (x, e, _) =>
1908 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "="),
1909 (L'.EJavaScript (L'.Script, e, NONE), loc),
1910 str ";"]))
1911 attrs
1912 in
1913 case assgns of
1914 [] => jexp
1915 | _ => strcat (str "var d="
1916 :: jexp
1917 :: str ";"
1918 :: assgns)
1919 end
1900 in 1920 in
1901 case tag of 1921 case tag of
1902 "body" => normal ("body", NONE, 1922 "body" => normal ("body", NONE,
1903 SOME (L'.EStrcat ((L'.EPrim (Prim.String "<script src=\"/app.js\"></script>"), loc), 1923 SOME (L'.EStrcat ((L'.EPrim (Prim.String "<script src=\"/app.js\"></script>"), loc),
1904 (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), 1924 (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]),
2000 ((L'.EStrcat (ts, 2020 ((L'.EStrcat (ts,
2001 (L'.EPrim (Prim.String "/>"), loc)), 2021 (L'.EPrim (Prim.String "/>"), loc)),
2002 loc), fm) 2022 loc), fm)
2003 end 2023 end
2004 | SOME (_, src, _) => 2024 | SOME (_, src, _) =>
2005 (strcat [str "<script type=\"text/javascript\">inp(\"input\",", 2025 let
2006 (L'.EJavaScript (L'.Script, src, NONE), loc), 2026 val sc = strcat [str "inp(\"input\",",
2007 str ")</script>"], 2027 (L'.EJavaScript (L'.Script, src, NONE), loc),
2008 fm)) 2028 str ")"]
2009 2029 val sc = setAttrs sc
2010 | "option" => normal ("option", NONE, NONE) 2030 in
2031 (strcat [str "<script type=\"text/javascript\">",
2032 sc,
2033 str "</script>"],
2034 fm)
2035 end)
2011 2036
2012 | "tabl" => normal ("table", NONE, NONE) 2037 | "tabl" => normal ("table", NONE, NONE)
2013 | _ => normal (tag, NONE, NONE) 2038 | _ => normal (tag, NONE, NONE)
2014 end 2039 end
2015 2040