clock weekday conversion toy

This is a little toy I knocked together for converting "nornal" yyyy-mm-dd dates into ISO8601 weeks, and back. It's not quite the one-liner I hoped, mostly because clock scan doesn't guess when you omit fields, and the %G specifier eluded me until I was informed of it by helpful chatters.

With a little work it could be extended to more date formats, perhaps even user-specified (though the defaults for omitted fields could get tricky).

  # weekdate.tcl
  package require Tk

  proc default {_arg default} {
      upvar 1 $_arg arg
      if {"" eq $arg} {set arg $default}
  }

  proc yearfix {y} {
      set thisyear [scan [clock format [clock scan now] -format %y] %d]
      set thiscent [scan [clock format [clock scan now] -format %C] %d]
      if {$y < ($thisyear+10)} {
          return [expr {100*$thiscent+$y}]
      } elseif {$y < 100} {
          return [expr {100*($thiscent-1)+$y}]
      }
  }

  set weekly_f "%Gw%V %a"

  proc weekly_do {} {
      lassign $::weekly yw d
      lassign [scan $yw %dw%d] y w
      default w 1
      default d Mon
      set y [yearfix $y]
      set ::weekly "${y}w$w $d"
      set ::normal [clock format [clock scan $::weekly -format $::weekly_f] -format $::normal_f]
  }

  set normal_f "%Y-%m-%d"

  proc normal_do {} {
      lassign [scan $::normal %d-%d-%d] y m d
      default m 1
      default d 1
      set y [yearfix $y]
      set ::normal "$y-$m-$d"
      set ::weekly [clock format [clock scan $::normal -format $::normal_f] -format $::weekly_f]
  }

  wm title . "Date converter"
  label .instr -text "Press enter to convert"
  label .normal_l -text "eg. [clock format [clock scan now] -format $normal_f]"
  entry .normal -textvar normal -width 10
  label .weekly_l -text "eg. [clock format [clock scan now] -format $weekly_f]"
  entry .weekly -textvar weekly -width 11
  bind .normal <Return> normal_do
  bind .weekly <Return> weekly_do

  grid .instr -
  grid .normal .weekly
  grid .normal_l .weekly_l

  proc quit {} {
      destroy .
  }

  bind . <Escape> quit
  bind . <Destroy> {set ::forever now}

  vwait forever
  exit