Import Geant4 0.0.0 source tree

2016-06-01 15:25:35 +02:00
parent 54d6b71f95
commit b97f8d0df7
3237 changed files with 807095 additions and 0 deletions
@@ -0,0 +1,208 @@
+##	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)
+		}
+	}
+}