#==============================================================================
# Contains the implementation of multi-entry widgets for date and time.
#
# Copyright (c) 1999-2002  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#
# Multi-entry widgets for date and time
# =====================================
#

#------------------------------------------------------------------------------
# mentry::dateMentry
#
# Creates a new mentry widget win that allows to display and edit a date
# according to the argument fmt, which must be a string of length 3, consisting
# of the letters d for the day (01 - 31), m for the month (01 - 12), and y or Y
# for the year without century (00 - 99) or with century (e.g., 1999), in an
# arbitrary order.  sep specifies the text to be displayed in the labels
# separating the entry children of the mentry widget.  Sets the type attribute
# of the widget to Date, saves the value of fmt in its format attribute, and
# returns the name of the newly created widget.
#------------------------------------------------------------------------------
proc mentry::dateMentry {win fmt sep args} {
    #
    # Parse the fmt argument
    #
    if {![regexp {^([dmyY])([dmyY])([dmyY])$} $fmt dummy \
		 fields(0) fields(1) fields(2)]} {
	return -code error \
	       "bad format \"$fmt\": must be a string of length 3,\
		consisting of the letters d, m, and y or Y"
    }

    #
    # Check whether all the three date components are represented in fmt
    #
    for {set n 0} {$n < 3} {incr n} {
	set lfields($n) [string tolower $fields($n)]
    }
    if {[string compare $lfields(0) $lfields(1)] == 0 ||
	[string compare $lfields(0) $lfields(2)] == 0 ||
	[string compare $lfields(1) $lfields(2)] == 0} {
	return -code error \
	       "bad format \"$fmt\": must have unique components for the\
		day, month, and year"
    }

    #
    # Create the widget, set its type to Date, and save the format string
    #
    eval [list mentry $win] $args
    array set widths {d 2  m 2  y 2  Y 4}
    ::$win configure -body [list $widths($fields(0)) $sep $widths($fields(1)) \
				 $sep $widths($fields(2))]
    ::$win attrib type Date format $fmt

    #
    # In all entry children allow only unsigned
    # integers of the corresponding maximal values
    #
    array set maxs {d 31  m 12  y 99  Y 9999}
    for {set n 0} {$n < 3} {incr n} {
	wcb::cbappend [::$win entrypath $n] before insert \
		      "wcb::checkEntryForUInt $maxs($fields($n))"
    }

    return $win
}

#------------------------------------------------------------------------------
# mentry::timeMentry
#
# Creates a new mentry widget win that allows to display and edit a time
# according to the argument fmt, which must be a string of length 2 or 3,
# consisting of the following field descriptor characters of the clock format
# command: H or I, followed by M, and optionally the letter S.  An H as first
# character specifies the time format %H:%M or %H:%M:%S, while the letter I
# stands for %I:%M %p or %I:%M:%S %p.  sep specifies the text to be displayed
# in the labels separating the entry children of the mentry widget.  Sets the
# type attribute of the widget to Time, saves the value of fmt in its format
# attribute, and returns the name of the newly created widget.
#------------------------------------------------------------------------------
proc mentry::timeMentry {win fmt sep args} {
    #
    # Parse the fmt argument
    #
    if {![regexp {^(H|I)(M)(S?)$} $fmt dummy fields(0) fields(1) fields(2)]} {
	return -code error \
	       "bad format \"$fmt\": must be a string of length 2 or 3\
		starting with H or I, followed by M and optionally by S"
    }

    #
    # Create the widget, set its type to Time, and save the format
    # string.  If the AM/PM indicator is needed, devide it into
    # an entry (containing A or P) and a label (displaying M)
    #
    eval [list mentry $win] $args
    set len [string length $fmt]
    if {$len == 2} {
	set body [list 2 $sep 2]
    } else {
	set body [list 2 $sep 2 $sep 2]
    }
    if {[string compare $fields(0) I] == 0} {
	lappend body " " 1 M
    }
    ::$win configure -body $body
    ::$win attrib type Time format $fmt

    #
    # In the first len entry children allow only unsigned
    # integers of the corresponding maximal values
    #
    array set maxs {H 23  I 12  M 59  S 59}
    for {set n 0} {$n < $len} {incr n} {
	wcb::cbappend [::$win entrypath $n] before insert \
		      "wcb::checkEntryForUInt $maxs($fields($n))"
    }

    #
    # In the entry child containing the first character of the AM/PM
    # indicator (if present), install automatic uppercase conversion and
    # allow only the characters A and P; further, set the width of this
    # entry to 0 (i.e., dynamic), because in the case of a proportionally-
    # spaced font these characters are wider than the average-size ones
    #
    if {[string compare $fields(0) I] == 0} {
	set w [::$win entrypath $len]
	wcb::cbappend $w before insert \
		      wcb::convStrToUpper mentry::checkStrForAOrP
	$w configure -width 0
    }

    return $win
}

#------------------------------------------------------------------------------
# mentry::putClockVal
#
# Outputs the date or time corresponding to the integer clockVal to the mentry
# widget win of type Date or Time.  The keyword args stands for ?-gmt boolean?,
# like in the clock format command.
#------------------------------------------------------------------------------
proc mentry::putClockVal {clockVal win args} {
    #
    # Check whether clockVal is an integer number
    #
    if {[catch {format %d $clockVal} res] != 0} {
	return -code error $res
    }

    set type [checkIfDateOrTimeMentry $win]
    set usage "putClockVal clockValue pathName ?-gmt boolean?"

    #
    # Check the number of optional arguments
    #
    set count [llength $args]
    if {$count != 0 && $count != 2} {
	mwutil::wrongNumArgs $usage
    }

    #
    # Parse the command line
    #
    set useGMT 0
    foreach {opt val} $args {
	if {[string compare $opt -gmt] == 0} {
	    #
	    # Get the boolean value specified by val
	    #
	    if {[catch {expr {$val ? 1 : 0}} useGMT] != 0} {
		return -code error $useGMT
	    }
	} else {
	    mwutil::wrongNumArgs $usage
	}
    }

    if {[string compare $type Date] == 0} {
	putClockValToDateMentry $clockVal $win $useGMT
    } else {
	putClockValToTimeMentry $clockVal $win $useGMT
    }
}

#------------------------------------------------------------------------------
# mentry::getClockVal
#
# Returns the clock value corresponding to the date or time contained in the
# mentry widget win of type Date or Time.  The keyword args stands for ?-base
# clockValue? ?-gmt boolean?, like in the clock scan command.
#------------------------------------------------------------------------------
proc mentry::getClockVal {win args} {
    set type [checkIfDateOrTimeMentry $win]
    set usage "getClockVal pathName ?-base clockValue? ?-gmt boolean?"

    #
    # Check the number of optional arguments
    #
    set count [llength $args]
    if {$count > 4} {
	mwutil::wrongNumArgs $usage
    }

    #
    # Parse the command line
    #
    set base [clock seconds]
    set useGMT 0
    foreach {opt val} $args {
	if {$count == 1} {
	    mwutil::wrongNumArgs $usage
	}
	if {[string compare $opt -base] == 0} {
	    #
	    # Check whether val is an integer number
	    #
	    if {[catch {format %d $val} res] != 0} {
		return -code error $res
	    }
	    set base $val
	} elseif {[string compare $opt -gmt] == 0} {
	    #
	    # Get the boolean value specified by val
	    #
	    if {[catch {expr {$val ? 1 : 0}} useGMT] != 0} {
		return -code error $useGMT
	    }
	} else {
	    mwutil::wrongNumArgs $usage
	}
	incr count -2
    }

    if {[string compare $type Date] == 0} {
	return [getClockValFromDateMentry $win $base $useGMT]
    } else {
	return [getClockValFromTimeMentry $win $base $useGMT]
    }
}

#
# Private procedures
# ==================
#

#------------------------------------------------------------------------------
# mentry::checkStrForAOrP
#
# This before-insert callback checks whether the string str to be inserted into
# the entry widget w is A or P; if not, it cancels the insert operation.
#------------------------------------------------------------------------------
proc mentry::checkStrForAOrP {w idx str} {
    if {![regexp {^[AP]$} $str]} {
	wcb::cancel
    }
}

#------------------------------------------------------------------------------
# mentry::checkIfDateOrTimeMentry
#
# Generates an error if win is not a mentry widget of type Date or Time.
#------------------------------------------------------------------------------
proc mentry::checkIfDateOrTimeMentry win {
    if {![winfo exists $win]} {
	return -code error "bad window path name \"$win\""
    }

    set type [::$win attrib type]
    if {[string compare [winfo class $win] Mentry] != 0 ||
	[string compare $type Date] != 0 && [string compare $type Time] != 0} {
	return -code error \
	       "window \"$win\" is not a mentry widget for date or time"
    }

    return $type
}

#------------------------------------------------------------------------------
# mentry::putClockValToDateMentry
#
# Outputs the date corresponding to the integer clockVal to the mentry widget
# win of type Date.
#------------------------------------------------------------------------------
proc mentry::putClockValToDateMentry {clockVal win useGMT} {
    set fmt [::$win attrib format]

    #
    # For each entry child of win, format clockVal according
    # to the corresponding field descriptor character contained
    # in fmt and to useGMT, and output the result to the entry
    #
    for {set n 0} {$n < 3} {incr n} {
	set field [string range $fmt $n $n]
	::$win put $n [clock format $clockVal -format %$field -gmt $useGMT]
    }
}

#------------------------------------------------------------------------------
# mentry::putClockValToTimeMentry
#
# Outputs the time corresponding to the integer clockVal to the mentry widget
# win of type Time.
#------------------------------------------------------------------------------
proc mentry::putClockValToTimeMentry {clockVal win useGMT} {
    set fmt [::$win attrib format]

    #
    # For each entry child of win, format clockVal according
    # to the corresponding field descriptor character contained
    # in fmt and to useGMT, and output the result to the entry
    #
    set len [string length $fmt]
    for {set n 0} {$n < $len} {incr n} {
	set field [string range $fmt $n $n]
	::$win put $n [clock format $clockVal -format %$field -gmt $useGMT]
    }

    #
    # In the entry child containing the first character of
    # the AM/PM indicator (if present), display the first
    # character of the corresponding time component
    #
    if {[string compare [string range $fmt 0 0] I] == 0} {
	set meridian [clock format $clockVal -format %p -gmt $useGMT]
	::$win put $len [string range $meridian 0 0]
    }
}

#------------------------------------------------------------------------------
# mentry::getClockValFromDateMentry
#
# Returns the clock value corresponding to the date contained in the mentry
# widget win of type Date.
#------------------------------------------------------------------------------
proc mentry::getClockValFromDateMentry {win base useGMT} {
    #
    # Scan the contents of the entry children; generate an error if
    # any of them is empty or the value of the day or month is zero
    #
    set fmt [::$win attrib format]
    array set mins {d 1  m 1  y 0  Y 0}
    for {set n 0} {$n < 3} {incr n} {
	set w [::$win entrypath $n]
	set str [$w get]
	if {[string compare $str ""] == 0} {
	    focus $w
	    return -code error EMPTY
	}
	scan $str %d vals($n)
	set field [string range $fmt $n $n]
	if {$vals($n) < $mins($field)} {
	    tabToEntry $w
	    return -code error BAD
	}
	set idxs($field) $n
    }

    #
    # Get the year, month, and day displayed in the widget
    #
    if {[info exists idxs(y)]} {
	set yearIdx $idxs(y)
    } else {
	set yearIdx $idxs(Y)
    }
    set year  $vals($yearIdx)
    set month $vals($idxs(m))
    set day   $vals($idxs(d))

    #
    # Check whether they represent a valid date
    #
    set dayList {0 31 28 31 30 31 30 31 31 30 31 30 31}
    if {($year % 4 == 0 && $year % 100 != 0) || $year % 400 == 0} {
	set dayList [lreplace $dayList 2 2 29]
    }
    if {$day > [lindex $dayList $month]} {
	set w [::$win entrypath 0]
	focus $w
	$w icursor 0
	return -code error BAD_DATE
    }

    #
    # Now we have a valid date: try to convert it to an integer clock
    # value; generate an error if this fails (because of the year)
    #
    if {[catch {clock scan $month/$day/$year -base $base -gmt $useGMT} res]
	== 0} {
	return $res
    } else {
	tabToEntry [::$win entrypath $yearIdx]
	return -code error BAD_YEAR
    }
}

#------------------------------------------------------------------------------
# mentry::getClockValFromTimeMentry
#
# Returns the clock value corresponding to the time contained in the mentry
# widget win of type Time.
#------------------------------------------------------------------------------
proc mentry::getClockValFromTimeMentry {win base useGMT} {
    #
    # Scan the contents of the numeric entry children;
    # generate an error if the first or second one is empty
    # or the value of the hour in 12-hour format is zero
    #
    set fmt [::$win attrib format]
    set len [string length $fmt]
    set meridianFlag [expr {[string compare [string range $fmt 0 0] I] == 0}]
    for {set n 0} {$n < $len} {incr n} {
	set w [::$win entrypath $n]
	set str [$w get]
	if {[string compare $str ""] == 0} {
	    if {$n == 2} {
		set str 00
		::$win put $n 00
	    } else {
		focus $w
		return -code error EMPTY
	    }
	}
	if {$n == 0 && $meridianFlag} {
	    scan $str %d val
	    if {$val < 1} {
		tabToEntry $w
		return -code error BAD
	    }
	}
	if {$n > 0} {
	    append timeStr :
	}
	append timeStr $str
    }

    #
    # Generate an error if the entry that should
    # contain an A or P (if present) is empty
    #
    if {$meridianFlag} {
	set w [::$win entrypath $len]
	set str [$w get]
	if {[string compare $str ""] == 0} {
	    focus $w
	    return -code error EMPTY
	}
	append timeStr " ${str}M"
    }

    #
    # Convert the time string built from the contents
    # of the widget to an integer clock value
    #
    return [clock scan $timeStr -base $base -gmt $useGMT]
}