# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# tools.tcl - Miscellaneous classes.
# Copyright (C) 1998, 1999 Cygnus Solutions.

##########################################
##
## Labeled entry
##
##########################################
itcl_class Entry& {
	constructor {{config ""}} {
		set class [$this info class]
		@@rename $this $this-tmp-
		@@frame $this -class $class
		@@rename $this $this-win-
		@@rename $this-tmp- $this
		
		if {$textvariable == ""} {
			set textvariable $this-entry
		}
		
		set lblcmd [list @@label $this.label \
				-text $label \
				-anchor $anchor \
				-underline $underline]
					
		if {$labelwidth != -1} {
			lappend lblcmd -width $labelwidth
		}
		pack [eval $lblcmd] -side $side
		
		#entry
		set entcmd [list @@entry $this.entry \
					-textvariable $textvariable \
					-exportselection $exportselection \
					-state $state]
		if {$width != -1} {
			lappend entcmd -width $width
		}
		pack [eval $entcmd] \
			-side $side \
			-fill $fill \
			-expand $expand
			
		if {$balloon != ""} {
			balloon_bind_info $this.entry $balloon
		}
		@@bind $this.entry <Tab> {focus [tk_focusNext %W]}
		@@bind $this.entry <Shift-Tab> {focus [tk_focusPrev %W]}
	}
	
	destructor {
	}
	
	method config {config} {
	}
	method entry {} {
		return $this.entry
	}
	method label {} {
		return $this.label
	}
	
	public state "normal" {
		if {[winfo exists $this.entry]} {
			$this.entry config -state $state
		}
	}
	public anchor "nw"
	public exportselection y
	public width 5
	public labelwidth -1
	public label "none"
	public side "left"
	public fill "both"
	public expand y
	public textvariable ""
	public balloon ""
	public underline -1 {
		if {[winfo exists $this.label]} {
			$this.label config -underline $underline
		}
	}
}

##########################################
##
## Radio box
##
##########################################
itcl_class Radio& {
	constructor {{config ""}} {
		set class [$this info class]
		@@rename $this $this-tmp-
		@@frame $this -class $class
		@@rename $this $this-win-
		@@rename $this-tmp- $this
		
		if {$variable == ""} {
			set variable $this-value
		}
		if {$label != ""} {
			label $this.label \
			    -text $label \
			    -underline $labelunderline
			pack $this.label \
					-side $side \
					-fill x \
					-expand n
			if {$labelwidth != -1} {
				$this.label config -width $labelwidth
			}
		}
		
		set wdgs ""
		set i 0
		
		#set fr [frame $this.fr]
		set fr $this
		foreach n $labels {
			set val [lindex $contents $i]
			if {$val == ""} {
				set val $i
			}
			set bal [lindex $balloons $i]
			
			radiobutton $fr.radio-$i \
					-text $n \
					-variable $variable \
					-value $val \
					-anchor $anchor \
					-underline $underline
					
			pack $fr.radio-$i \
					-side $side \
					-fill x \
					-expand $expand \
					-anchor nw
					
			if {$command != ""} {
				$fr.radio-$i config \
					-command "eval $command" \
			}
			#bind balloon text
			if {$bal != ""} {
				balloon_bind_info $fr.radio-$i $bal
			}
			
			lappend wdgs $fr.radio-$i
			
			incr i
		}
		#pack $fr -side $side -fill $fill -expand $expand
		#if {[llength $wdgs] > 1} {
		#	@@eval grid $wdgs -sticky ew
		#}
	}
	
	destructor {
	}
	
	method config {config} {
	}
	
	public labelwidth  20
	public width  20
	public label  none
	public side   left
	public fill   both
	public expand n
	public anchor nw
	public variable ""
	public labels {on}
	public contents ""
	public command ""
	public balloons ""
	public underline -1
	public labelunderline -1
}

##########################################
##
## Checkbutton
##
##########################################
itcl_class CheckButton& {
	constructor {{config ""}} {
		set class [$this info class]
		@@rename $this $this-tmp-
		@@frame $this -class $class
		@@rename $this $this-win-
		@@rename $this-tmp- $this
		
		if {$label != ""} {
			label $this.label \
				-text $label \
				-underline $labelunderline
			pack $this.label \
					-side $side \
					-fill x \
					-expand n
			if {$labelwidth != -1} {
				$this.label config -width $labelwidth
			}
		}
		#set fr [frame $this.fr]
		set fr $this
		set i 0
		foreach n $labels {
		
			set var [lindex $variables $i]
			set bal [lindex $balloons $i]
			if {$var == ""} {
				set var $this-$i
			}
			set vals [lindex $values $i]
			if {$vals != ""} {
				set onval [lindex $vals 0]
				set offval [lindex $vals 1]
			} else {
				set onval 1
				set offval 0
			}
			set underline [lindex $underlines $i]
			if {$underline == ""} {
				set underline -1
			}
			checkbutton $fr.check-$i \
					-text $n \
					-variable $var \
					-onvalue $onval \
					-offvalue $offval \
					-anchor $anchor \
					-underline $underline \
					-state $state
			
			pack $fr.check-$i \
					-side $side \
					-fill x \
					-expand $expand \
					-anchor nw
					
			if {$command != ""} {
				$fr.check-$i config \
					-command "eval $command"
			}
			#bind balloon text
			if {$bal != ""} {
				balloon_bind_info $fr.check-$i $bal
			}
			incr i
		}
		
		#when only a checkbutton is availiable and doesn't
		#have text, underline text widget.
		if {$labelunderline == -1 && $i == 1 && $n == ""} {
			$this.label config -underline $underline
		}
	}
	
	destructor {
	}
	
	method config {config} {
	}
	
	public labelwidth  20
	public width  20
	public label  none
	public side   left
	public fill   both
	public expand n
	public anchor nw
	public variables ""
	public balloons ""
	public labels on
	public values ""
	public command ""
	public underlines -1
	public state "normal"
	public labelunderline -1
}


#############################################
# [Label Entry Button] widget
#############################################
itcl_class LabelEntryButton& {
	constructor {{config ""}} {
		global sn_options
		set class [$this info class]
		@@rename $this $this-tmp-
		@@frame $this -class $class
		@@rename $this $this-win-
		@@rename $this-tmp- $this
		
		if {$variable == ""} {
			set variable $this-txt
		}
		
		label $this.lbl \
				-text $text \
				-anchor $anchor \
				-underline $underline
		if {$labelwidth	!= -1} {
			$this.lbl config -width $labelwidth
		}
		
		#if native is enabled display path dependent to the OS
		if {$native} {
			global $variable
			catch {uplevel #0 "set $variable [list [file nativename [set $variable]]]"}
		}
		#entry for path
		@@entry $this.txt \
				-textvariable $variable \
				-state $state
		if {$width != -1} {
			$this.txt config -width $width
		}
				
		button $this.btn \
				-text [get_indep String Choose] \
				-underline $buttonunderline \
				-state $state
		if {$buttonballoon != ""} {
			balloon_bind_info $this.btn $buttonballoon
		}
		if {$command == ""} {
			set command "$this select_file $this.txt $variable"
		}
		$this.btn config \
			-command "eval $command"
		
		pack $this.lbl -side left -fill x
		pack $this.txt -side left -fill both -expand y
		pack $this.btn -side left -fill x
	}
	destructor {
	}
	
	method config {config} {
	}
	method entry {} {
		return $this.txt
	}
	method select_file_cb {var file} {
		global tcl_platform
		if {($tcl_platform(os)=="Windows 95") & ({string length $defaultextension} > 4)} {
		#Windows95 file select dialog has probably truncated the file extension
			set file [file rootname	$file]
			set file "$file$defaultextension"		
		}
		if {$native} {
			uplevel #0 "set $var [list [file nativename $file]]"
		} else {
			uplevel #0 "set $var [list $file]"
		}
	}
	method select_file {cls var} {
		upvar #0 $var v
		
		if {$v != ""} {
			set inifile [file tail $v]
			set inidir  [file dirname $v]
		} else {
			set inifile ""
			set inidir ""
		}
		
		if {$directory} {
			Editor& @@ DirDialog [winfo toplevel $cls] \
				-title [get_indep String Open] \
				-script "$this select_file_cb $var" \
				-initialdir $inidir
		} else {
			Editor& @@ FileDialog [winfo toplevel $cls] \
				-title [get_indep String Open] \
				-save_open $save_open \
				-script "$this select_file_cb $var" \
				-defaultextension $defaultextension \
				-extensions $extensions \
				-initialdir $inidir \
				-initialfile $inifile
		}
	}
	public native 1
	public defaultextension ""
	public extensions ""
	public save_open "open"
	public width -1
	public command ""
	public labelwidth -1
	public anchor nw
	public text "entry"
	public buttonballoon [get_indep String ChooseINFO]
	public variable "" {
		if {$variable == ""} {
			set variable $this-txt
		}
		if {[winfo exists $this.txt]} {
			$this.txt config -textvariable $variable
		}
	}
	public state "normal" {
		if {[winfo exists $this.txt]} {
			$this.txt config -state $state
			$this.btn config -state $state
		}
	}
	public value "" {
		if {$native} {
			uplevel #0 "set $variable [list [file nativename $value]]"
		} else {
			uplevel #0 "set $variable [list $value]"
		}
	}
	public underline -1
	public buttonunderline -1
	public directory 0
}
		
#Choose colors
itcl_class ChooseColor& {
	inherit Toplevel&
	
	constructor {{config ""}} {
		global sn_options
		
		if {$variable == ""} {
			set variable $this-value
			uplevel #0 "set $this-value [list $current]"
		}
		upvar #0 $variable var
		if {$var == ""} {
			@@set var $current
		}
		
		Toplevel&@@constructor -class ChooseColor
		
		$this withdraw
		
		title [get_indep String ChooseColor]
		
		#ok/apply/cancel buttons	
		sn_motif_buttons $this bottom 0 \
				[get_indep String ok] \
				[get_indep String Apply] \
				[get_indep String cancel]
		$this.button_0 config -command "$this apply"
		$this.button_1 config -command "$this apply 0"
		$this.button_2 config -command "set $variable \"\"; $this delete"
		
		label $this.sample -text " "
		pack $this.sample \
				-side top -fill x -expand y -pady 10 -padx 20
				
		if {[catch {$this.sample config -bg $current}]} {
			$this.sample config -bg white
		}
		
		if {$current == ""} {
			set current black
		}
		set current [winfo rgb $this.sample $current]
		
		set bg [$this cget -bg]
		set i 0
		foreach clr {red green blue} {
			global $this-$clr
			scale $this.$clr \
				-label $clr \
				-from 0 -to 255 \
				-showvalue y \
				-orient horizontal \
				-variable $this-$clr \
				-bg $bg \
				-command "$this view_color $clr"
			@@set $this-$clr [format %i "0x[string range [format "%02x" [lindex $current $i]] 0 1]"]
			pack $this.$clr -side top -fill x -expand y \
				-padx 5 \
				-pady 2
			incr i
		}
		
		#view current color
		view_color red 0
		
		#center window
		$this move_to_mouse
		$this take_focus
	}
	destructor {
		global $variable
		@@set $variable "ok"
		foreach v [@@info globals "$this-*"] {
			catch {uplevel #0 unset $v}
		}
	}
	
	method view_color {clrname value} {
		upvar #0 $this-red red
		upvar #0 $this-green green
		upvar #0 $this-blue blue
		
		set current [format "#%02x%02x%02x" $red $green $blue]
		$this.sample config -bg $current
	}
	
	method apply {{exit 1}} {
	
		if {$command != ""} {
			eval $command [list $current]
		}
	
		if {$exit} {
			$this delete
		}
	}
	
	public command ""
	public variable ""
	public current "#000000"
}
		
#Choose Font
itcl_class ChooseFont& {
	inherit Toplevel&
	
	global sn_options
	
	constructor {{config ""}} {
		global sn_options
		global tcl_platform
		
		if {$variable == ""} {
			set variable $this-value
			uplevel #0 "set $this-value [list $current]"
		}
		upvar #0 $variable var
		if {$var == ""} {
			@@set var $current
		}
		
		Toplevel&@@constructor -class ChooseFont
		
		$this withdraw
		title [get_indep String ChooseFont]
		
		#ok/apply/cancel buttons	
		sn_motif_buttons $this bottom 0 \
				[get_indep String ok] \
				[get_indep String Apply] \
				[get_indep String cancel]
		$this.button_0 config -command "$this apply"
		$this.button_1 config -command "watch y $this; $this apply 0; watch n $this"
		$this.button_2 config -command "set $variable \"\"; $this delete"
		
		label $this.sample -text " Sample " -anchor c
		pack $this.sample \
				-side top -fill x -expand y -pady 10 -padx 20
				
		if {[catch {$this.sample config -font $current}]} {
			set current $sn_options(def,default-font)
			$this.sample config -font $current
		}
		
		set fntfr $this.font
		frame $fntfr
		pack $fntfr -side top -fill x -padx 10 -pady 5
		
		set fntfr $this.font.name
		pack [frame $fntfr] -side top -fill x
		
		#font Family
		label $fntfr.famlbl -text [get_indep String Family] -anchor ne
		set fam $fntfr.fam
		Combo& $fam \
			-width 12 \
			-filter "" \
			-selectcommand "$this view_font"
		#no family for windows
		if {$tcl_platform(platform) == "windows"} {
			$fam contents [list "*"]
		} else {
			$fam contents [list "*" Adobe Sony Schumacher B&H Bitstream Misc]
			pack $fntfr.famlbl -side left
			pack $fam -side left
		}
		
		#font name
		label $fntfr.namlbl -text [get_indep String FontName] -anchor ne
		pack $fntfr.namlbl -side left
		set nam $fntfr.nam
		Combo& $nam \
			-width 22 \
			-filter "" \
			-selectcommand "$this view_font"
		if {$tcl_platform(platform) == "windows"} {
			$nam contents [list "*" Arial {Comic Sans MS} Courier {Courier New} Fixedsys Garamond  {Lucida Console} {MS Sans Serif} System  {Times New Roman}]
		} else {
			$nam contents [list "*" Courier Clean Fixed Lucida Terminal Charter Helvetica {New Century Schoolbook} Times Utopia]
		}
		pack $nam -side left
		
		#font size
		label $fntfr.sizlbl -text [get_indep String FontSize] -anchor ne
		pack $fntfr.sizlbl -side left
		set siz $fntfr.siz
		Combo& $siz \
			-width 3 \
			-filter "" \
			-selectcommand "$this view_font"
		$siz contents [list "*" 8 10 11 12 13 14 15 16 18 20 22 24 28]
		pack $siz -side left
		
		set fntfr $this.font.checks
		pack [frame $fntfr] -side top -fill x -anchor c
		
		#Normal/Bold
		set bld $fntfr.bld
		checkbutton $bld \
					-text [get_indep String FontBold] \
					-variable $this-bold \
					-onvalue "bold" \
					-offvalue "medium" \
					-underline $underline \
					-command "$this view_font"

		pack $bld -side left -anchor c
		
		#Normal/Cursive
		set cursive $fntfr.cursive
		checkbutton $cursive \
					-text [get_indep String FontCursive] \
					-variable $this-cursive \
					-onvalue "o" \
					-offvalue "r" \
					-underline $underline \
					-command "$this view_font"
		pack $cursive -side left -anchor c
		
		disp_font $current
		
		#view current color
		view_font $current
		
		#center window
		$this move_to_mouse
		$this take_focus
		
		#@@tkwait variable $variable
	}
	destructor {
		catch {$fam delete}
		catch {$nam delete}
		catch {$siz delete}
		foreach v [@@info globals "$this-*"] {
			catch {uplevel #0 unset $v}
		}
		
		global $variable
		@@set $variable "ok"
	}

	method disp_font {fnt} {
		upvar #0 $this-bold bold
		upvar #0 $this-cursive cursive
		
		set fnt [split $fnt "-"]
		set len [llength $fnt]
		if {$len > 8} {
			set family [lindex $fnt 1]
			set name   [lindex $fnt 2]
			set sz     [lindex $fnt 8]
			set bld    [lindex $fnt 3]
			set crsv   [lindex $fnt 4]
		} else {
			set name [lindex $fnt 0]
			set family ""
			set sz 120
			set bld ""
			set crsv ""
		}
		if {$name == ""} {
			set name "Courier"
		}
		$fam selecttext $family
		$nam selecttext $name
		
		if {$sz != "*" && [catch {set x [expr $sz + 0]}]} {
			set sz 120
		}
		if {$sz != "*"} {
			set sz [expr $sz / 10]
		}
		$siz selecttext $sz
		
		@@set bold    [string tolower $bld]
		@@set cursive [string tolower $crsv]
	}
	
	method config {config} {
	}
			
	method view_font {{value ""}} {
		upvar #0 $this-bold bold
		upvar #0 $this-cursive cursive
		
		if {$bold == ""} {
			@@set bold "medium"
		}
		if {$cursive == ""} {
			@@set cursive "r"
		}
		set family [$fam getentry]
		set name   [$nam getentry]
		set size   [$siz getentry]
		
		#add '0' to the font size
		if {$size != "*"} {
			set size "${size}0"
		}
		
		set current "-$family-$name-$bold-$cursive-Normal--*-$size-*-*-*-*-iso8859-1"
		if {[catch {$this.sample config -font $current}]} {
			set current $sn_options(def,default-font)
			$this.sample config -font $current
			bell
		}
	}
	
	method apply {{exit 1}} {
		if {$command != ""} {
			eval $command [list $current]
		}
		if {$exit} {
			$this delete
		}
	}
	
	protected fam
	protected nam
	protected siz
	
	public underline -1
	public command ""
	public variable ""
	public current $sn_options(def,default-font) {
		if {[winfo exists $this]} {
			disp_font $current
			view_font
		}
	}
}

###################################################
##
## Color managment
##
###################################################
itcl_class Color& {
	constructor {{config ""}} {
		global sn_path
		
		set class [$this info class]
		@@rename $this $this-tmp-
		@@frame $this -class $class
		@@rename $this $this-win-
		@@rename $this-tmp- $this
		
		set unknown_bitmap [file join $sn_path(bitmapdir) undef.xbm]
		set plus_bitmap    [file join $sn_path(bitmapdir) plus.xbm]
		set minus_bitmap   [file join $sn_path(bitmapdir) minus.xbm]
		
		set cmbfr $this.cmbfr
		frame $cmbfr
		pack $cmbfr -side left -fill y
		
		#Schemes
		set combo $cmbfr.schemes
		Combo& $combo \
				-filter "" \
				-selectcommand "$this display_scheme"
		pack $combo -side top -fill x

		#Categories
		set tree $cmbfr.tree
		Tree& $tree \
			-indentwidth 20 \
			-width 34 \
			-plusimage plus_image \
			-minusimage minus_image \
			-filter ""

		$tree bind <ButtonRelease-1> "$this display_value %x %y"
		$tree bind <space> "%W selection clear 0 end
							%W selection set active
							$this display_item
							break"
		$tree bind <Return> [$tree bind <space>]
		pack $tree -side top -fill y -expand y
		set treew [$tree tree]
		
		set fr $this.fr
		pack [frame $fr] -side right -fill both -expand y

		#sample for current setting
		set sample $fr.sample
		label $sample -text [get_indep String Sample] -anchor c \
				-height 3
		pack $sample -fill x -side top -pady 30
		
		#choose font
		set fnt_btn $fr.fnt
		LabelEntryButton& $fnt_btn \
			-text [get_indep String Font] \
			-labelwidth 14 \
			-underline [get_indep Pos Font] \
			-command "$this choose_font $fnt_btn" \
			-anchor e \
			-state disabled
		
		# Since error handling is currently broken, disable typing.
		$fnt_btn.txt configure -state disabled	
		bind $fnt_btn <FocusOut> "$this verify_font"
		pack $fnt_btn -side top -fill x
		
		#choose color
		set fg_btn $fr.fg
		#button $fg_btn -text [get_indep String FgColor]
		#pack $fg_btn -side top -padx 5 -pady 5 -fill x -expand y
		LabelEntryButton& $fg_btn \
			-text [get_indep String FgColor] \
			-labelwidth 14 \
			-underline [get_indep Pos FgColor] \
			-command "$this choose_fg $fg_btn" \
			-anchor e \
			-state disabled
		# Since error handling is currently broken, disable typing.
		$fg_btn.txt configure -state disabled
		bind $fg_btn <FocusOut> "$this verify_color fg"
		pack $fg_btn -side top -fill x
		
		#choose color
		set bg_btn $fr.bg
		#button $bg_btn -text [get_indep String BgColor]
		#pack $bg_btn -side top -padx 5 -pady 5 -fill x -expand y
		LabelEntryButton& $bg_btn \
			-text [get_indep String BgColor] \
			-underline [get_indep Pos BgColor] \
			-labelwidth 14 \
			-command "$this choose_bg $bg_btn" \
			-anchor e \
			-state disabled
		# Since error handling is currently broken, disable typing.
		$bg_btn.txt configure -state disabled
		bind $bg_btn <FocusOut> "$this verify_color bg"
		pack $bg_btn -side top -fill x
		
		#reset
		set rst $fr.rst
		button $rst \
				-text [get_indep String Reset] \
				-command "$this reset"
		pack $rst -side top -anchor ne
		
		display_schemes
		
		after idle "pack propagate $tree 0"
	}
	destructor {
	}
	
	#add availiable scheme names to the combo box
	method display_schemes {} {
		set default_scheme ""
		foreach sm $schemes {
			set sname [lindex $sm 0]
			$combo insert end -text $sname
			
			if {$default_scheme == ""} {
				set default_scheme $sname
			}
		}
		$combo selecttext $default_scheme
		display_scheme $default_scheme
	}
	
	#draw the tree of variable settings for the actual scheme
	method display_scheme {scheme} {
		foreach sm $schemes {
			set sname [lindex $sm 0]
			if {$sname != $scheme} {
				continue
			}
			set sents [lindex $sm 1]
			
			#delete old values
			$treew delete 0 end
			#categories (editor, class, ..)
			foreach cat [join [lrange $sm 1 end]] {
				set cname [lindex $cat 0]
				set cents [lindex $cat 1]
				set idx [$treew insert end \
					-text $cname \
					-bitmap @$unknown_bitmap]
				#options (text, ..)
				foreach ent $cents {
					set ename [lindex $ent 0]
					set eents [lindex $ent 1]
					if {$ename == ""} {
						continue
					}
					$treew insert end \
						-text $ename \
						-parent $idx \
						-data $eents \
						-bitmap @$unknown_bitmap
				}
			}
		}
	}
	
	method display_item {{idx ""}} {
		if {$idx == ""} {
			set idx [$treew curselection]
		}
		if {$idx == ""} {
			bell; return
		}
		set data [$treew data $idx]
		control_buttons $data
	}
	
	method display_value {x y} {
		#toggle the sub tree, if availiable
		set ret [$treew identify $x $y]
		if {$ret == "view" || $ret == "hide"} {
			$treew toggle @$x,$y
			Tree& @@ resize_widget $treew
			return
		}
		display_item
	}
	
	method reset {} {
		global sn_options
		if {$fnt != ""} {
			@@set sn_options($opt_fnt) $sn_options($fnt)
		}
		if {$fg != ""} {
			@@set sn_options($opt_fg) $sn_options($fg)
		}
		if {$bg != ""} {
			@@set sn_options($opt_bg) $sn_options($bg)
		}
	}
	
	method control_buttons {data} {
		global sn_options
	
		if {$data == ""} {
			set state disabled
		} else {
			set state normal
		}
		if {$data == ""} {
			set fnt     ""
			set opt_fnt ""
			set fg      ""
			set opt_fg  ""
			set bg      ""
			set opt_bg  ""
		} else {
			set fnt     [lindex $data 0]
			set opt_fnt [lindex $data 1]
			set fg      [lindex $data 2]
			set opt_fg  [lindex $data 3]
			set bg      [lindex $data 4]
			set opt_bg  [lindex $data 5]
		}
		
		if {$fnt == ""} {
			$fnt_btn config \
					-state disabled \
					-variable "" \
					-value ""
			# Since error handling is currently broken, disable typing.
			$fnt_btn.txt configure -state disabled	
			$sample config -font $sn_options(def,default-font)
		} else {
			$fnt_btn config -state normal
			# Since error handling is currently broken, disable typing.
			$fnt_btn.txt configure -state disabled	
			if {![@@info exists sn_options($opt_fnt)]} {
				@@set sn_options($opt_fnt) $sn_options($fnt)
			}
			$sample config -font $sn_options($opt_fnt)
			$fnt_btn config \
					-variable sn_options($opt_fnt) \
					-value $sn_options($opt_fnt)
		}
		if {$fg == ""} {
			$fg_btn config \
					-state disabled \
					-variable "" \
					-value ""
			# Since error handling is currently broken, disable typing.
			$fg_btn.txt configure -state disabled
			$sample config -fg black
		} else {
			$fg_btn config -state normal
			# Since error handling is currently broken, disable typing.
			$fg_btn.txt configure -state disabled
			if {![@@info exists sn_options($opt_fg)]} {
				@@set sn_options($opt_fg) $sn_options($fg)
			}
			$sample config -fg $sn_options($opt_fg)
			$fg_btn config \
					-variable sn_options($opt_fg) \
					-value $sn_options($opt_fg)
		}
		if {$bg == ""} {
			$bg_btn config \
					-state disabled \
					-variable "" \
					-value ""
			# Since error handling is currently broken, disable typing.
			$bg_btn.txt configure -state disabled
			$sample config -bg white
		} else {
			$bg_btn config -state normal
			# Since error handling is currently broken, disable typing.
			$bg_btn.txt configure -state disabled
			if {![@@info exists sn_options($opt_bg)]} {
				@@set sn_options($opt_bg) $sn_options($bg)
			}
			$sample config -bg $sn_options($opt_bg)
			$bg_btn config \
					-variable sn_options($opt_bg) \
					-value $sn_options($opt_bg)
		}
	}
	
	#if we can't set the font the sample, the
	#it is a wrong font
	method verify_font {} {
		global sn_options
		if {$fnt == ""} {
			return
		}
		if {$sn_options($opt_fnt) == "" || \
			[catch {$sample config -font $sn_options($opt_fnt)}]} {
			bell
			@@set sn_options($opt_fnt) $sn_options($fnt)
			
			if {[catch {$sample config -font $sn_options($fnt)}]} {
				@@set sn_options($opt_fnt) "Courier"
			}
		}
	}
	
	#verify if it is a correct color
	method verify_color {fg_bg} {
		global sn_options
		if {$fg_bg == "fg" && $fg == "" || $fg_bg == "bg" && $bg == ""} {
			return
		}
		if {$fg_bg == "fg"} {
			if {[catch {$sample config -fg $sn_options($opt_fg)}] || \
				$sn_options($opt_fg) == ""} {
				bell
				@@set sn_options($opt_fg) $sn_options($fg)
			}
		}
		if {$fg_bg == "bg"} {
			if {[catch {$sample config -bg $sn_options($opt_bg)}] || \
				$sn_options($opt_bg) == ""} {
				bell
				@@set sn_options($opt_bg) $sn_options($bg)
			}
		}
	}
	
	#called from choosing font to set the selected font
	#to the optional variable
	method setfont {cls fontname choosed_font} {
		global sn_options
		if {$choosed_font != "" && ![catch {$sample config -font $choosed_font}]} {
			@@set $fontname $choosed_font
		}
	}
	
	#choose different font
	method choose_font {cls} {
		global sn_options tcl_platform
		
		if {$tcl_platform(platform) == "windows"} {
			# use native Windows common Dialog font selector
			@@set sn_options($opt_fnt) [ide_win_choose_font \
						-default $sn_options($opt_fnt) \
						-parent $cls ]
			sn_log "New font (for $opt_fnt) = $sn_options($opt_fnt)"
		} else {
			set win $this-font
			
			catch {$win delete}
			ChooseFont& $win \
					-current $sn_options($opt_fnt) \
					-command [list $this setfont $cls sn_options($opt_fnt)]
		}
	}
			
	#accept choosed color
	method setcolor {fg_bg cls clrname choosed_clr} {
		global sn_options
		global $clrname
		if {$choosed_clr != ""} {
			if {$fg_bg == "fg"} {
				set ret [catch {$sample config -fg $choosed_clr}]
			} else {
				set ret [catch {$sample config -bg $choosed_clr}]
			}
			if {! $ret} {
				@@set $clrname $choosed_clr
			}
		}
	}
	
	#choose fgcolor
	method choose_fg {cls} {
		global sn_options
		set win $this-choose_color
		catch {$win delete}
		ChooseColor& $win \
			-current $sn_options($opt_fg) \
			-command "$this setcolor fg $cls sn_options($opt_fg)"
	}
	
	#choose bg color
	method choose_bg {cls} {
		global sn_options
		set win $this-choose_color
		catch {$win delete}
		ChooseColor& $win \
			-current $sn_options($opt_bg) \
			-command "$this setcolor bg $cls sn_options($opt_bg)"
	}
	
	protected fnt     ""
	protected opt_fnt ""
	protected fg      ""
	protected opt_fg  ""
	protected bg      ""
	protected opt_bg  ""
	
	protected combo
	protected treew
	protected tree
	protected sample
	protected fnt_btn
	protected fg_btn
	protected bg_btn
	
	protected unknown_bitmap ""
	protected plus_bitmap ""
	protected minus_bitmap ""

	public width 20
	public text "class"
	public color "color"
	public variable ""
	public schemes ""
}

