--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/navbar.ur	Tue Apr 26 20:27:04 2011 -0430
@@ -0,0 +1,85 @@
+style active
+style last
+
+datatype navItem = NavItem of string * url
+
+datatype navBar m = NavBar of (list navItem) * (list navItem)
+(* First list is items before the active item, second list is items at and after the active one.
+ * If the second list is non-empty its head is the active item.  Parameter mode is to avoid
+ * double reverses coming from calling printingNavBar. *)
+
+type build = unit
+type print = unit
+
+class mode t = navBar t -> xbody
+
+(* The case of special treatment for the last one seems common in themes. *)
+fun mapXLast [a ::: Type] [ctx ::: {Unit}] (f : a -> bool -> xml ctx [] []) (ls : list a) : (xml ctx [] []) =
+    let
+        fun mapXLast' ls =
+            case ls of
+                [] => <xml/>
+              | x :: [] => <xml>{f x True}</xml>
+              | x :: ls => <xml>{f x False}{mapXLast' ls}</xml>
+    in
+        mapXLast' ls
+    end
+
+fun navItemToXml css (NavItem (text, url)) =
+    case css of
+        None => <xml><a href={url} title={text}>{[text]}</a></xml>
+      | Some cl => <xml><a class={cl} href={url} title={text}>{[text]}</a></xml>
+
+fun navBarToXml' (NavBar (before, after)) =
+    let
+        fun navListToXml checkForLast =
+            mapXLast (fn navItem lst =>
+                         let
+                             val linkXml = navItemToXml None navItem
+                         in
+                             if checkForLast && lst then
+                                 <xml><li class={last}>{linkXml}</li></xml>
+                             else
+                                 <xml><li>{linkXml}</li></xml>
+                         end)
+    in
+        case after of
+            [] => <xml>{navListToXml True before}</xml>
+          | act :: tl =>
+            <xml>
+              {navListToXml False before}
+              {case tl of
+                   [] => <xml><li class={last}>{navItemToXml (Some active) act}</li></xml>
+                 | _ =>
+                   <xml>
+                     <li>{navItemToXml (Some active) act}</li>
+                     {navListToXml True tl}
+                   </xml>}
+            </xml>
+    end
+
+fun printingNavBar (NavBar (before, after)) =
+    NavBar (List.rev before, List.rev after)
+
+fun navBarToXml [t ::: Type] (m : mode t) = m
+
+fun navToXml_build (n : navBar build) : xbody =
+    navBarToXml' (printingNavBar n)
+
+fun navToXml_print (n: navBar print) : xbody =
+    navBarToXml' n
+
+val emptyNavBar = NavBar ([], [])
+
+fun mkNavItem text url =
+    NavItem (text, url)
+
+fun navAdd navItem navBar =
+    case navBar of
+        NavBar (before, []) => NavBar (navItem :: before, [])
+      | NavBar (before, after) => NavBar (before, navItem :: after)
+
+fun navAddActive navItem navBar =
+    case navBar of
+        NavBar (before, []) => NavBar (before, navItem :: [])
+      | NavBar (before, after) => NavBar (List.append after before, navItem :: [])