This provides a new toplevel for arranging preferences or options in a common manner.

I still have some ideas for it. But right now it works fine. Some options can only be configured at creation time like -tabfont. It makes use of the BLT tabs but I tried to separate the tab functionality so that an other tab widget could be used. Any volunteers for tile ?

''Oct. 14. 2005 Changes:''
   * delete widgets array when widget is destroyed
   * add new command options
   * add _rcsid variable for version tracking

''Oct. 19. 2005 Changes:''
   * fix typo in option
   * add color option for selected item
   * set default font to font size 10
   * leave selected item marked when highlighting another item
   * separate procs for enter and leave of an item


----

 # Copyright (c) 2005, Rüdiger Härtel
 # All Rights Reservered
 #
 #
 # This code is freely distributable without restriction, but is
 # provided as-is with no warranty expressed or implied.
 #
 #
 # This widgets presents a framework for a
 # preferences widget.
 #
 # Requirements:
 #     BLT
 #     autoscroll               only used if package is installed
 #
 # Options:
 #    -canceltext <text>	text for Cancel Button
 #    -command <script>		script is invoked with 2
 #                               parameter, window and cmd
 #    -defaulttext <text>	text for Default Button
 #    -font
 #    -oktext <text>		text for Ok Button
 #    -relief <relief>
 #    -tabfont <font>
 #    -textbackground <color>
 #    -textforeground <color>
 #    -highlightbackground <color>
 #    -highlightforeground <color>
 #    -selectedbackground <color>
 #    -selectedforeground <color>
 #    -tabstyle <style>		currently: blt
 #    -titlefont
 #    -type			okCancel, defaultOkCancel
 #
 # Commands:
 #       insert <index> <text> ?option value?
 #       configure ?option value?
 #       options                 returns a key value list of
 #                               index and the path to the frame
 #
 # Insert Options:
 #        -title <text>
 #        -titleimage <image>
 #
 #
 #
 #
 
 package require msgcat
 
 msgcat::mcset de Ok		"Ok"
 msgcat::mcset de Cancel		"Cancel"
 msgcat::mcset de Default	"Standardwerte"
 
 namespace eval prefs {
     variable widgetOptions
     variable widgetCommands
 
     variable _rcsid "\$Id: 14831,v 1.10 2005-10-21 06:02:04 jcw Exp $"
 }
 
 # ::prefs::prefs --
 #
 #     This is the command that gets exported. It creates a new
 #     prefs widget.
 #
 # Arguments:
 #
 #     w        path of new widget to create
 #     args     additional option/value pairs
 #                (eg: -background white, etc.)
 #
 # Results:
 #
 #     It creates the widget and sets up all of the default bindings
 #
 # Returns:
 #
 #     The name of the newly create widget
 
 proc prefs::prefs { w args } {
 
     namespace export prefs
 
     variable widgetOptions
     variable widgetCommands
 
     if {![info exists widgetOptions]} {
 	Init
     }
 
     eval Build $w $args
 
 }
 
 # ::prefs::Init --
 #
 #
 # Arguments:
 #
 #    none
 #
 # Results:
 #
 #     All state variables are set to their default values; all of
 #     the option database entries will exist.
 #
 # Returns:
 #
 #     empty string
 
 proc ::prefs::Init {} {
     variable widgetOptions
     variable widgetCommands
 
     array set widgetOptions [list \
     	-canceltext		{cancelText	CancelText}	\
     	-command		{command	Command}	\
     	-defaulttext		{defaultText	DefaultText}	\
     	-font			{font		Font}		\
     	-oktext			{okText		OkText}		\
     	-relief			{relief		Relief}		\
     	-tabfont		{tabFont	TabFont}	\
     	-textbackground		{textBackground	TextBackground}	\
     	-textforeground		{textForeground	TextForeground}	\
     	-highlightbackground	{highlightBackground 	HighlightBackground}	\
     	-highlightforeground	{highlightForeground	HighlightForeground}	\
     	-selectedbackground	{selectedBackground	SelectedBackground}	\
     	-selectedforeground	{selectedForeground	SelectedForeground}	\
     	-tabstyle		{tabStyle	TabStyle}	\
     	-titlefont		{titleFont	TitleFont}	\
     	-type			{type		Type}		\
     ]
 
     set widgetCommands [list \
     	insert	configure options
     ]
 
     option add *Preferences.cancelText             " Cancel  "    widgetDefault
     option add *Preferences.defaultText            " Default "    widgetDefault
     option add *Preferences.okText                 "   Ok    "    widgetDefault
     option add *Preferences.font                   "Helvetica 10 bold" widgetDefault
     option add *Preferences.highlightBackground    darkblue       widgetDefault
     option add *Preferences.highlightForeground    white          widgetDefault
     option add *Preferences.selectedBackground     darkblue       widgetDefault
     option add *Preferences.selectedForeground     white          widgetDefault
     option add *Preferences.tabFont                "Helvetica 10" widgetDefault
     option add *Preferences.titleFont              "Helvetica 24" widgetDefault
     option add *Preferences.tabStyle               blt            widgetDefault
     option add *Preferences.textBackground         white          widgetDefault
     option add *Preferences.textForeground         black          widgetDefault
     option add *Preferences.type                   okCancel       widgetDefault
 
     # set class bindings
     SetClassBindings
 }
 
 # ::prefs::SetClassBindings --
 #
 #    Sets up the default bindings for the widget class
 #
 #    this proc exists since it's The Right Thing To Do, but
 #    I haven't had the time to figure out how to do all the
 #    binding stuff on a class level. The main problem is that
 #    the entry widget must have focus for the insertion cursor
 #    to be visible. So, I either have to have the entry widget
 #    have the Combobox bindtag, or do some fancy juggling of
 #    events or some such. What a pain.
 #
 # Arguments:
 #
 #    none
 #
 # Returns:
 #
 #    empty string
 
 proc ::prefs::SetClassBindings {} {
 
     # make sure we clean up after ourselves...
     bind Preferences <Destroy> [list ::prefs::DestroyHandler %W]
 
     return ""
 }
 
 # ::prefs::Build --
 #
 #    This does all of the work necessary to create the basic
 #    prefs.
 #
 # Arguments:
 #
 #    w        widget name
 #    args     additional option/value pairs
 #
 # Results:
 #
 #    Creates a new widget with the given name. Also creates a new
 #    namespace patterened after the widget name, as a child namespace
 #    to ::prefs
 #
 # Returns:
 #
 #    the name of the widget
 
 proc prefs::Build { w args } {
     variable widgetOptions
 
     namespace eval ::prefs::$w {
 	variable widgets
 	variable options
 	variable data
 
 	set widgets(foo) foo  ;# coerce into an array
 	set options(foo) foo  ;# coerce into an array
 	set data(foo) foo  ;# coerce into an array
 
 	unset widgets(foo)
 	unset options(foo)
 	unset data(foo)
     }
 
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     # create GUI
     #
     #    +------------------------------------------+
     #    | +----------+  +------------------------+ |
     #    | |        |-|  |                        | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |optList | |  |    optFrame            | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |        | |  |                        | |
     #    | |        |-|  |                        | |
     #    | +----------+  +------------------------+ |
     #    |                                          |
     #    |   +----------+  +--------+  +--------+   |
     #    |   | Default  |  |   Ok   |  | Cancel |   |
     #    |   +----------+  +--------+  +--------+   |
     #    +------------------------------------------+
     #
 
     # create optList and optFrame
     set widgets(this)  [toplevel $w -class Preferences]
 
     # this defines all of the default options. We get the
     # values from the option database. Note that if an array
     # value is a list of length one it is an alias to another
     # option, so we just ignore it
     # if one option is given as argument use its value
     # instead of the default option
     foreach name [array names widgetOptions] {
 	if {[llength $widgetOptions($name)] == 1} continue
 	if { [lsearch $args $name] > -1 } {
 
 	    set idx [lsearch $args $name]
 	    set value [lindex $args [expr $idx + 1]]
 	    set options($name) $value
 	} else {
 
 	    set optName  [lindex $widgetOptions($name) 0]
 	    set optClass [lindex $widgetOptions($name) 1]
 
 	    set value [option get $w $optName $optClass]
 	    set options($name) $value
 	}
     }
 
     set pw $w.pw
     set widgets(optPanedWin) [panedwindow $pw -orient horizontal \
         -showhandle 0 -sashwidth 5]
 
     set f1 [frame $pw.f1 -takefocus 0]
     set widgets(optVScroll) $f1.optVS
     set widgets(optHScroll) $f1.optHS
 
     set widgets(optList) [text $f1.optList \
         -cursor left_ptr \
         -takefocus 0 \
         -width 12 \
         -height 15 \
         -wrap none \
     	-spacing1 3 \
     	-spacing3 3 \
         -xscroll [list $widgets(optHScroll) set]\
         -yscroll [list $widgets(optVScroll) set]]
 
     # see efftcl hierlist.tcl
     set tabsize [option get $w indent Indent]
     set tabsize [winfo pixels $w 10]
     set tabs "15"
     for {set i 1} {$i < 20} {incr i} {
         lappend tabs [expr $i*$tabsize+15]
     }
     $widgets(optList) configure -tabs $tabs
 
     set btags [bindtags $widgets(optList)]
     set i [lsearch $btags Text]
     if {$i >= 0} {
         set btags [lreplace $btags $i $i]
     }
     bindtags $widgets(optList) $btags
     ## end
 
     scrollbar $widgets(optVScroll) -orient vertical
     scrollbar $widgets(optHScroll) -orient horizontal
 
     if { [lsearch [package names] autoscroll] > -1} {
 	package require autoscroll
 
 	autoscroll::autoscroll $widgets(optVScroll)
 	autoscroll::autoscroll $widgets(optHScroll)
     }
 
     grid $widgets(optList) -row 0 -column 0 -sticky news
     grid $widgets(optVScroll) -row 0 -column 1 -sticky ns
     grid $widgets(optHScroll) -row 1 -column 0 -sticky ew
 
     grid rowconfigure    $f1 0 -weight 1
     grid columnconfigure $f1 0 -weight 1
 
     set widgets(optFrame) [frame $w.optFrame -takefocus 0]
 
     $pw add $f1 -sticky news
     $pw add $widgets(optFrame) -sticky news
 
     #pack $pw -expand 1 -fill both -side top -pady 10 -padx 10
     grid $pw -row 0 -column 0 -sticky news -padx 5 -pady 5
 
     # create buttonFrame
     set btnf [frame $w.f2 -takefocus 0]
     set widgets(defaultButton) [button $btnf.defBtn]
     set widgets(okButton) [button $btnf.okBtn]
     set widgets(cancelButton) [button $btnf.cancelBtn]
 
     grid $widgets(defaultButton) $widgets(okButton) $widgets(cancelButton) \
     	-row 0 -padx 5
 
     #pack $btnf -pady 10 -expand 1 -fill both
     grid $btnf -row 1 -column 0 -sticky ew -pady 10
     grid rowconfigure $w 0 -weight 1
     grid columnconfigure $w 0 -weight 1
 
     set widgets(frame) ::prefs::${w}::$w
     rename $w ::$widgets(frame)
     proc ::$w { command args } \
 	"eval ::prefs::WidgetProc $w \$command \$args"
 
     set data(curopt) ""
     if {[catch "::prefs::Configure [list $widgets(this)] [array get options]" error]} {
 	catch {destroy $w}
 	error "internal error: $error"
     }
 
     return $w
 }
 
 # ::prefs::DestroyHandler {w} --
 #
 #    Cleans up after a combobox widget is destroyed
 #
 # Arguments:
 #
 #    w    widget pathname
 #
 # Results:
 #
 #    The namespace that was created for the widget is deleted,
 #    and the widget proc is removed.
 
 proc ::prefs::DestroyHandler {w} {
     upvar ::prefs::${w}::widgets widgets
 
     array unset widgets
 
     catch {
 	# if the widget actually being destroyed is of class Combobox,
 	# remove the namespace and associated proc.
 	if {[string compare [winfo class $w] "Preferences"] == 0} {
 	    # delete the namespace and the proc which represents
 	    # our widget
 	    namespace delete ::combobox::$w
 	    rename $w {}
 	}
     }
     return ""
 }
 
 
 
 # ::prefs::Configure --
 #
 #    Implements the "configure" widget subcommand
 #
 # Arguments:
 #
 #    w      widget pathname
 #    args   zero or more option/value pairs (or a single option)
 #
 # Results:
 #
 #    Performs typcial "configure" type requests on the widget
 
 proc ::prefs::Configure {w args} {
     variable widgetOptions
 
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
 
     if {[llength $args] == 0} {
 	# hmmm. User must be wanting all configuration information
 	# note that if the value of an array element is of length
 	# one it is an alias, which needs to be handled slightly
 	# differently
 	set results {}
 	foreach opt [lsort [array names widgetOptions]] {
 	    if {[llength $widgetOptions($opt)] == 1} {
 		set alias $widgetOptions($opt)
 		set optName $widgetOptions($alias)
 		lappend results [list $opt $optName]
 	    } else {
 		set optName  [lindex $widgetOptions($opt) 0]
 		set optClass [lindex $widgetOptions($opt) 1]
 		set default [option get $w $optName $optClass]
 		if {[info exists options($opt)]} {
 		    lappend results [list $opt $optName $optClass \
 			    $default $options($opt)]
 		} else {
 		    lappend results [list $opt $optName $optClass \
 			    $default ""]
 		}
 	    }
 	}
 
 	return $results
     }
 
     # one argument means we are looking for configuration
     # information on a single option
     if {[llength $args] == 1} {
 	# set opt [::combobox::Canonize $w option [lindex $args 0]]
 	set opt [lindex $args 0]
 
 	set optName  [lindex $widgetOptions($opt) 0]
 	set optClass [lindex $widgetOptions($opt) 1]
 	set default [option get $w $optName $optClass]
 	set results [list $opt $optName $optClass \
 		$default $options($opt)]
 	return $results
     }
 
     # if we have an odd number of values, bail.
     if {[expr {[llength $args]%2}] == 1} {
 	# hmmm. An odd number of elements in args
 	error "value for \"[lindex $args end]\" missing"
     }
 
     foreach option [array names options] {
 	set newValue $options($option)
 	if {[info exists options($option)]} {
 	    set oldValue $options($option)
 	}
 
 	set options($option) $newValue
 	switch -- $option {
     	    -canceltext {
 		 $widgets(cancelButton) configure -text $newValue
     	    }
     	    -command {
     	        if { $newValue eq {} } {
 		    continue
     	        }
     	        foreach btn [list default ok cancel] {
 		    $widgets(${btn}Button) configure -command [list $newValue $w $btn]
     	        }
 		 wm protocol $widgets(this) WM_DELETE_WINDOW [list $newValue $w cancel]
     	    }
     	    -defaulttext {
 		 $widgets(defaultButton) configure -text $newValue
     	    }
     	    -font {
 		$widgets(optList) configure -font $newValue
     	    	set options($option) $newValue
 	    }
 	    -highlightbackground {
 	    }
 	    -highlightforeground {
 	    }
     	    -oktext {
 		 $widgets(okButton) configure -text $newValue
     	    }
     	    -tabfont {
     	    }
     	    -textbackground {
 		$widgets(optList) configure -background $newValue
     	    }
     	    -textbackground {
 		$widgets(optList) configure -foreground $newValue
     	    }
     	    -titlefont {
     	    }
     	    -type {
 		switch -- $newValue {
 		    "okCancel" {
 			grid forget $widgets(defaultButton)
 		    }
 		    default {
 		    }
 		}
     	    }
     	}
     }
 }
 
 
 # ::prefs::WidgetProc --
 #
 #
 # Arguments:
 #
 #    w         widget pathname
 #    command   widget subcommand
 #    args      additional arguments; varies with the subcommand
 #
 # Results:
 #
 #    Performs the requested widget command
 
 proc ::prefs::WidgetProc {w command args} {
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     #puts "[info level 0]"
 
     set _args $args
     set index [lindex $_args 0]
     set _args [lreplace $_args 0 0]
     set nodeText [lindex $_args 0]
     set _args [lreplace $_args 0 0]
 
     # if we have an odd number of values, bail.
     if {[expr {[llength $_args]%2}] == 1} {
 	# hmmm. An odd number of elements in args
 	error "value for \"[lindex $args end]\" missing"
     }
 
     # Great. An even number of options. Let's make sure they
     # are all valid before we do anything. Note that Canonize
     # will generate an error if it finds a bogus option; otherwise
     # it returns the canonical option name
     foreach {name value} $_args {
 	set opts($name) $value
     }
 
     switch $command {
 	insert {
 	    set ident [string map {{ } {} {.} {}} $nodeText]
 	    set idx [string map {{ } {} {.} {}} $index]
 
 	    # for index "end" create a new frame
 	    # for a created index check if a tab widget exists
 	    #   if not create tab widget
 	    #   create a new frame
 	    switch -- $idx {
 		"end" {
 		    # create entry in optList widget
 		    if { [array get opts "-image"] ne "" } {
 			$widgets(optList) image create end \
 			    -image $opts(-image) -align center
 		    }
 		    $widgets(optList) insert end "$nodeText\n" [list optname $ident]
 
 		    $widgets(optList) tag bind $ident <Enter> \
 			[list ::prefs::EnterOption $w $ident]
 		    $widgets(optList) tag bind $ident <Leave> \
 			[list ::prefs::LeaveOption $w $ident]
 		    $widgets(optList) tag bind $ident <ButtonPress-1> \
 			[list ::prefs::ActivateOption $w $ident]
 
 		    set activebg $options(-selectedbackground)
 		    set activefg $options(-selectedforeground)
 		    $widgets(optList) tag configure selected -background $activebg -foreground $activefg
 
 		    eval ::prefs::addNewOption $w $args
 
 		    if { $data(curopt) eq "" } {
 			::prefs::ActivateOption $w $ident
 		    }
 
 		    set widgets(optFrame,${ident}Body) $widgets(optFrame,$ident).body
 		    frame $widgets(optFrame,${ident}Body) -takefocus 0
 		    pack $widgets(optFrame,${ident}Body) \
 		    	-expand 1 -fill both -side top -anchor nw
 
 		    return $widgets(optFrame,${ident}Body)
 		}
 		default {
 		    switch -- $options(-tabstyle) {
 			"blt" {
 			    set w [eval ::prefs::addNewBltTab $w $args]
 			}
 			default {
 			    error "only BLT tabs supported"
 			}
 		    }
 		    return $w
 		}
 	    }
 	}
 	options {
  	    set result [list]
  	    set name ""
  	    foreach item [array names widgets optFrame,*Body] {
 		regexp {optFrame,(.*)Body} $item dummy name
 		lappend result $name $widgets($item)
  	    }
  	    return $result
 	}
     }
 
 }
 
 
 # ::prefs::addNewOption --
 #
 #
 # Arguments:
 #
 #    none
 #
 # Results:
 #
 #   Insert new option in List
 #
 # Returns:
 #
 #     empty string
 
 proc ::prefs::addNewOption { w args } {
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     # puts [info level 0]
     set index [lindex $args 0]
     set args [lreplace $args 0 0]
     set nodeText [lindex $args 0]
     set args [lreplace $args 0 0]
 
     # if we have an odd number of values, bail.
     if {[expr {[llength $args]%2}] == 1} {
 	# hmmm. An odd number of elements in args
 	error "value for \"[lindex $args end]\" missing"
     }
 
     # Great. An even number of options. Let's make sure they
     # are all valid before we do anything. Note that Canonize
     # will generate an error if it finds a bogus option; otherwise
     # it returns the canonical option name
     foreach {name value} $args {
 	set opts($name) $value
     }
 
     set ident [string map {{ } {} {.} {}} $nodeText]
     set idx [string map {{ } {} {.} {}} $index]
 
     set widgets(optFrame,$ident) $widgets(optFrame).opt-$ident
     frame $widgets(optFrame,$ident) -takefocus 0
 
     set drawSeparator 0
     if { [array get opts "-title"] ne "" } {
 	# create title label
 	set widgets(optFrame,${ident}Title) \
 	    $widgets(optFrame,$ident).title
 	frame $widgets(optFrame,${ident}Title) -takefocus 0
 	label $widgets(optFrame,${ident}Title).l1 \
 	    -text $opts(-title) \
 	    -justify left -anchor w \
 	    -font $options(-titlefont)
 	set drawSeparator 1
     }
     if { [array get opts "-titleimage"] ne "" } {
 	# add image
 	# if label doesn't exist yet create one
 	if { [array get opts "-title"] eq "" } {
 	    set widgets(optFrame,${ident}Title) \
 		$widgets(optFrame,$ident).title
 	    label $widgets(optFrame,${ident}Title).l1
 	    set drawSeparator 1
 	}
 	$widgets(optFrame,${ident}Title).l1 configure \
 	    -image $opts(-titleimage) \
 	    -compound left
     }
 
     if { $drawSeparator == 1 } {
 	pack $widgets(optFrame,${ident}Title).l1 \
 	    -anchor nw -fill x
 	pack $widgets(optFrame,${ident}Title) \
 	    -anchor nw -fill x
 
 	frame $widgets(optFrame,${ident}Title).sep -height 2 \
 	    -relief sunken -takefocus 0 -borderwidth 2
 	pack $widgets(optFrame,${ident}Title).sep -fill x -pady 3
     }
 
 }
 
 
 # ::prefs::addNewBltTab --
 #
 #
 # Arguments:
 #
 #    none
 #
 # Results:
 #
 #   Add Suboption as BLT Tab
 #
 # Returns:
 #
 #     empty string
 
 proc ::prefs::addNewBltTab { w args } {
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     if { [lsearch [package names] BLT] < 0 } {
 	error "package BLT is required"
     }
     package require BLT
 
     #puts [info level 0]
     set index [lindex $args 0]
     set args [lreplace $args 0 0]
     set nodeText [lindex $args 0]
     set args [lreplace $args 0 0]
 
     # if we have an odd number of values, bail.
     if {[expr {[llength $args]%2}] == 1} {
 	# hmmm. An odd number of elements in args
 	error "value for \"[lindex $args end]\" missing"
     }
 
     # Great. An even number of options. Let's make sure they
     # are all valid before we do anything. Note that Canonize
     # will generate an error if it finds a bogus option; otherwise
     # it returns the canonical option name
     foreach {name value} $args {
 	set opts($name) $value
     }
 
     set ident [string map {{ } {} {.} {}} $nodeText]
     set idx [string map {{ } {} {.} {}} $index]
 
     if {[lsearch [array names widgets] "optFrame,$idx"] > -1 } {
 	if {[lsearch [array names widgets] "optFrame,${idx}-tab"] < 0 } {
 	    # tab does not yet exist, create one
 	    set widgets(optFrame,${idx}-tab) $widgets(optFrame,${idx}Body).tab$idx
 
 	    set bgcolor [$widgets(this).pw cget -background]
 	    blt::tabset $widgets(optFrame,${idx}-tab) -relief flat \
 	        -takefocus 0 -tearoff 0 -tile "" \
 	        -font $options(-tabfont) \
 	        -borderwidth 0 \
 	        -background $bgcolor \
 	        -activebackground $bgcolor \
 	        -selectbackground $bgcolor \
 	        -tiers 3
 
 	    pack $widgets(optFrame,${idx}-tab) -expand 1 -fill both
 	}
 	set widgets(optFrame,$ident) $widgets(optFrame,${idx}-tab).$ident
 	frame $widgets(optFrame,$ident) -takefocus 0
 	$widgets(optFrame,${idx}-tab) insert end $opts(-title) \
 	    -window $widgets(optFrame,$ident) -fill both
 
 	return $widgets(optFrame,$ident)
 
     } else {
 	error "Unknown index $ident"
     }
 }
 
 # ::prefs::EnterOption --
 #
 #
 # Arguments:
 #
 #    none
 #
 # Results:
 #
 #   highlight item
 #
 # Returns:
 #
 #     empty string
 
 proc ::prefs::EnterOption { w opt } {
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     $widgets(optList) tag configure $opt \
     	-background $options(-highlightbackground) \
     	-foreground $options(-highlightforeground)
 }
 
 # ::prefs::LeaveOption --
 #
 #
 # Arguments:
 #
 #    none
 #
 # Results:
 #
 #   remove highlight from item
 #
 # Returns:
 #
 #     empty string
 
 proc ::prefs::LeaveOption { w opt } {
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     $widgets(optList) tag configure $opt -background {} -foreground {}
 }
 
 # ::prefs::ActivateOption --
 #
 #
 # Arguments:
 #
 #    none
 #
 # Results:
 #
 #   Show new frame and update internal variables
 #
 # Returns:
 #
 #     empty string
 
 proc ::prefs::ActivateOption { w opt } {
     upvar ::prefs::${w}::widgets widgets
     upvar ::prefs::${w}::options options
     upvar ::prefs::${w}::data data
 
     if { $data(curopt) eq "" } {
 	set data(curopt) $opt
     }
 
     set range [$widgets(optList) tag ranges $data(curopt)]
     set start [lindex $range 0]
     set end [lindex $range 1]
     $widgets(optList) tag remove selected $start $end
 
     pack forget $widgets(optFrame,$data(curopt))
     pack $widgets(optFrame,$opt) -expand 1 -fill both -side top
 
     set data(curopt) $opt
     set range [$widgets(optList) tag ranges $data(curopt)]
     set start [lindex $range 0]
     set end [lindex $range 1]
     $widgets(optList) tag add selected $start $end
     $widgets(optList) tag raise selected
 
     pack $widgets(optFrame,$data(curopt)) -expand 1 -fill both \
     	-padx 5 -pady 5
 
 }
 
 

 ##
 # some demo code
 ##
  
 proc prefsAction { w cmd } {
     puts [info level 0]
 
     destroy $w
     exit
 }
 
 prefs::prefs .p1 \
     -textbackground white \
     -oktext Okay \
     -command prefsAction \
     -highlightbackground peru \
     -highlightforeground gold \
     -selectedbackground bisque4 

 set t0 [.p1 insert end General -title "General"]
 set t1 [.p1 insert end "Fonts and Colors" -title "Fonts and Colors"]
 set t2 [.p1 insert end CANopen -title "CANopen"]
 set t3 [.p1 insert end DeviceNet -title "DeviceNet"]
 set t4 [.p1 insert end J1939 -title "J1939"]
 set t5 [.p1 insert CANopen pdomap -title "PDO Mapping"]
 set t6 [.p1 insert CANopen nodes -title "Node Names"]
 set t7 [.p1 insert CANopen fonts -title "Fonts and Colors"]
 #pack .p1 -expand yes -fill both
 
 foreach tab [list $t0 $t1 $t2 $t3 $t4 $t5 $t6 $t7 ] {
     puts $tab
     label $tab.l1 -text $tab
     pack $tab.l1 -side top
 }
----
[Category Widget]