# Copyright (c) 1993 by Sanjay Ghemawat
###############################################################################
# Date parsing routines
#
#	date_search
#	date_match
#
#	time_search
#	time_match
#
#	timerange_search
#	timerange_match
#
#	item_parse

###############################################################################
# Date parsing routines

# Search for first occurrence of a date in string.
# If found, set "pre" to the text before the occurrence of the date,
# set "post" to the text after the occurrence of the date, and
# "date" to the parsed date.

proc date_search {s dateVar preVar postVar} {
    global date_re
    set re $date_re(date)

    set off 0
    while {[regexp -nocase -indices $re [string range $s $off end] match]} {
	set start  [lindex $match 0]
	set finish [lindex $match 1]
	set x [string range $s [expr $off+$start] [expr $off+$finish]]
	if [date_match $x result] {
	    # Found it
	    upvar $dateVar date
	    upvar $preVar  pre
	    upvar $postVar post

	    set pre  [string range $s 0 [expr $start-1]]
	    set post [string range $s [expr $finish+1] end]
	    set date $result
	    return 1
	}

	incr off [expr $finish+1]
    }

    return 0
}

# Parse "string" as date.  If "string" is passed succesfully, set the
# variable named by "result" to the parsed date and return 1.  Else return 0.
proc date_match {string result} {
    upvar $result date

    global date_re
    set int	"($date_re(int))"
    set sep	$date_re(sep)
    set month	$date_re(month)
    set today	[date today]

    # Make sure it matches
    if ![regexp -nocase "^($date_re(date))\$" $string] {return 0}

    if ![string compare [string tolower $string] today] {
	set date $today
	return 1
    }

    if ![string compare [string tolower $string] tomorrow] {
	set date [expr $today+1]
	return 1
    }

    if ![string compare [string tolower $string] yesterday] {
	set date [expr $today-1]
	return 1
    }

    set y [date year $today]
    if {
	[regexp "$int/$int/$int" $string j1 m d y] ||
	[regexp "$int/$int" $string j1 m d] ||
	[regexp -nocase -- "$month$sep$int$sep$int" $string j1 m d y] ||
	[regexp -nocase -- "$int$sep$month$sep$int" $string j1 d m y] ||
	[regexp -nocase -- "$month$sep$int" $string j1 m d] ||
	[regexp -nocase -- "$int$sep$month" $string j1 d m]
    } {
	regsub {^0+} $m "" m
	regsub {^0+} $d "" d
	regsub {^0+} $y "" y
	if [catch {set m [_date_find_month $m]}] {return 0}

	if {$m > 12} {
	    # Has to be day/month/year
	    set tmp $m
	    set m $d
	    set d $tmp
	}

	if {$y < 100} {
	    # Move year to current century
	    incr y [expr ([date year $today]/100)*100]
	}

	if ![catch {set date [_date_build $d $m $y]}] {return 1}
    }

    return 0
}

###############################################################################
# Time parsing routines

# Search for first occurrence of a time in string.
# If found, set "pre" to the text before the occurrence of the time,
# set "post" to the text after the occurrence of the time, and
# "time" to the parsed date.

# The parsed time is returned as number of seconds since midnight.

proc time_search {s timeVar preVar postVar} {
    global date_re
    set re $date_re(time)

    set off 0
    while {[regexp -nocase -indices $re [string range $s $off end] match]} {
	set start  [lindex $match 0]
	set finish [lindex $match 1]
	set x [string range $s [expr $off+$start] [expr $off+$finish]]
	if [time_match $x result] {
	    # Found it
	    upvar $timeVar time
	    upvar $preVar  pre
	    upvar $postVar post

	    set pre  [string range $s 0 [expr $start-1]]
	    set post [string range $s [expr $finish+1] end]
	    set time $result
	    return 1
	}

	incr off [expr $finish+1]
    }

    return 0
}

# Parse "str" as time.  If "str" is passed succesfully, set the
# variable named by "result" to the parsed time and return 1.  Else return 0.

# The parsed time is returned as number of seconds since midnight.

proc time_match {str result} {
    upvar $result time

    global date_re
    set dig12	"$date_re(dig12)"
    set dig2	"$date_re(dig2)"
    set am	"$date_re(am)"
    set pm	"$date_re(pm)"
    set mer	"$date_re(mer)"
    set today	[date today]

    # Make sure it matches
    if ![regexp -nocase "^($date_re(time))\$" $str] {return 0}

    if ![string compare [string tolower $str] midnight] {
	set time 0
	return 1
    }

    if ![string compare [string tolower $str] noon] {
	set time [expr 12*60*60]
	return 1
    }

    set h 0
    set m 0
    set s 0
    set x ""
    if {
	[regexp -nocase "($dig12):($dig2)(:$dig2)?$mer?" $str j h m s x] ||

	[regexp -nocase "($dig12)$mer" $str j h x]
    } {
	regsub {^:}  $s "" s
	regsub {^0+} $h "" h
	regsub {^0+} $m "" m
	regsub {^0+} $s "" s
	if ![string compare $h ""] {set h 0}
	if ![string compare $m ""] {set m 0}
	if ![string compare $s ""] {set s 0}

	# Parse meridian
	if [regexp -nocase $am $x] {
	    if {$h == 12} {set h 0}
	    if {$h > 12} {return 0}
	} elseif [regexp -nocase $pm $x] {
	    if {$h == 12} {set h 0}
	    if {$h > 12} {return 0}
	    incr h 12
	}

	if {$h > 24} {return 0}
	set time [expr ($h*60 + $m)*60 + $s]
	return 1
    }

    return 0
}

###############################################################################
# Time range parsing routines

# Search for first occurrence of a time range in string.
# If found, set "pre" to the text before the occurrence of the range,
# set "post" to the text after the occurrence of the range, and
# "start" and "finish" to the parsed range.

# The parsed times are returned as number of seconds since midnight.

proc timerange_search {s startVar finishVar preVar postVar} {
    global date_re
    set re $date_re(timerange)

    set off 0
    while {[regexp -nocase -indices $re [string range $s $off end] match]} {
	set start  [lindex $match 0]
	set finish [lindex $match 1]
	set x [string range $s [expr $off+$start] [expr $off+$finish]]
	if [timerange_match $x r1 r2] {
	    # Found it
	    upvar $startVar  st
	    upvar $finishVar fi
	    upvar $preVar    pre
	    upvar $postVar   post

	    set pre  [string range $s 0 [expr $start-1]]
	    set post [string range $s [expr $finish+1] end]
	    set st   $r1
	    set fi   $r2
	    return 1
	}

	incr off [expr $finish+1]
    }

    return 0
}

# Parse "str" as time range.  If "str" is passed succesfully, set the
# variables named by "start" and "finish" to the parsed range and return 1.
# Else return 0.

# The parsed times are returned as number of seconds since midnight.
# Negative sized ranges are not matched.

proc timerange_match {str start finish} {
    global date_re
    set dig12 $date_re(dig12)
    set timesep $date_re(timesep)

    # Make sure it matches
    if ![regexp -nocase "^($date_re(timerange))\$" $str] {return 0}

    if {[time_search $str s j1 pos] && [time_search $pos f j2 j3]} {
	if {$s > $f} {return 0}

	upvar $start r1
	upvar $finish r2
	set r1 $s
	set r2 $f
	return 1
    }

    # Also search for strings of the form "<hour> to <time>" because
    # we can get the meridian information from the finish time.

    if {[regexp -nocase "($dig12)[set timesep]($date_re(time))" $str x h y p]
	&& [time_match $p f]
    } {
	regsub {^0+} $h "" h
	if ![string compare $h ""] {set h 0}

	if {($h <= 0) || ($h > 12)} {return 0}
	if {$h == 12} {set h 0}
	set s [expr $h*60*60]

	# Move $s into second half of the day if range would be more than 12hrs
	if {($f - $s) > 12*60*60} {incr s [expr 12*60*60]}

	if {$s > $f} {return 0}

	upvar $start r1
	upvar $finish r2
	set r1 $s
	set r2 $f
	return 1
    }
    return 0
}

###############################################################################
# Time range parsing routines

# Parse string as an item and return it.
# If default_date is not supplied, it defaults to [date today]

proc item_parse {text {default_date ""}} {
    set type notice
    set date $default_date
    if ![string compare $date ""] {set date [date today]}

    if {[timerange_search $text start finish pre post]} {
	set text "$pre $post"
	set type appt
    } elseif {[time_search $text start pre post]} {
	set text "$pre $post"
	set finish [expr $start + 60*60]
	if {$finish > 24*60*60} {set finish [expr 24*60*60]}
	set type appt
    }

    if [date_search $text date pre post] {
	set text "$pre $post"
    }

    regsub -all "\[ \t\n\]+" $text " " text
    regsub {^ } $text "" text
    regsub { $} $text "" text

    if ![string compare $type notice] {
	set id [notice]
    } else {
	set id [appointment]
	$id starttime [expr $start/60]
	$id length    [expr ($finish - $start)/60]
    }

    $id date $date
    $id earlywarning [cal option DefaultEarlyWarning]
    $id own
    $id text $text
    return $id
}

###############################################################################
# Internal routines

proc _date_find_month {m} {
    if [regexp -nocase "^jan" $m] {return 1}
    if [regexp -nocase "^feb" $m] {return 2}
    if [regexp -nocase "^mar" $m] {return 3}
    if [regexp -nocase "^apr" $m] {return 4}
    if [regexp -nocase "^may" $m] {return 5}
    if [regexp -nocase "^jun" $m] {return 6}
    if [regexp -nocase "^jul" $m] {return 7}
    if [regexp -nocase "^aug" $m] {return 8}
    if [regexp -nocase "^sep" $m] {return 9}
    if [regexp -nocase "^oct" $m] {return 10}
    if [regexp -nocase "^nov" $m] {return 11}
    if [regexp -nocase "^dec" $m] {return 12}
    return $m
}

proc _date_build {d m y} {
    # Fix year
    if {$y < 100} {
	set century [expr [date year [date today]]/100]
	incr y [expr $century*100]
    }

    if {($m < 1) ||
	($m > 12) ||
	($d < 1) ||
	($d > [date monthsize [date make 1 $m $y]])} {
	error "Invalid date"
    } else {
	return [date make $d $m $y]
    }
}

# Internal initialization routine
proc _date_re_init {} {
    # Some simple regexps
    set wday ([join {
	mon tue tues wed thu thur fri sat sun
	monday tuesday wednesday thursday friday saturday sunday
    } "|"])

    set month ([join {
	jan feb mar apr may jun jul aug sep sept oct nov dec
	january february march april may june july august september october
	november december
    } "|"])

    set dig   {[0-9]}
    set dig2  {[0-9][0-9]}
    set dig12 {[0-9][0-9]?}
    set int   {[0-9]+}
    set sep   {[., \t\n]+}
    set yearopt "($sep$int)?"
    set slashopt {(/[0-9]+)?}

    # Date regular expression
    set re1 "today"
    set re2 "tomorrow"
    set re3 "yesterday"
    set re4 "$int/$int$slashopt"
    set re5 "$month$sep$int$yearopt"
    set re6 "$int$sep$month$yearopt"
    set date "$re1|$re2|$re3|($wday$sep)?($re4|$re5|$re6)"

    # Time regular expression
    set am  "\[ \t\n\]*a\\.?m\\.?"
    set pm  "\[ \t\n\]*p\\.?m\\.?"
    set mer "($am|$pm)"

    set re1 "noon"
    set re2 "midnight"
    set re3 "$dig12:$dig2:$dig2$am"
    set re4 "$dig12:$dig2:$dig2$pm"
    set re5 "$dig12:$dig2:$dig2"
    set re6 "$dig12:$dig2$am"
    set re7 "$dig12:$dig2$pm"
    set re8 "$dig12:$dig2"
    set re9 "$dig12$mer"
    set time "$re1|$re2|$re3|$re4|$re5|$re6|$re7|$re8|$re9"

    # Time range regular expression
    set timesep   "\[ \t\n\]*(\\-|to)\[ \t\n\]*"
    set timerange "($time)[set timesep]($time)|$dig12[set timesep]($time)"

    # Initialize the global array
    global date_re
    set date_re(weekday)	$wday
    set date_re(month)		$month
    set date_re(int)		$int
    set date_re(sep)		$sep
    set date_re(yearopt)	$yearopt
    set date_re(slashopt)	$slashopt
    set date_re(date)		$date

    set date_re(am)		$am
    set date_re(pm)		$pm
    set date_re(mer)		$mer
    set date_re(dig)		$dig
    set date_re(dig2)		$dig2
    set date_re(dig12)		$dig12
    set date_re(timesep)	$timesep
    set date_re(time)		$time
    set date_re(timerange)	$timerange
}

_date_re_init