#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}

#==============================================================================
# Demonstrates how to implement a multi-entry widget for Ethernet addresses.
#
# Copyright (c) 1999-2004  Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================

#------------------------------------------------------------------------------
# ethernetAddrMentry
#
# Creates a new mentry widget win that allows to display and edit Ethernet
# addresses.  Sets the type attribute of the widget to EthernetAddr and returns
# the name of the newly created widget.
#------------------------------------------------------------------------------
proc ethernetAddrMentry {win args} {
    #
    # Create a mentry widget consisting of 6 entry children of
    # width 2, separated by colons, and set its type to EthernetAddr
    #
    eval [list mentry::mentry $win] $args
    $win configure -body {2 : 2 : 2 : 2 : 2 : 2}
    $win attrib type EthernetAddr

    #
    # Install automatic uppercase conversion and allow only hexadecimal
    # digits in all entry children; use wcb::cbappend (or wcb::cbprepend)
    # instead of wcb::callback in order to keep the wcb::checkEntryLen
    # callback, registered by mentry::mentry for all entry children
    #
    foreach w [$win entries] {
	wcb::cbappend $w before insert wcb::convStrToUpper \
		      {wcb::checkStrForRegExp {^[0-9A-F]*$}}
    }

    #
    # In the case of a proportionally-spaced font make the
    # entries within the widget a bit wider because the
    # characters A - F need more room than the digits 0 - 9
    #
    if {![font metrics [$win cget -font] -fixed]} {
	foreach w [$win entries] {
	    $w configure -width 3
	}
    }

    return $win
}

#------------------------------------------------------------------------------
# putEthernetAddr
#
# Outputs the Ethernet address addr to the mentry widget win of type
# EthernetAddr.  The address must be a string of the form XX:XX:XX:XX:XX:XX,
# where each XX must be a hexadecimal string in the range 0 - 255.  Leading
# zeros are allowed (but not required), hence the components may have more (but
# also less) than two characters; the procedure displays them with exactly two
# digits.
#------------------------------------------------------------------------------
proc putEthernetAddr {addr win} {
    set errorMsg "expected an Ethernet address but got \"$addr\""

    #
    # Check the syntax of addr
    #
    set lst [split $addr :]
    if {[llength $lst] != 6} {
	return -code error $errorMsg
    }

    #
    # Try to convert the 6 components of addr to hexadecimal
    # strings and check whether they are in the range 0 - 255
    #
    for {set n 0} {$n < 6} {incr n} {
	set val 0x[lindex $lst $n]
	if {[catch {format "%02X" $val} str$n] != 0 || $val < 0 || $val > 255} {
	    return -code error $errorMsg
	}
    }

    #
    # Check the widget and display the properly formatted Ethernet address
    #
    checkIfEthernetAddrMentry $win
    $win put 0 $str0 $str1 $str2 $str3 $str4 $str5
}

#------------------------------------------------------------------------------
# getEthernetAddr
#
# Returns the Ethernet address contained in the mentry widget win of type
# EthernetAddr.
#------------------------------------------------------------------------------
proc getEthernetAddr win {
    #
    # Check the widget
    #
    checkIfEthernetAddrMentry $win

    #
    # Generate an error if any entry child is empty
    #
    for {set n 0} {$n < 6} {incr n} {
	if {[$win isempty $n]} {
	    focus [$win entrypath $n]
	    return -code error EMPTY
	}
    }

    #
    # Return the properly formatted Ethernet address built
    # from the values contained in the entry children
    #
    $win getarray strs
    return [format "%02X:%02X:%02X:%02X:%02X:%02X" \
	    0x$strs(0) 0x$strs(1) 0x$strs(2) 0x$strs(3) 0x$strs(4) 0x$strs(5)]
}

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

    if {[string compare [winfo class $win] "Mentry"] != 0 ||
	[string compare [$win attrib type] "EthernetAddr"] != 0} {
	return -code error \
	       "window \"$win\" is not a mentry widget for Ethernet addresses"
    }
}

#------------------------------------------------------------------------------

package require Mentry

set title "Ethernet Address"
wm title . $title

#
# Get the current windowing system ("x11", "win32", "classic",
# or "aqua") and add some entries to the Tk option database
#
if {[catch {tk windowingsystem} winSys] != 0} {
    switch $::tcl_platform(platform) {
	unix      { set winSys x11 }
	windows   { set winSys win32 }
	macintosh { set winSys classic }
    }
}
switch $winSys {
    x11     { option add *Font		"Helvetica -12" }
    classic { option add *background	#dedede }
}

#
# Frame .f with a mentry displaying an Ethernet address
#
frame .f
label .f.l -text "A mentry widget for Ethernet addresses,\nwith automatic\
		  uppercase conversion:"
ethernetAddrMentry .f.me -justify center -bg white
pack .f.l .f.me

#
# Button .get invoking the procedure getEthernetAddr
#
button .get -text "Get from mentry" -command {
    if {[catch {
	set addr ""
	set addr [getEthernetAddr .f.me]
    }] != 0} {
	bell
	tk_messageBox -icon error -message "Field value missing" \
		      -title $title -type ok
    }
}

#
# Label .addr displaying the result of getEthernetAddr
#
label .addr -textvariable addr

#
# Frame .sep and button .close
#
frame .sep -height 2 -bd 1 -relief sunken
button .close -text Close -command exit

#
# Manage the widgets
#
pack .close -side bottom -pady 10
pack .sep -side bottom -fill x
pack .f -padx 10 -pady 10
pack .get -padx 10
pack .addr -padx 10 -pady 10

putEthernetAddr 0:40:5:E4:99:26 .f.me
focus [.f.me entrypath 0]