##	Public.proc
##	(Momo, GGE, GAG, FB procedure)
#	File List window model
#
#	This must be revised to have better display of the file's path
#	The absolute path is displayed so that it demands too large width.
#	1998 7 5  displaying $w.info.label1 only the currect dir name
##
##	k.ohtubo(Tubocky)
##
##	1998.3.17
##	Tcl/Tk version 8.0
##	1998 July 5 GEANT4 Beta-01

proc File_List_Skeleton w {
	global env

	if [winfo exists $w] {
		raise $w
		focus $w.name.ent
		return
	}

	toplevel $w -highlightthickness 0


	frame $w.butt -highlightthickness 0
	pack $w.butt -side top -fill x

	button $w.butt.b0 -text O.K. -bd 3 -highlightthickness 0
	button $w.butt.b1 -text Clear -bd 3 -highlightthickness 0
	button $w.butt.b2 -text Cancel -bd 3 -highlightthickness 0
	pack $w.butt.b0 $w.butt.b1 $w.butt.b2 -side left


	frame $w.info -highlightthickness 0
	pack $w.info -side top -fill x

	label $w.info.label0 -text "Current Dir:" -anchor w \
		-highlightthickness 0
	pack $w.info.label0 -side left

	set END [string length $env(HOME)]
	set Path ~[string range $env(G_PATH) $END end]
## cut out the current dir
	set dlist [file split $Path]
	set cdir [lindex $dlist end]
##supress label $w.info.label1 -text $Path -anchor w -highlightthickness 0
	label $w.info.label1 -text $cdir -anchor w -highlightthickness 0
	pack $w.info.label1 -side left -fill x -expand 1


	frame $w.name -highlightthickness 0
	pack $w.name -side top -fill x

	label $w.name.label -text File -highlightthickness 0
	pack $w.name.label -side left

	entry $w.name.ent -highlightthickness 0
	pack $w.name.ent -side left -fill x -expand 1


	frame $w.select -highlightthickness 0
	pack $w.select -side top -fill both

	listbox $w.select.list -width 20 -height 20 \
		-yscrollcommand "$w.select.scroll set" \
		-highlightthickness 0
	pack $w.select.list -side left -fill both -expand 1

	scrollbar $w.select.scroll -command "$w.select.list yview" \
		-highlightthickness 0
	pack $w.select.scroll -side left -fill y

	focus $w.name.ent
}

#	Change Path (Like Unix command "cd")
proc Change_Path DIR {
	global env

	if {![info exists env(G_PATH)]} {
		Message_Skeleton -icon warning -button O.K. \
			-message "Warning!\nCheck \"G_PATH\" value."
		.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
		return
	}

	set DIR [string trimright $DIR "/"]

	if {$DIR == "\."} {
		return $env(G_PATH)
	}
	if {$DIR == "\.\."} {
		set END [expr [string last "/" $env(G_PATH)] -1]
		set env(G_PATH) [string range $env(G_PATH) 0 $END]
		return $env(G_PATH)
	}

	if {![file isdirectory $env(G_PATH)/$DIR]} {
		return It_is_file
	}

	foreach l [glob $env(G_PATH)/*/] {
		set l [string trimright $l "/"]
		set END [expr [string last "/" $l] + 1]
		set l [string range $l $END end]
		if {$DIR == $l} {
			set env(G_PATH) $env(G_PATH)/$DIR
			return $env(G_PATH)
		}
	}

	return It_is_file
}

#	Putout File name List
proc Put_File_List w {
	global env

	if {![winfo exists $w.select.list]} {
		Message_Skeleton -icon warning -button O.K. \
			-message "Warning!\nWhat's happen?"
		.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
		return
	}

	$w.select.list delete 0 end
	foreach l [glob $env(G_PATH)/\.* $env(G_PATH)/*] {
		set END [expr [string last "/" $l] + 1]
		if {[file isdirectory $l]} {
			set l $l/
		}
		set l [string range $l $END end]
		$w.select.list insert end $l
	}
}

#	Define window size
proc Win_Size w {
	update
	wm geometry $w {}
	scan [wm geometry $w] %dx%d WIDTH HEIGHT
	wm minsize $w $WIDTH $HEIGHT
}

#	Change Font on window
proc Change_Font {FONT WIDGET} {
	global errorCode errorInfo
	if {![catch {winfo children $WIDGET} LIST]} {
		foreach w $LIST {
			Change_Font $FONT $w
		}
	} else {
		if {$errorCode != "NONE"} {
			set errorCode NONE
		}
		if {$errorInfo != ""} {
			set errorInfo ""
		}
		return
	}
	foreach w $LIST {
		catch {eval $w configure -font "$FONT"}
	}
	catch {eval $WIDGET configure -font "$FONT"}

	if {$errorCode != "NONE"} {
		set errorCode NONE
	}
	if {$errorInfo != ""} {
		set errorInfo ""
	}
}

#	Scroll Link
proc Scroll_Link {WIDGET args} {
	foreach w [split $WIDGET] {
		eval $w yview $args
	}
}

#	Change Color on window(FG BG)
proc Change_Color {F B WIDGET} {
	global errorCode errorInfo
	if {![catch {winfo children $WIDGET} LIST]} {
		foreach w $LIST {
			Change_Color $F $B $w
		}
	} else {
		if {$errorCode != "NONE"} {
			set errorCode NONE
		}
		if {$errorInfo != ""} {
			set errorInfo ""
		}
		return
	}
	foreach w $LIST {
		catch {$w configure -foreground $F}
		catch {$w configure -background $B}
	}
	catch {$WIDGET configure -foreground $F}
	catch {$WIDGET configure -background $B}

	if {$errorCode != "NONE"} {
		set errorCode NONE
	}
	if {$errorInfo != ""} {
		set errorInfo ""
	}
}

#	Check value (int,double,boolean,string)
proc Value_Check {TYPE VALUE} {
	switch $TYPE {
		int -
		i {	if {[regexp {^[+-]?0x[0-9a-fA-F]+$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]+\.$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]*\.[0-9a-fA-F]+$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]+\.?[eE][+-]?[0-9a-fA-F]+$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]*\.[0-9a-fA-F]+[eE][+-]?[0-9a-fA-F]+$} $VALUE]} {
				set ANSWER [tk_messageBox -type yesnocancel -icon question \
				-message "This value $VALUE is hexadecimal.\nChange to [expr $VALUE]?"]
				switch $ANSWER {
					yes {	return [Value_Check $TYPE [expr $VALUE]]}
					no {	if {[string index $VALUE 0] != "0"} {
							set FLAG [string index $VALUE 0]
						} else {
							set FLAG ""
						}
						set HEAD [expr [string first 0x $VALUE] + 2]
						set VALUE $FLAG[string range $VALUE $HEAD end]
						return [Value_Check $TYPE $VALUE]
					}
					cancel {return ERROR}
				}
			} elseif {[regexp {^[+-]?0[0-7]+$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.[0-7]+$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.?[eE][+-]?[0-7]+$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.[0-7]+[eE][+-]?[0-7]+$} $VALUE]} {
				if {[string index $VALUE 0] != "0"} {
					set FLAG [string index $VALUE 0]
					set VALUE [string range $VALUE 1 end]
				} else {
					set FLAG ""
				}
				set ANSWER [tk_messageBox -type yesnocancel -icon question \
				-message "This value $VALUE is octal.\nChange to [expr $VALUE]?"]
				switch $ANSWER {
					yes {	return [Value_Check $TYPE $FLAG[expr $VALUE]]}
					no {	while {[string index $VALUE 0] == "0"} {
							set VALUE [string range $VALUE 1 end]
						}
						return [Value_Check $TYPE $FLAG$VALUE]
					}
					cancel {return ERROR}
				}
			} elseif {[regexp {^[+-]?0[0-9]+$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.[0-9]+$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.?[eE][+-]?[0-9]+$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.[0-9]+[eE][+-]?[0-9]+$} $VALUE]} {
				if {[string index $VALUE 0] != "0"} {
					set FLAG [string index $VALUE 0]
					set VALUE [string range $VALUE 1 end]
				} else {
					set FLAG ""
				}
				while {[string index $VALUE 0] == "0"} {
					set VALUE [string range $VALUE 1 end]
				}
				return [Value_Check $TYPE $FLAG$VALUE]
			} elseif {[regexp {^[+-]?[0-9]+\.$} $VALUE] || \
				[regexp {^[+-]?[0-9]*\.[0-9]+$} $VALUE] || \
				[regexp {^[+-]?[0-9]+\.?[eE][+-]?[0-9]+$} $VALUE] || \
				[regexp {^[+-]?[0-9]*\.[0-9]+[eE][+-]?[0-9]+$} $VALUE]} {
				set ANSWER [tk_messageBox -type yesnocancel -icon question \
				-message "This value is $VALUE.\nType is $TYPE.\nChange to integer?"]
				switch $ANSWER {
					yes {	return [Value_Check $TYPE [expr int($VALUE)]]}
					no {	return ERROR}
					cancel {return ERROR}
				}
			} elseif {[regexp {^[+-]?[0-9]+$} $VALUE]} {
				return $VALUE
			} else {
				tk_messageBox -type ok -icon question \
				-message "Check!\nParameter type doesn't match."
				return ERROR
			}
		}
		double -
		d {	if {[regexp {^[+-]?0x[0-9a-fA-F]+$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]+\.$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]*\.[0-9a-fA-F]+$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]+\.?[eE][+-]?[0-9a-fA-F]+$} $VALUE] || \
				[regexp {^[+-]?0x[0-9a-fA-F]*\.[0-9a-fA-F]+[eE][+-]?[0-9a-fA-F]+$} $VALUE]} {
				set ANSWER [tk_messageBox -type yesnocancel -icon question \
				-message "This value $VALUE is hexadecimal.\nChange to [expr $VALUE]?"]
				switch $ANSWER {
					yes {	return [Value_Check $TYPE [expr $VALUE]]}
					no {	if {[string index $VALUE 0] != "0"} {
							set FLAG [string index $VALUE 0]
						} else {
							set FLAG ""
						}
						set HEAD [expr [string first 0x $VALUE] + 2]
						set VALUE $FLAG[string range $VALUE $HEAD end]
						return [Value_Check $TYPE $VALUE]
					}
					cancel {return ERROR}
				}
			} elseif {[regexp {^[+-]?0[0-7]+$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.[0-7]+$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.?[eE][+-]?[0-7]+$} $VALUE] || \
				[regexp {^[+-]?0[0-7]+\.[0-7]+[eE][+-]?[0-7]+$} $VALUE]} {
				if {[string index $VALUE 0] != "0"} {
					set FLAG [string index $VALUE 0]
					set VALUE [string range $VALUE 1 end]
				} else {
					set FLAG ""
				}
				set ANSWER [tk_messageBox -type yesnocancel -icon question \
				-message "This value $VALUE is octal.\nChange to [expr $VALUE]?"]
				switch $ANSWER {
					yes {	return [Value_Check $TYPE $FLAG[expr $VALUE]]}
					no {	while {[string index $VALUE 0] == "0"} {
							set VALUE [string range $VALUE 1 end]
						}
						return [Value_Check $TYPE $FLAG$VALUE]
					}
					cancel {return ERROR}
				}
			} elseif {[regexp {^[+-]?0[0-9]+$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.[0-9]+$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.?[eE][+-]?[0-9]+$} $VALUE] || \
				[regexp {^[+-]?0[0-9]+\.[0-9]+[eE][+-]?[0-9]+$} $VALUE]} {
				if {[string index $VALUE 0] != "0"} {
					set FLAG [string index $VALUE 0]
					set VALUE [string range $VALUE 1 end]
				} else {
					set FLAG ""
				}
				while {[string index $VALUE 0] == "0"} {
					set VALUE [string range $VALUE 1 end]
				}
				return [Value_Check $TYPE $FLAG$VALUE]
			} elseif {[regexp {^[+-]?[0-9]+$} $VALUE]} {
				return $VALUE.0
			} elseif {[regexp {^[+-]?[0-9]+\.$} $VALUE] || \
				[regexp {^[+-]?[0-9]*\.[0-9]+$} $VALUE] || \
				[regexp {^[+-]?[0-9]+\.?[eE][+-]?[0-9]+$} $VALUE] || \
				[regexp {^[+-]?[0-9]*\.[0-9]+[eE][+-]?[0-9]+$} $VALUE]} {
				return $VALUE
			} else {
				tk_messageBox -type ok -icon question \
				-message "Check!\nParameter type doesn't match."
				return ERROR
			}
		}
		boolean -
		b {	foreach B {TRUE FALSE YES NO T F Y N 1 0} {
				if {[regexp -nocase -- $B $VALUE]} {
					return $VALUE
				}
			}
			return ERROR
		}
		char -
		c -
		string -
		s {	return $VALUE}
		default {
			tk_messageBox -type ok -icon warning \
			-message "Type is \"$TYPE\".\nWhat's this?"
			return ERROR
		}
	}
}

#	Tab key off for all
proc Tab_off {} {
	bind all <Tab> {}
	bind all <Shift-Tab> {}
}

#	Delete key bind for entry & text 
proc Del_Bind {} {
	bind Entry <Delete> {
		if [%W selection present] {
			%W delete sel.first sel.last
		} else {
			set X [expr [%W index insert] - 1]
			if {$X>= 0} {
				%W delete $X
			}
			if {[%W index @0] >= [%W index insert]} {
				set RANGE [%W xview]
				set LEFT [lindex $RANGE 0]
				set RIGHT [lindex $RANGE 1]
				%W xview moveto [expr $LEFT - ($RIGHT - $LEFT)/2.0]
			}
		}
	}
	bind Text <Delete> {
		if {[%W tag nextrange sel 1.0 end] != ""} {
			%W delete sel.first sel.last
		} elseif [%W compare insert != 1.0] {
			%W delete insert-1c
			%W see insert
		}
	}
}

#	Dialog box model
proc Message_Skeleton args {
	global FONT F_COLOR B_COLOR

	if [winfo exists .msgskeleton] {
		destroy .msgskeleton
	}

	set COUNT [llength $args]
	for {set i 0} {$i < $COUNT} {incr i} {
		switch -- [lindex $args $i] {
			"-icon" {
				incr i
				set ICON [lindex $args $i]
			}
			"-butt" -
			"-button" {
				incr i
				set BUTTON [lindex $args $i]
			}
			"-message" {
				incr i
				set MESSAGE [lindex $args $i]
			}
		}
	}

	set FOCUS [focus]
	toplevel .msgskeleton -highlightthickness 0
	wm transient .msgskeleton .
	wm title .msgskeleton "Dialog Box"
	wm protocol .msgskeleton WM_DELETE_WINDOW {
		grab release .msgskeleton
		focus $FOCUS
	}


	frame .msgskeleton.info -highlightthickness 0
	pack .msgskeleton.info -side top -fill both -expand 1

	if [info exists ICON] {
		label .msgskeleton.info.icon -bitmap $ICON -highlightthickness 0
		pack .msgskeleton.info.icon -padx 15 -pady 5 -side left
	}

	if [info exists MESSAGE] {
		message .msgskeleton.info.msg -text $MESSAGE -width 7c -highlightthickness 0
		pack .msgskeleton.info.msg -pady 5 -side left -fill both -expand 1
	}


	frame .msgskeleton.butt -highlightthickness 0
	pack .msgskeleton.butt -padx 5 -side top -fill x -expand 1

	set COUNT 0
	if [info exists BUTTON] {
		foreach i [split $BUTTON] {
			button .msgskeleton.butt.$COUNT -text " $i " -bd 3 \
				-highlightthickness 0
			pack .msgskeleton.butt.$COUNT -padx 3 -pady 3 -side left -expand 1
			incr COUNT
		}
	} else {
		button .msgskeleton.butt.$COUNT -text " OK " -bd 3 \
			-command {destroy .msgskeleton} -highlightthickness 0
		pack .msgskeleton.butt.$COUNT -padx 3 -pady 3 -side left -expand 1
	}


	wm withdraw .msgskeleton
	update
	set x [expr [winfo screenwidth .msgskeleton]/2 \
		- [winfo width .msgskeleton]/2]
	set y [expr [winfo screenheight .msgskeleton]/2 \
		- [winfo height .msgskeleton]/2]
	wm geom .msgskeleton +$x+$y
	wm deiconify .msgskeleton

	Win_Size .msgskeleton
	Tab_off
	Control
	grab set .msgskeleton
	focus $FOCUS
}

proc Another_Line STRING {
	if {[string first "\\n" $STRING] >= 0} {
		set HEAD [string first "\\n" $STRING]
		set TAIL [expr $HEAD + 2]
		incr HEAD -1
		set STRING [string range $STRING 0 $HEAD]\n[string range $STRING $TAIL end]
		set STRING [Another_Line $STRING]
	} elseif {[string first ". " $STRING] >= 0} {
		set HEAD [string first ". " $STRING]
		set TAIL [expr $HEAD + 2]
		incr HEAD -1
		set STRING [string range $STRING 0 $HEAD].\n[string range $STRING $TAIL end]
		set STRING [Another_Line $STRING]
	}
	return $STRING
}

proc Control {} {
	global CTRL

	bind Text <Control-k> {
		if [%W compare insert == {insert lineend}] {
			set CTRL(%W) "\n"
			%W delete insert
		} else {
			scan [%W index insert] %%d.%%d LINE HEAD
			set CTRL(%W) [%W get insert $LINE.end]
			%W delete insert {insert lineend}
		}
	}

	bind Entry <Control-k> {
		set CTRL(%W) [string range [%W get] [%W index insert] end]
		%W delete insert end
	}

	foreach WIDGET {Text Entry} {
		bind $WIDGET <Control-y> {
			if {[info exists CTRL(%W)]} {
				%W insert insert $CTRL(%W)
			}
		}
	}
}