geant4/environments/Momo/tcltk/SetEnv.proc

##	SetEnv
##	(Momo procedure)
#	Set environment value, make window
##
##	k.ohtubo(Tubocky)
##
##	1997.3.16
##	Tcl/Tk version 8.0
##	1998 July 5 GEANT4 Beta-01

proc List_Env {} {
	if [winfo exists .se] {
		raise .se
		focus .se.left.input.ent
		return
	}

	global env errorCode errorInfo

	toplevel .se -highlightthickness 0
	wm title .se "Set ENV variables"


	frame .se.butt -highlightthickness 0
	pack .se.butt -side top -fill x

	button .se.butt.set -text "Set ENV variable" -bd 3 \
		-highlightthickness 0 \
		-command {
			if [catch {.se.left.input.ent get} VARIABLE] {
				Message_Skeleton -icon warning -button O.K. \
					-message "Input Variable's name."
				if {[lsearch [array names env] FONT] >= 0} {
					Change_Font $env(FONT) .msgskeleton
				}
				Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .msgskeleton
				.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
			} elseif [catch {.se.right.input.ent get} VALUE] {
				Message_Skeleton -icon warning -button O.K. \
					-message "Input Value."
				if {[lsearch [array names env] FONT] >= 0} {
					Change_Font $env(FONT) .msgskeleton
				}
				Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .msgskeleton
				.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
			} else {
				set env($VARIABLE) $VALUE
				Put_Env
			}
			if {$errorCode != "NONE"} {
				set errorCode NONE
			}
			if {$errorInfo != ""} {
				set errorInfo ""
			}
		}
	pack .se.butt.set -side left

#	button .se.butt.clear -text Clear -bd 3 -highlightthickness 0 \
#		-command {
#			.se.left.list see 0
#			.se.right.list see 0
#			.se.left.list selection clear 0 end
#			.se.right.list selection clear 0 end
#			focus .se.left.input.ent
#			.se.left.input.ent delete 0 end
#			.se.right.input.ent delete 0 end
#		}
#	pack .se.butt.clear -side left

	button .se.butt.cancel -text Cancel -bd 3 -highlightthickness 0 \
		-command {
			destroy .se
		}
	pack .se.butt.cancel -side left


	frame .se.left -relief raised -bd 1 -highlightthickness 0
	pack .se.left -side left -fill both -expand 1


	frame .se.left.input -highlightthickness 0
	pack .se.left.input -side top -fill x

	label .se.left.input.label -text Variable -highlightthickness 0
	pack .se.left.input.label -side left

	entry .se.left.input.ent -highlightthickness 0
	pack .se.left.input.ent -side left -fill x -expand 1

	listbox .se.left.list -yscrollcommand ".se.scroll.scroll set" \
		-highlightthickness 0
	pack .se.left.list -side top -fill both -expand 1


	frame .se.right -relief raised -bd 1 -highlightthickness 0
	pack .se.right -side left -fill both -expand 1


	frame .se.right.input -highlightthickness 0
	pack .se.right.input -side top -fill x

	label .se.right.input.label -text Value -highlightthickness 0
	pack .se.right.input.label -side left

	entry .se.right.input.ent -highlightthickness 0
	pack .se.right.input.ent -side left -fill x -expand 1

	listbox .se.right.list -yscrollcommand ".se.scroll.scroll set" \
		-highlightthickness 0
	pack .se.right.list -side top -fill both -expand 1


	frame .se.scroll -bd 1 -highlightthickness 0
	pack .se.scroll -side right -fill y

	entry .se.scroll.dummy -state disabled -relief flat -width 0 \
		-highlightthickness 0
	pack .se.scroll.dummy -side top

	scrollbar .se.scroll.scroll \
		-command {Scroll_Link {.se.left.list .se.right.list}} \
		-highlightthickness 0
	pack .se.scroll.scroll -side top -fill y -expand 1


#	Binding
	bind .se.left.list <ButtonRelease> {
		focus .se.left.input.ent
		.se.left.input.ent delete 0 end
		.se.right.input.ent delete 0 end
		if {![catch {selection get} GET]} {
			.se.left.input.ent insert end $GET
		}
		if {![catch {.se.right.list get [.se.left.list index @%x,%y]} VALUE]} {
			.se.right.input.ent insert end $VALUE
		}
		if {$errorCode != "NONE"} {
			set errorCode NONE
		}
		if {$errorInfo != ""} {
			set errorInfo ""
		}
	}

	bind .se.right.list <ButtonRelease> {
		focus .se.right.input.ent
		.se.left.input.ent delete 0 end
		.se.right.input.ent delete 0 end
		if {![catch {selection get} GET]} {
			.se.right.input.ent insert end $GET
		}
		if {![catch {.se.left.list get [.se.right.list index @%x,%y]} VARIABLE]} {
			.se.left.input.ent insert end $VARIABLE
		}
		if {$errorCode != "NONE"} {
			set errorCode NONE
		}
		if {$errorInfo != ""} {
			set errorInfo ""
		}
	}

	foreach BIND {Return Tab Shift-Tab} {
		bind .se <$BIND> {
			if {[focus] == ".se.left.input.ent"} {
				focus .se.right.input.ent
			} else {
				focus .se.left.input.ent
			}
		}
	}

	focus .se.left.input.ent
	Put_Env
	if {[lsearch [array names env] FONT] >= 0} {
		Change_Font $env(FONT) .se
	}
	Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .se
	Win_Size .se
	Tab_off
	Control
}

#	Putout enviroment value on list box
proc Put_Env {} {
	global env

	if {![winfo exists .se]} {
		Message_Skeleton -icon warning -button O.K. \
			-message "Warning!\nWhat's happen?"
		if {[lsearch [array names env] FONT] >= 0} {
			Change_Font $env(FONT) .msgskeleton
		}
		Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .msgskeleton
		.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
		return
	}

	.se.left.list delete 0 end
	.se.right.list delete 0 end
	foreach E [lsort [array names env]] {
		if {$env($E) != ""} {
			.se.left.list insert end $E
			.se.right.list insert end $env($E)
		}
	}
}