view datebox.ur @ 33:2e7f8f7d71d4

Update for Ur/Web's new tag name resolution
author Adam Chlipala <adam@chlipala.net>
date Thu, 21 Nov 2013 16:12:17 -0500
parents b5432d74841a
children
line wrap: on
line source
type t = {Cal : Calendar.t,
          Panel : TogglePanel.togglePanel Calendar.t body'}

type date = Calendar.date
val date_eq = Calendar.date_eq
val date_ord = Calendar.date_ord
val time = Calendar.time
val date = Calendar.date

val format : TogglePanel.formatCtl body' = fn [[Dyn] ~ body'] =>
    TogglePanel.defaultFormat
        -- #OpenCtl -- #CloseCtl
        ++ {OpenCtl = fn behaviour => <xml><button value="Choose" onclick={fn _ => behaviour}/></xml>,
            CloseCtl = fn behaviour => <xml><button value="Hide" onclick={fn _ => behaviour}/></xml>}

fun create tm =
    cal <- Calendar.create tm;
    panel <- TogglePanel.create @format cal False;

    return {Cal = cal,
            Panel = panel}

fun onChange db f =
    Calendar.onChange db.Cal f

fun set db day =
    Calendar.set db.Cal day

fun value db = Calendar.value db.Cal

val gui_t = Gui.mkGui (fn [[Dyn] ~ body'] db =>
    <xml>
      <dyn signal={date <- Calendar.value db.Cal;
                   return <xml>{[date.Year]}-{[date.Month]}-{[date.Day]}</xml>}/>
      {Gui.toXml db.Panel}
    </xml>)