Import Geant4 0.0.0 source tree
This commit is contained in:
Gabriele Cosmo
@@ -0,0 +1,4 @@
|
||||
GUI_STYLE horizontal
|
||||
GUI_POSITION left
|
||||
FORE_GROUND_COLOR #000000000
|
||||
BACK_GROUND_COLOR #d90d90d90
|
||||
@@ -0,0 +1,26 @@
|
||||
#Momo Plug-in example
|
||||
# An example of Momo/Tcl Plug-in
|
||||
#1998 July 20 H Yoshida
|
||||
|
||||
# A line starting with # is a comment line.
|
||||
# An empty line is ignored.
|
||||
# Momoseparator is a separation line between menu items.
|
||||
# Any Unix X-window applications can be invoked by describing
|
||||
# the command name and associated arguments.
|
||||
# See the example below.
|
||||
# Commands are executed in the background.
|
||||
# But & is not necessary at the end of a line.
|
||||
|
||||
#java GGE
|
||||
#java gag
|
||||
|
||||
xclock
|
||||
|
||||
Momoseparator
|
||||
xterm
|
||||
|
||||
Momoseparator
|
||||
netscape
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
FONT -adobe-times-bold-r-normal--14-140-75-75-p-77-iso8859-1
|
||||
GUI_STYLE horizontal
|
||||
GUI_POSITION left
|
||||
FORE_GROUND_COLOR #000000000
|
||||
BACK_GROUND_COLOR #947fffc28
|
||||
@@ -0,0 +1,382 @@
|
||||
## DefineColor
|
||||
## (Momo procedure)
|
||||
# Define foreground and background Color of all widgets
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1997.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc Define_Color {} {
|
||||
global env FC FR FG FB BC BR BG BB
|
||||
|
||||
if {![info exists FC]} {
|
||||
if {[lsearch [array name env] FORE_GROUND_COLOR] >= 0} {
|
||||
set FC $env(FORE_GROUND_COLOR)
|
||||
Reset_Color F
|
||||
}
|
||||
}
|
||||
|
||||
if {![info exists BC]} {
|
||||
if {[lsearch [array name env] BACK_GROUND_COLOR] >= 0} {
|
||||
set BC $env(BACK_GROUND_COLOR)
|
||||
Reset_Color B
|
||||
}
|
||||
}
|
||||
|
||||
if [winfo exists .dc] {
|
||||
raise .dc
|
||||
return
|
||||
}
|
||||
|
||||
toplevel .dc -highlightthickness 0
|
||||
wm title .dc "Define Colors"
|
||||
|
||||
frame .dc.butt -highlightthickness 0
|
||||
pack .dc.butt -side top -fill x
|
||||
|
||||
button .dc.butt.change -text "Change Color" -bd 3 \
|
||||
-highlightthickness 0 \
|
||||
-command {
|
||||
Change_Color $FC $BC .
|
||||
set env(FORE_GROUND_COLOR) $FC
|
||||
set env(BACK_GROUND_COLOR) $BC
|
||||
if [winfo exists .cf] {
|
||||
Change_Color $FC $BC .cf
|
||||
}
|
||||
if [winfo exists .se] {
|
||||
Change_Color $FC $BC .se
|
||||
Put_Env
|
||||
}
|
||||
Make_Color .dc.fg.main.color
|
||||
Make_Color .dc.bg.main.color
|
||||
}
|
||||
pack .dc.butt.change -side left
|
||||
|
||||
button .dc.butt.default -text Default -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
set FR 0
|
||||
set FG 0
|
||||
set FB 0
|
||||
Make_Color .dc.fg.main.color
|
||||
set BR 0.848
|
||||
set BG 0.848
|
||||
set BB 0.848
|
||||
Make_Color .dc.bg.main.color
|
||||
}
|
||||
pack .dc.butt.default -side left
|
||||
|
||||
button .dc.butt.cancel -text Cancel -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
destroy .dc
|
||||
}
|
||||
pack .dc.butt.cancel -side left
|
||||
|
||||
frame .dc.space -height 10 -highlightthickness 0
|
||||
pack .dc.space -side top
|
||||
|
||||
|
||||
frame .dc.fg -highlightthickness 0
|
||||
pack .dc.fg -side top -fill both
|
||||
|
||||
|
||||
frame .dc.fg.input -relief raised -bd 1 -highlightthickness 0
|
||||
pack .dc.fg.input -side top -fill x
|
||||
|
||||
label .dc.fg.input.label -text Foreground: -highlightthickness 0
|
||||
pack .dc.fg.input.label -side left
|
||||
|
||||
entry .dc.fg.input.ent -textvariable FC -state disabled -relief flat \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.input.ent -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.fg.main -relief raised -bd 1 -highlightthickness 0
|
||||
pack .dc.fg.main -side top -fill x
|
||||
|
||||
|
||||
frame .dc.fg.main.color -relief sunken -bd 1 -width 70 -height 40 \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.color -side left -padx 20 -pady 10
|
||||
|
||||
|
||||
frame .dc.fg.main.scale -highlightthickness 0
|
||||
pack .dc.fg.main.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.fg.main.scale.r -highlightthickness 0
|
||||
pack .dc.fg.main.scale.r -side top -fill x -expand 1
|
||||
|
||||
label .dc.fg.main.scale.r.label -text R -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.scale.r.label -side left
|
||||
|
||||
entry .dc.fg.main.scale.r.ent -width 5 -relief flat \
|
||||
-textvariable FR -highlightthickness 0
|
||||
pack .dc.fg.main.scale.r.ent -side left
|
||||
|
||||
scale .dc.fg.main.scale.r.scale -from 0 -to 1 -resolution 0.01 \
|
||||
-variable FR -orient horizontal -showvalue false \
|
||||
-activebackground #fff000000 -troughcolor #bcd000000 \
|
||||
-command {Make_Color .dc.fg.main.color} \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.scale.r.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.fg.main.scale.g -highlightthickness 0
|
||||
pack .dc.fg.main.scale.g -side top -fill x -expand 1
|
||||
|
||||
label .dc.fg.main.scale.g.label -text G -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.scale.g.label -side left
|
||||
|
||||
entry .dc.fg.main.scale.g.ent -width 5 -relief flat \
|
||||
-textvariable FG -highlightthickness 0
|
||||
pack .dc.fg.main.scale.g.ent -side left
|
||||
|
||||
scale .dc.fg.main.scale.g.scale -from 0 -to 1 -resolution 0.01 \
|
||||
-variable FG -orient horizontal -showvalue false \
|
||||
-activebackground #000fff000 -troughcolor #000bcd000 \
|
||||
-command {Make_Color .dc.fg.main.color} \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.scale.g.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.fg.main.scale.b -highlightthickness 0
|
||||
pack .dc.fg.main.scale.b -side top -fill x -expand 1
|
||||
|
||||
label .dc.fg.main.scale.b.label -text B -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.scale.b.label -side left
|
||||
|
||||
entry .dc.fg.main.scale.b.ent -width 5 -relief flat \
|
||||
-textvariable FB -highlightthickness 0
|
||||
pack .dc.fg.main.scale.b.ent -side left
|
||||
|
||||
scale .dc.fg.main.scale.b.scale -from 0 -to 1 -resolution 0.01 \
|
||||
-variable FB -orient horizontal -showvalue false \
|
||||
-activebackground #000000fff -troughcolor #000000bcd \
|
||||
-command {Make_Color .dc.fg.main.color} \
|
||||
-highlightthickness 0
|
||||
pack .dc.fg.main.scale.b.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.between -height 10 -highlightthickness 0
|
||||
pack .dc.between -side top -fill x
|
||||
|
||||
|
||||
frame .dc.bg -highlightthickness 0
|
||||
pack .dc.bg -side top -fill both
|
||||
|
||||
|
||||
frame .dc.bg.input -relief raised -bd 1 -highlightthickness 0
|
||||
pack .dc.bg.input -side top -fill x
|
||||
|
||||
label .dc.bg.input.label -text Background: -highlightthickness 0
|
||||
pack .dc.bg.input.label -side left
|
||||
|
||||
entry .dc.bg.input.ent -textvariable BC -state disabled \
|
||||
-relief flat -highlightthickness 0
|
||||
pack .dc.bg.input.ent -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.bg.main -relief raised -bd 1 -highlightthickness 0
|
||||
pack .dc.bg.main -side top -fill x
|
||||
|
||||
|
||||
frame .dc.bg.main.color -relief sunken -bd 1 -width 70 -height 40 \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.color -side left -padx 20 -pady 10
|
||||
|
||||
|
||||
frame .dc.bg.main.scale -highlightthickness 0
|
||||
pack .dc.bg.main.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.bg.main.scale.r -highlightthickness 0
|
||||
pack .dc.bg.main.scale.r -side top -fill x -expand 1
|
||||
|
||||
label .dc.bg.main.scale.r.label -text R -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.scale.r.label -side left
|
||||
|
||||
entry .dc.bg.main.scale.r.ent -width 5 -relief flat \
|
||||
-textvariable BR -highlightthickness 0
|
||||
pack .dc.bg.main.scale.r.ent -side left
|
||||
|
||||
scale .dc.bg.main.scale.r.scale -from 0 -to 1 -resolution 0.01 \
|
||||
-variable BR -orient horizontal -showvalue false \
|
||||
-activebackground #fff000000 -troughcolor #bcd000000 \
|
||||
-command {Make_Color .dc.bg.main.color} \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.scale.r.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.bg.main.scale.g -highlightthickness 0
|
||||
pack .dc.bg.main.scale.g -side top -fill x -expand 1
|
||||
|
||||
label .dc.bg.main.scale.g.label -text G -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.scale.g.label -side left
|
||||
|
||||
entry .dc.bg.main.scale.g.ent -width 5 -relief flat \
|
||||
-textvariable BG -highlightthickness 0
|
||||
pack .dc.bg.main.scale.g.ent -side left
|
||||
|
||||
scale .dc.bg.main.scale.g.scale -from 0 -to 1 -resolution 0.01 \
|
||||
-variable BG -orient horizontal -showvalue false \
|
||||
-activebackground #000fff000 -troughcolor #000bcd000 \
|
||||
-command {Make_Color .dc.bg.main.color} \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.scale.g.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .dc.bg.main.scale.b -highlightthickness 0
|
||||
pack .dc.bg.main.scale.b -side top -fill x -expand 1
|
||||
|
||||
label .dc.bg.main.scale.b.label -text B -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.scale.b.label -side left
|
||||
|
||||
entry .dc.bg.main.scale.b.ent -width 5 -relief flat \
|
||||
-textvariable BB -highlightthickness 0
|
||||
pack .dc.bg.main.scale.b.ent -side left
|
||||
|
||||
scale .dc.bg.main.scale.b.scale -from 0 -to 1 -resolution 0.01 \
|
||||
-variable BB -orient horizontal -showvalue false \
|
||||
-activebackground #000000fff -troughcolor #000000bcd \
|
||||
-command {Make_Color .dc.bg.main.color} \
|
||||
-highlightthickness 0
|
||||
pack .dc.bg.main.scale.b.scale -side left -fill x -expand 1
|
||||
|
||||
|
||||
# Binding
|
||||
foreach BIND {Return Tab Down Control-n} {
|
||||
bind .dc.fg.main.scale.r.ent <$BIND> {
|
||||
focus .dc.fg.main.scale.g.ent
|
||||
}
|
||||
bind .dc.fg.main.scale.g.ent <$BIND> {
|
||||
focus .dc.fg.main.scale.b.ent
|
||||
}
|
||||
bind .dc.fg.main.scale.b.ent <$BIND> {
|
||||
focus .dc.bg.main.scale.r.ent
|
||||
}
|
||||
|
||||
bind .dc.bg.main.scale.r.ent <$BIND> {
|
||||
focus .dc.bg.main.scale.g.ent
|
||||
}
|
||||
bind .dc.bg.main.scale.g.ent <$BIND> {
|
||||
focus .dc.bg.main.scale.b.ent
|
||||
}
|
||||
bind .dc.bg.main.scale.b.ent <$BIND> {
|
||||
focus .dc.fg.main.scale.r.ent
|
||||
}
|
||||
}
|
||||
|
||||
foreach BIND {Shift-Tab Up Control-p} {
|
||||
bind .dc.fg.main.scale.r.ent <$BIND> {
|
||||
focus .dc.bg.main.scale.b.ent
|
||||
}
|
||||
bind .dc.fg.main.scale.g.ent <$BIND> {
|
||||
focus .dc.fg.main.scale.r.ent
|
||||
}
|
||||
bind .dc.fg.main.scale.b.ent <$BIND> {
|
||||
focus .dc.fg.main.scale.g.ent
|
||||
}
|
||||
|
||||
bind .dc.bg.main.scale.r.ent <$BIND> {
|
||||
focus .dc.fg.main.scale.b.ent
|
||||
}
|
||||
bind .dc.bg.main.scale.g.ent <$BIND> {
|
||||
focus .dc.bg.main.scale.r.ent
|
||||
}
|
||||
bind .dc.bg.main.scale.b.ent <$BIND> {
|
||||
focus .dc.bg.main.scale.g.ent
|
||||
}
|
||||
}
|
||||
if {[lsearch [array names env] FONT] >= 0} {
|
||||
Change_Font $env(FONT) .dc
|
||||
}
|
||||
Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .dc
|
||||
Win_Size .dc
|
||||
wm resizable .dc 1 0
|
||||
Tab_off
|
||||
Control
|
||||
}
|
||||
|
||||
# Make Color (RGB)
|
||||
proc Make_Color {w args} {
|
||||
switch $w {
|
||||
.dc.fg.main.color {
|
||||
global FC FR FG FB
|
||||
regexp {^[0-9]+} [expr $FR * 4095] red
|
||||
regexp {^[0-9]+} [expr $FG * 4095] green
|
||||
regexp {^[0-9]+} [expr $FB * 4095] blue
|
||||
set FC [format #%03x%03x%03x $red $green $blue]
|
||||
$w configure -bg $FC
|
||||
}
|
||||
.dc.bg.main.color {
|
||||
global BC BR BG BB
|
||||
regexp {^[0-9]+} [expr $BR * 4095] red
|
||||
regexp {^[0-9]+} [expr $BG * 4095] green
|
||||
regexp {^[0-9]+} [expr $BB * 4095] blue
|
||||
set BC [format #%03x%03x%03x $red $green $blue]
|
||||
$w configure -bg $BC
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Set Color(FG BG) value in environment variable
|
||||
proc Set_Color {} {
|
||||
global env FC BC
|
||||
|
||||
set env(FORE_GROUND_COLOR) $FC
|
||||
set env(BACK_GROUND_COLOR) $BC
|
||||
}
|
||||
|
||||
# Reset Color default value
|
||||
proc Reset_Color SWITCH {
|
||||
global FC FR FG FB BC BR BG BB
|
||||
|
||||
switch $SWITCH {
|
||||
F {
|
||||
switch [string length $FC] {
|
||||
4 { scan $FC #%01x%01x%01x red green blue
|
||||
set FR [expr [format %f $red] / 4095.0]
|
||||
set FG [expr [format %f $green] / 4095.0]
|
||||
set FB [expr [format %f $blue] / 4095.0]
|
||||
}
|
||||
7 { scan $FC #%02x%02x%02x red green blue
|
||||
set FR [expr [format %f $red] / 4095.0]
|
||||
set FG [expr [format %f $green] / 4095.0]
|
||||
set FB [expr [format %f $blue] / 4095.0]
|
||||
}
|
||||
10 { scan $FC #%03x%03x%03x red green blue
|
||||
set FR [expr [format %f $red] / 4095.0]
|
||||
set FG [expr [format %f $green] / 4095.0]
|
||||
set FB [expr [format %f $blue] / 4095.0]
|
||||
}
|
||||
}
|
||||
}
|
||||
B {
|
||||
switch [string length $BC] {
|
||||
4 { scan $BC #%01x%01x%01x red green blue
|
||||
set BR [expr [format %f $red] / 4095.0]
|
||||
set BG [expr [format %f $green] / 4095.0]
|
||||
set BB [expr [format %f $blue] / 4095.0]
|
||||
}
|
||||
7 { scan $BC #%02x%02x%02x red green blue
|
||||
set BR [expr [format %f $red] / 4095.0]
|
||||
set BG [expr [format %f $green] / 4095.0]
|
||||
set BB [expr [format %f $blue] / 4095.0]
|
||||
}
|
||||
10 { scan $BC #%03x%03x%03x red green blue
|
||||
set BR [expr [format %f $red] / 4095.0]
|
||||
set BG [expr [format %f $green] / 4095.0]
|
||||
set BB [expr [format %f $blue] / 4095.0]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,149 @@
|
||||
## FBmain.proc
|
||||
## (Momo procedure)
|
||||
# File Browser main
|
||||
## assumes MOMOPATH/tcltk/Momo/FBtext directories
|
||||
# uses FBtext procs for file browser
|
||||
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc FBmain {} {
|
||||
global env FONT F_COLOR B_COLOR WISH HOME
|
||||
|
||||
if [winfo exists .fbm] {
|
||||
raise .fbm
|
||||
focus .fbm.name.ent
|
||||
return
|
||||
}
|
||||
|
||||
if {[lsearch [array name env] FONT] >= 0} {
|
||||
set FONT $env(FONT)
|
||||
} else {
|
||||
set FONT ""
|
||||
}
|
||||
if {[lsearch [array name env] FORE_GROUND_COLOR] >= 0} {
|
||||
set F_COLOR $env(FORE_GROUND_COLOR)
|
||||
} else {
|
||||
set F_COLOR #000000000
|
||||
}
|
||||
if {[lsearch [array names env] BACK_GROUND_COLOR] >= 0} {
|
||||
set B_COLOR $env(BACK_GROUND_COLOR)
|
||||
} else {
|
||||
set B_COLOR #d90d90d90
|
||||
}
|
||||
|
||||
toplevel .fbm -highlightthickness 0
|
||||
|
||||
frame .fbm.butt -highlightthickness 0
|
||||
pack .fbm.butt -side top -fill x
|
||||
|
||||
menubutton .fbm.butt.b0 -text Function -bd 3 -menu .fbm.butt.b0.func \
|
||||
-relief raised -highlightthickness 0
|
||||
pack .fbm.butt.b0 -side left -fill y
|
||||
|
||||
menu .fbm.butt.b0.func -tearoff 0
|
||||
.fbm.butt.b0.func add command -label Clear -command {
|
||||
.fbm.select.list see 0
|
||||
.fbm.select.list selection clear 0 end
|
||||
focus .fbm.name.ent
|
||||
.fbm.name.ent delete 0 end
|
||||
set END [string length $env(HOME)]
|
||||
set Path ~[string range $env(G_PATH) $END end]
|
||||
.fbm.info.label1 configure -text $Path
|
||||
Put_File_List .fbm
|
||||
}
|
||||
.fbm.butt.b0.func add separator
|
||||
.fbm.butt.b0.func add command -label "Close File Browser" -command {destroy .fbm}
|
||||
|
||||
|
||||
frame .fbm.info -highlightthickness 0
|
||||
pack .fbm.info -side top -fill x
|
||||
|
||||
label .fbm.info.label0 -text Directory: -anchor w -highlightthickness 0
|
||||
pack .fbm.info.label0 -side left
|
||||
|
||||
set END [string length $env(HOME)]
|
||||
set Path ~[string range $env(G_PATH) $END end]
|
||||
label .fbm.info.label1 -text $Path -anchor w -highlightthickness 0
|
||||
pack .fbm.info.label1 -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .fbm.name -highlightthickness 0
|
||||
pack .fbm.name -side top -fill x
|
||||
|
||||
label .fbm.name.label -text "File Name" -anchor w -highlightthickness 0
|
||||
pack .fbm.name.label -side left
|
||||
|
||||
entry .fbm.name.ent -highlightthickness 0
|
||||
pack .fbm.name.ent -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .fbm.select -highlightthickness 0
|
||||
pack .fbm.select -side top -fill both
|
||||
|
||||
listbox .fbm.select.list -width 20 -height 20 \
|
||||
-yscrollcommand ".fbm.select.scroll set" -highlightthickness 0
|
||||
pack .fbm.select.list -side left -fill both -expand 1
|
||||
|
||||
scrollbar .fbm.select.scroll -command ".fbm.select.list yview" \
|
||||
-highlightthickness 0
|
||||
pack .fbm.select.scroll -side left -fill y
|
||||
|
||||
|
||||
## Binding
|
||||
|
||||
bind .fbm.select.list <ButtonRelease> {
|
||||
.fbm.name.ent delete 0 end
|
||||
.fbm.name.ent insert end [selection get]
|
||||
|
||||
set NAME [.fbm.name.ent get]
|
||||
if [file isdirectory $env(G_PATH)/$NAME] {
|
||||
Change_Path $NAME
|
||||
set END [string length $env(HOME)]
|
||||
set Path ~[string range $env(G_PATH) $END end]
|
||||
.fbm.info.label1 configure -text $Path
|
||||
.fbm.butt.b0.func invoke 1
|
||||
Put_File_List .fbm
|
||||
}
|
||||
}
|
||||
bind .fbm.select.list <Double-Button> {
|
||||
set NAME [.fbm.name.ent get]
|
||||
if {$NAME != ""} {
|
||||
if [file executable $env(G_PATH)/$NAME] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nCannot open."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$NAME] {
|
||||
set env(FB_Open_File_Name) $env(G_PATH)/$NAME
|
||||
exec $WISH $HOME/FBtext/FBtext.tcl &
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
focus .fbm.name.ent
|
||||
|
||||
Put_File_List .fbm
|
||||
|
||||
|
||||
wm title .fbm "File Browser"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .fbm
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .fbm
|
||||
}
|
||||
Win_Size .fbm
|
||||
Tab_off
|
||||
Del_Bind
|
||||
Control
|
||||
}
|
||||
@@ -0,0 +1,61 @@
|
||||
## FBclear
|
||||
## (FBtext procedure)
|
||||
# Clear Log
|
||||
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1997.11.10
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
##
|
||||
|
||||
proc Clear_Log {} {
|
||||
global FONT F_COLOR B_COLOR
|
||||
if {![winfo exists .fbt.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set RANGE [.fbt.text tag range sel]
|
||||
if {$RANGE == ""} {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nClear all?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
.fbt.text delete 1.0 end
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nClear marked part?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
.fbt.text tag remove sel 1.0 end
|
||||
eval .fbt.text delete $RANGE
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,287 @@
|
||||
## GAGsavelog
|
||||
## (FBtext procedure)
|
||||
# check Before Save
|
||||
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
# 1998 July 5 GEANT4 Beta-01
|
||||
## Procedures
|
||||
|
||||
proc Before_Save {} {
|
||||
global SAVE_RANGE FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .fbt.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if {[.fbt.text tag range SEARCH_ALL_TAG] != ""} {
|
||||
Message_Skeleton -icon question -button {O.K. Cancel} \
|
||||
-message "Save only searched strings."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
set SAVE_RANGE [.fbt.text tag range SEARCH_ALL_TAG]
|
||||
Save_Window
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} elseif {[.fbt.text tag range sel] != ""} {
|
||||
Message_Skeleton -icon question -button {O.K. Cancel} \
|
||||
-message "Save only marked part."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
set SAVE_RANGE [.fbt.text tag range sel]
|
||||
Save_Window
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
set SAVE_RANGE [list 0.0 [.fbt.text index end]]
|
||||
Save_Window
|
||||
}
|
||||
}
|
||||
|
||||
# make Save window
|
||||
proc Save_Window {} {
|
||||
if [winfo exists .sl] {
|
||||
raise .sl
|
||||
focus .sl.name.ent
|
||||
return
|
||||
}
|
||||
|
||||
global FONT F_COLOR B_COLOR errorCode errorInfo env
|
||||
|
||||
set DIR $env(G_PATH)
|
||||
File_List_Skeleton .sl
|
||||
|
||||
.sl.butt.b0 configure -text "Save Text" -command {
|
||||
set Name [.sl.name.ent get]
|
||||
if {$Name != ""} {
|
||||
if [file isdirectory $env(G_PATH)/$Name] {
|
||||
cd $Name
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
.sl.info.label1 configure -text $PATH
|
||||
.sl.butt.b1 invoke
|
||||
Put_File_List .sl
|
||||
} elseif [file executable $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\n\"$Name\" is an executable file."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: Overwrite?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: New file?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
.sl.butt.b1 configure -text Clear -command {
|
||||
.sl.select.list see 0
|
||||
.sl.select.list selection clear 0 end
|
||||
focus .sl.name.ent
|
||||
.sl.name.ent delete 0 end
|
||||
set END [string length $env[HOME)]
|
||||
set PATH ~[string range [pwd] $END end]
|
||||
.sl.info.label1 configure -text $PATH
|
||||
Put_File_List .sl
|
||||
}
|
||||
|
||||
.sl.butt.b2 configure -text Cancel -command {
|
||||
destroy .sl
|
||||
}
|
||||
|
||||
|
||||
# Binding
|
||||
|
||||
bind .sl.select.list <ButtonRelease> {
|
||||
if {![catch {selection get} GET]} {
|
||||
if [file isdirectory $env(G_PATH)/$GET] {
|
||||
Change_Path $GET
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
.sl.info.label1 configure -text $PATH
|
||||
.sl.butt.b1 invoke
|
||||
Put_File_List .sl
|
||||
} else {
|
||||
.sl.name.ent delete 0 end
|
||||
.sl.name.ent insert end $GET
|
||||
}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
bind .sl.select.list <Double-Button> {
|
||||
set Name [.sl.name.ent get]
|
||||
if {$Name != ""} {
|
||||
if [file executable $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\n\"$Name\" is an executable file."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: Overwrite?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: New file?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bind .sl.select.list <Double-ButtonRelease> {}
|
||||
|
||||
bind .sl.name.ent <Return> {.sl.butt.b0 invoke}
|
||||
|
||||
bind .sl <Enter> {
|
||||
raise .sl
|
||||
focus .sl.name.ent
|
||||
}
|
||||
|
||||
|
||||
wm title .sl "Save Log"
|
||||
wm protocol .sl WM_DELETEWINDOW {
|
||||
grab release .sl
|
||||
Change_Path $DIR
|
||||
}
|
||||
Put_File_List .sl
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .sl
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .sl
|
||||
}
|
||||
Win_Size .sl
|
||||
Tab_off
|
||||
Control
|
||||
grab set .sl
|
||||
}
|
||||
|
||||
# Save log
|
||||
proc Save {} {
|
||||
global SAVE_RANGE FONT F_COLOR B_COLOR errorCode errorInfo env
|
||||
|
||||
if {![winfo exists .sl]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set Name [.sl.name.ent get]
|
||||
|
||||
if {![catch {open $env(G_PATH)/$Name w} file_ID]} {
|
||||
set LENGTH [llength $SAVE_RANGE]
|
||||
for {set i 0} {$i < $LENGTH} {incr i} {
|
||||
puts $file_ID [.fbt.text get [lindex $SAVE_RANGE $i] [lindex $SAVE_RANGE [expr $i + 1]]]
|
||||
incr i
|
||||
}
|
||||
close $file_ID
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot open."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,411 @@
|
||||
## FBsearchstring
|
||||
## (FBtext procedure)
|
||||
# make Search String window
|
||||
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1997.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
##
|
||||
proc Search_String {} {
|
||||
global FONT SEARCH REPLACE F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .fbt.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
if [winfo exists .ss] {
|
||||
raise .ss
|
||||
focus .ss.ent.search
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
toplevel .ss -highlightthickness 0
|
||||
wm title .ss "Search String"
|
||||
wm protocol .ss WM_DELETE_WINDOW {
|
||||
.fbt.text tag remove SEARCH_TAG 1.0 end
|
||||
.fbt.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
destroy .ss
|
||||
}
|
||||
|
||||
frame .ss.butt -highlightthickness 0
|
||||
pack .ss.butt -side top -fill x
|
||||
|
||||
button .ss.butt.b0 -text Search -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if {[.ss.ent.search get] != ""} {
|
||||
if {![Search]} {
|
||||
set STRING [.ss.ent.search get]
|
||||
Message_Skeleton -icon info -button O.K. \
|
||||
-message "$STRING:No match."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Input String."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
button .ss.butt.b1 -text Replace -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if {[.ss.ent.search get] != ""} {
|
||||
if {[.ss.ent.replace get] != ""} {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Chack!\nDelete [.ss.ent.search get]?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Replace
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Input String."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
|
||||
menubutton .ss.butt.b2 -text Option -menu .ss.butt.b2.set \
|
||||
-relief raised -bd 3 -highlightthickness 0
|
||||
|
||||
menu .ss.butt.b2.set -tearoff 0
|
||||
.ss.butt.b2.set add cascade -label Search -menu .ss.butt.b2.set.search
|
||||
.ss.butt.b2.set add cascade -label Replace \
|
||||
-menu .ss.butt.b2.set.replace
|
||||
|
||||
menu .ss.butt.b2.set.search -tearoff 0
|
||||
.ss.butt.b2.set.search add radiobutton -label Up \
|
||||
-variable SEARCH -value Up
|
||||
.ss.butt.b2.set.search add radiobutton -label Down \
|
||||
-variable SEARCH -value Down
|
||||
|
||||
menu .ss.butt.b2.set.replace -tearoff 0
|
||||
.ss.butt.b2.set.replace add radiobutton -label "Only One" \
|
||||
-variable REPLACE -value One
|
||||
.ss.butt.b2.set.replace add radiobutton -label "About All" \
|
||||
-variable REPLACE -value All
|
||||
|
||||
button .ss.butt.b3 -text Clear -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
.ss.ent.search delete 0 end
|
||||
.ss.ent.replace delete 0 end
|
||||
.fbt.text tag remove SEARCH_TAG 1.0 end
|
||||
.fbt.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
focus .ss.ent.search
|
||||
.fbt.text see end
|
||||
}
|
||||
button .ss.butt.b4 -text Cancel -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if [winfo exists .ss] {destroy .ss}
|
||||
.fbt.text tag remove SEARCH_TAG 1.0 end
|
||||
.fbt.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
}
|
||||
|
||||
pack .ss.butt.b0 .ss.butt.b1 .ss.butt.b2 .ss.butt.b3 .ss.butt.b4 \
|
||||
-side left -fill x
|
||||
|
||||
|
||||
frame .ss.space -highlightthickness 0
|
||||
pack .ss.space -side top -fill both -expand 1
|
||||
|
||||
|
||||
frame .ss.label -highlightthickness 0
|
||||
pack .ss.label -side left
|
||||
|
||||
label .ss.label.search -text Search -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .ss.label.search -side top -fill x
|
||||
|
||||
label .ss.label.replace -text Replace -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .ss.label.replace -side top -fill x
|
||||
|
||||
|
||||
frame .ss.ent -highlightthickness 0
|
||||
pack .ss.ent -side left -fill x -expand 1
|
||||
|
||||
entry .ss.ent.search -highlightthickness 0
|
||||
pack .ss.ent.search -side top -fill x
|
||||
|
||||
entry .ss.ent.replace -highlightthickness 0
|
||||
pack .ss.ent.replace -side top -fill x
|
||||
|
||||
|
||||
focus .ss.ent.search
|
||||
Tab_off
|
||||
Control
|
||||
|
||||
foreach BIND {Return Tab Shift-Tab Down Control-n} {
|
||||
bind .ss.ent.search <$BIND> {focus .ss.ent.replace}
|
||||
}
|
||||
foreach BIND {Return Tab Shift-Tab Up Control-p} {
|
||||
bind .ss.ent.replace <$BIND> {focus .ss.ent.search}
|
||||
}
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .ss
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .ss
|
||||
}
|
||||
Win_Size .ss
|
||||
wm resizable .ss 1 0
|
||||
}
|
||||
|
||||
# Search string on FBtext window
|
||||
proc Search {} {
|
||||
global SEARCH FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .ss.ent.search]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 1
|
||||
}
|
||||
|
||||
|
||||
.fbt.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
.fbt.text tag configure SEARCH_ALL_TAG \
|
||||
-foreground #fffffffff -background #000000000
|
||||
set CURSOL [.fbt.text index insert]
|
||||
set CUR 1.0
|
||||
set STRING [.ss.ent.search get]
|
||||
if {$STRING != ""} {
|
||||
while {[set CUR [.fbt.text search -count LENGTH -regexp --\
|
||||
$STRING $CUR end]] != ""} {
|
||||
.fbt.text tag add SEARCH_ALL_TAG \
|
||||
$CUR "$CUR + $LENGTH char"
|
||||
set CUR [.fbt.text index "$CUR + $LENGTH char"]
|
||||
}
|
||||
}
|
||||
.fbt.text index $CURSOL
|
||||
|
||||
switch $SEARCH {
|
||||
Up {
|
||||
if [Search_Up] {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
Down {
|
||||
if [Search_Down] {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
default {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Click \"Option\" button.\nAnd check search up or down."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 1
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Search mode is "up"
|
||||
proc Search_Up {} {
|
||||
.fbt.text tag remove SEARCH_TAG 1.0 end
|
||||
.fbt.text tag configure SEARCH_TAG \
|
||||
-foreground #fffffffff -background #ccc000000
|
||||
|
||||
set CURSOL [.fbt.text index insert]
|
||||
set STRING [.ss.ent.search get]
|
||||
set STOP 1.0
|
||||
|
||||
set INDEX [.fbt.text search -backwards \
|
||||
-count LENGTH -regexp -- $STRING $CURSOL $STOP]
|
||||
|
||||
if {$INDEX != ""} {
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set TAIL [expr $HEAD + $LENGTH]
|
||||
.fbt.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
.fbt.text mark set insert $LINE.$HEAD
|
||||
.fbt.text yview -pickplace insert
|
||||
} else {
|
||||
.fbt.text mark set insert 1.0
|
||||
return 0
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Search mode is "down"
|
||||
proc Search_Down {} {
|
||||
.fbt.text tag remove SEARCH_TAG 1.0 end
|
||||
.fbt.text tag configure SEARCH_TAG \
|
||||
-foreground #fffffffff -background #ccc000000
|
||||
|
||||
set CURSOL [.fbt.text index insert]
|
||||
set STRING [.ss.ent.search get]
|
||||
set STOP [.fbt.text index end]
|
||||
|
||||
set INDEX [.fbt.text search -count LENGTH -regexp \
|
||||
-- $STRING $CURSOL $STOP]
|
||||
|
||||
if {$INDEX != ""} {
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set TAIL [expr $HEAD + $LENGTH]
|
||||
.fbt.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
.fbt.text mark set insert $LINE.$TAIL
|
||||
.fbt.text yview -pickplace insert
|
||||
} else {
|
||||
.fbt.text mark set insert end
|
||||
return 0
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Replace string on FBtext window
|
||||
proc Replace {} {
|
||||
global REPLACE FONT F_COLOR B_COLOR errorCode errorInfo
|
||||
|
||||
if {![winfo exists .ss.ent.replace]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set STRING [.ss.ent.search get]
|
||||
|
||||
switch $REPLACE {
|
||||
One {
|
||||
if {![Replace_One]} {
|
||||
Message_Skeleton -icon info -button O.K. \
|
||||
-message "$STRING:No match."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
All {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nReplace all?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Replace_All
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
default {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Click \"Option\" button.\nAnd check replace one or all."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 conigure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Replace mode is "one"
|
||||
proc Replace_One {} {
|
||||
if {[set RANGE [.fbt.text tag range SEARCH_TAG]] == ""} {
|
||||
if {![Search]} {
|
||||
return 0
|
||||
} else {
|
||||
return 1
|
||||
}
|
||||
}
|
||||
|
||||
if {[.ss.ent.search get] != [eval ".fbt.text get $RANGE"]} {
|
||||
if {![Search]} {
|
||||
return 0
|
||||
} else {
|
||||
set RANGE [.fbt.text tag range SEARCH_TAG]
|
||||
}
|
||||
}
|
||||
|
||||
.fbt.text tag remove SEARCH_TAG 1.0 end
|
||||
eval .fbt.text delete $RANGE
|
||||
set INSERT [lindex [split $RANGE] 0]
|
||||
|
||||
if {![catch {.ss.ent.replace get} STRING]} {
|
||||
.fbt.text insert $INSERT $STRING
|
||||
scan $INSERT %d.%d LINE HEAD
|
||||
set TAIL [expr [string length $STRING] + $HEAD]
|
||||
.fbt.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
if {![Search]} {return 0}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Replace mode is "all"
|
||||
proc Replace_All {} {
|
||||
while {[Replace_One] != 0} {}
|
||||
}
|
||||
@@ -0,0 +1,159 @@
|
||||
## FBtext.tcl
|
||||
## Window Manager
|
||||
## called by FBmain.proc
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
wm title . "File Browser Text"
|
||||
|
||||
## Set global variable
|
||||
if [info exists env(MOMOPATH)] {
|
||||
set END [expr [string length $env(MOMOPATH)] - 1]
|
||||
if {[string index $env(MOMOPATH) $END] == "/"} {
|
||||
set HOME [strinf range $env(MOMOPATH) 0 [expr $END - 1]]
|
||||
} else {
|
||||
set HOME $env(MOMOPATH)
|
||||
}
|
||||
} else {
|
||||
set HOME $env(HOME)/Momo/tcltk
|
||||
}
|
||||
set FILE $env(FB_Open_File_Name)
|
||||
if {[lsearch [array names env] FONT] >= 0} {
|
||||
set FONT $env(FONT)
|
||||
} else {
|
||||
set FONT ""
|
||||
}
|
||||
if {[lsearch [array names env] FORE_GROUND_COLOR] >= 0} {
|
||||
set F_COLOR $env(FORE_GROUND_COLOR)
|
||||
} else {
|
||||
set F_COLOR #000000000
|
||||
}
|
||||
if {[lsearch [array names env] BACK_GROUND_COLOR] >= 0} {
|
||||
set B_COLOR $env(BACK_GROUND_COLOR)
|
||||
} else {
|
||||
set B_COLOR #d90d90d90
|
||||
}
|
||||
set SEARCH Down
|
||||
set REPLACE One
|
||||
set errorCode NONE
|
||||
set errorInfo ""
|
||||
|
||||
|
||||
## tclIndex
|
||||
set auto_path [linsert $auto_path 0 $HOME/]
|
||||
set auto_path [linsert $auto_path 0 $HOME/FBtext/]
|
||||
|
||||
|
||||
## Source
|
||||
#source $HOME/FBtext/FBsearchstring.proc
|
||||
#source $HOME/FBtext/FBclear.proc
|
||||
#source $HOME/FBtext/FBsavelog.proc
|
||||
|
||||
|
||||
## Make window
|
||||
frame .butt -highlightthickness 0
|
||||
pack .butt -side top -fill x
|
||||
|
||||
menubutton .butt.func -text Function -bd 3 -menu .butt.func.menu \
|
||||
-relief raised -highlightthickness 0
|
||||
pack .butt.func -side left -fill y
|
||||
|
||||
menu .butt.func.menu -tearoff 0
|
||||
.butt.func.menu add command -label Clear -command Clear_Log
|
||||
.butt.func.menu add command -label Save -command Before_Save
|
||||
.butt.func.menu add command -label Search -command Search_String
|
||||
.butt.func.menu add separator
|
||||
.butt.func.menu add command -label "Exit File Browser Text" -command exit
|
||||
|
||||
|
||||
frame .dir -highlightthickness 0
|
||||
pack .dir -side top -fill x
|
||||
|
||||
label .dir.lbl -text Directory: -anchor w -highlightthickness 0
|
||||
pack .dir.lbl -side left
|
||||
|
||||
set END [string length $env(HOME)]
|
||||
set Path ~[string range [pwd] $END end]
|
||||
label .dir.lbr -text $Path -anchor w -highlightthickness 0
|
||||
pack .dir.lbr -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .file -highlightthickness 0
|
||||
pack .file -side top -fill x
|
||||
|
||||
|
||||
label .file.lb -text "Load File:" -anchor w -highlightthickness 0
|
||||
pack .file.lb -side left
|
||||
|
||||
entry .file.ent -highlightthickness 0
|
||||
pack .file.ent -side left -fill x -expand 1
|
||||
|
||||
|
||||
frame .fbt -highlightthickness 0
|
||||
pack .fbt -side top -fill both -expand 1
|
||||
|
||||
text .fbt.text -width 80 -height 15 -bd 2 -yscrollcommand {.fbt.scroll set} \
|
||||
-highlightthickness 0
|
||||
pack .fbt.text -side left -fill both -expand 1
|
||||
|
||||
scrollbar .fbt.scroll -command {.fbt.text yview} -highlightthickness 0
|
||||
pack .fbt.scroll -side left -fill y
|
||||
|
||||
|
||||
frame .info -highlightthickness 0
|
||||
pack .info -side top -fill x
|
||||
|
||||
|
||||
frame .info.lbl -highlightthickness 0
|
||||
pack .info.lbl -side left
|
||||
|
||||
label .info.lbl.info -text Information -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .info.lbl.info -side top -fill x
|
||||
|
||||
|
||||
frame .info.lbr -highlightthickness 0
|
||||
pack .info.lbr -side left -fill x -expand 1
|
||||
|
||||
label .info.lbr.info -relief sunken -anchor w -highlightthickness 0
|
||||
pack .info.lbr.info -side top -fill x -expand 1
|
||||
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .
|
||||
}
|
||||
|
||||
Tab_off
|
||||
Win_Size .
|
||||
Del_Bind
|
||||
Control
|
||||
|
||||
|
||||
if {[file readable $FILE] && [file writable $FILE]} {
|
||||
.info.lbr.info configure -text "This file is readable & writable."
|
||||
set FILE_ID [open $FILE r]
|
||||
.fbt.text insert end [read $FILE_ID]
|
||||
close $FILE_ID
|
||||
} elseif [file readable $FILE] {
|
||||
.info.lbr.info configure -text "This file is readable."
|
||||
set FILE_ID [open $FILE r]
|
||||
.fbt.text insert end [read $FILE_ID]
|
||||
|
||||
.fbt.text configure -state disabled
|
||||
.butt.func.menu entryconfigure 0 -state disabled
|
||||
.butt.func.menu entryconfigure 1 -state disabled
|
||||
|
||||
close $FILE_ID
|
||||
} else {
|
||||
.info.lbr.info configure -text "This file is not readable."
|
||||
}
|
||||
|
||||
.file.ent insert end $FILE
|
||||
.file.ent configure -state disabled
|
||||
@@ -0,0 +1,29 @@
|
||||
## global variable
|
||||
env
|
||||
FONT
|
||||
F_COLOR
|
||||
B_COLOR
|
||||
SAVE_RANGE
|
||||
SEARCH
|
||||
REPLACE
|
||||
errorCode
|
||||
errorInfo
|
||||
|
||||
|
||||
## procedures
|
||||
#FBclear.proc
|
||||
Clear_Log
|
||||
|
||||
#FBsavelog.proc
|
||||
Before_Save
|
||||
Save_Window
|
||||
Save
|
||||
|
||||
#FBsearchstring.proc
|
||||
Search_String
|
||||
Search
|
||||
Search_Up
|
||||
Search_Down
|
||||
Replace
|
||||
Replace_One
|
||||
Replace_All
|
||||
@@ -0,0 +1,19 @@
|
||||
# Tcl autoload index file, version 2.0
|
||||
# This file is generated by the "auto_mkindex" command
|
||||
# and sourced to set up indexing information for one or
|
||||
# more commands. Typically each line is a command that
|
||||
# sets an element in the auto_index array, where the
|
||||
# element name is the name of a command and the value is
|
||||
# a script that loads the command.
|
||||
|
||||
set auto_index(Clear_Log) [list source [file join $dir FBclear.proc]]
|
||||
set auto_index(Search_String) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Search) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Search_Up) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Search_Down) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Replace) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Replace_One) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Replace_All) [list source [file join $dir FBsearchstring.proc]]
|
||||
set auto_index(Before_Save) [list source [file join $dir FBsavelog.proc]]
|
||||
set auto_index(Save_Window) [list source [file join $dir FBsavelog.proc]]
|
||||
set auto_index(Save) [list source [file join $dir FBsavelog.proc]]
|
||||
@@ -0,0 +1,256 @@
|
||||
## GAG.tcl
|
||||
## GAG Window Manager
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
|
||||
## 1998 July 5 Hajime
|
||||
# added "Exit GEANT4" and "Kill GEANT4" menus
|
||||
# yet to debug for invokation of non-GEANT4 executables
|
||||
# which hangs the pipe.
|
||||
# Non GEANT4 command which is suspended can be killed by the
|
||||
# new "Kill GEANT4" menu.
|
||||
## 1998 July 20 Hajime
|
||||
# renamed Exec GEANT4 => Run GEANT4
|
||||
# added Continue GEANT4
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
## 1998 December 3 Beta-03 Added protection against G4 binaries with
|
||||
# G4UIterminal session
|
||||
#
|
||||
# MOMOPATH/tcltk/Momo/GAG
|
||||
|
||||
wm title . GAG
|
||||
wm protocol . WM_DELETE_WINDOW {
|
||||
.mbutt.function.command invoke last
|
||||
}
|
||||
|
||||
## Set global variable
|
||||
if [info exists env(MOMOPATH)] {
|
||||
set END [expr [string length $env(MOMOPATH)] - 1]
|
||||
if {[string index $env(MOMOPATH) $END] == "/"} {
|
||||
set HOME [string range $env(MOMOPATH) 0 [expr $END - 1]]
|
||||
} else {
|
||||
set HOME $env(MOMOPATH)
|
||||
}
|
||||
} else {
|
||||
set HOME $env(HOME)/Momo/tcltk
|
||||
}
|
||||
if {[lsearch [array names env] FONT] >= 0} {
|
||||
set FONT $env(FONT)
|
||||
} else {
|
||||
set FONT ""
|
||||
}
|
||||
set PROMPT "GAG> "
|
||||
set Protocol "T1.0a"
|
||||
if {[lsearch [array names env] FORE_GROUND_COLOR] >= 0} {
|
||||
set F_COLOR $env(FORE_GROUND_COLOR)
|
||||
} else {
|
||||
set F_COLOR #000000000
|
||||
}
|
||||
if {[lsearch [array names env] BACK_GROUND_COLOR] >= 0} {
|
||||
set B_COLOR $env(BACK_GROUND_COLOR)
|
||||
} else {
|
||||
set B_COLOR #d90d90d90
|
||||
}
|
||||
if {![info exists env(G_PATH)]} {
|
||||
set env(G_PATH) $env(PWD)
|
||||
}
|
||||
set SEARCH Down
|
||||
set REPLACE One
|
||||
set HISTORY ""
|
||||
set errorCode NONE
|
||||
set errorInfo ""
|
||||
|
||||
## Source
|
||||
#source $HOME/GAG/GAGclearlog.proc
|
||||
#source $HOME/GAG/GAGconnect.proc
|
||||
#source $HOME/GAG/GAGdirectory.proc
|
||||
#source $HOME/GAG/GAGparam.proc
|
||||
#source $HOME/GAG/GAGsavelog.proc
|
||||
#source $HOME/GAG/GAGsearchstring.proc
|
||||
#source $HOME/Public.proc
|
||||
|
||||
## tclIndex
|
||||
set auto_path [linsert $auto_path 0 $HOME/]
|
||||
set auto_path [linsert $auto_path 0 $HOME/GAG/]
|
||||
|
||||
## Make window
|
||||
. configure -highlightthickness 0
|
||||
|
||||
frame .mbutt -relief raised -bd 1 -highlightthickness 0
|
||||
pack .mbutt -side top -fill x
|
||||
|
||||
menubutton .mbutt.function -text Function -relief raised -bd 3 \
|
||||
-menu .mbutt.function.command -highlightthickness 0
|
||||
pack .mbutt.function -side left
|
||||
|
||||
menu .mbutt.function.command -tearoff 0
|
||||
.mbutt.function.command add command -label "Run GEANT4" -command Directory
|
||||
.mbutt.function.command add command -label "Continue" -command {
|
||||
puts $GEANT_ID continue
|
||||
.log.text insert end continue\n}
|
||||
## GEANT4_ID is not yet checked 720
|
||||
|
||||
.mbutt.function.command add command -label "Exit GEANT4" -command {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Do you exit GEANT4?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
catch {puts $GEANT_ID exit}
|
||||
destroy .msgskeleton
|
||||
## exit
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {
|
||||
destroy .msgskeleton
|
||||
}
|
||||
}
|
||||
.mbutt.function.command add command -label "Kill GEANT4" -command {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Do you really kill GEANT4?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
##test
|
||||
set PID [pid $GEANT_ID]
|
||||
catch {exec kill $PID}
|
||||
destroy .msgskeleton
|
||||
## exit
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {
|
||||
destroy .msgskeleton
|
||||
}
|
||||
}
|
||||
|
||||
.mbutt.function.command add separator
|
||||
|
||||
.mbutt.function.command add command -label "Command History" -command Command_History
|
||||
.mbutt.function.command add separator
|
||||
|
||||
.mbutt.function.command add command -label "Save Log" -command Before_Save
|
||||
.mbutt.function.command add command -label "Search Log" \
|
||||
-command Search_String
|
||||
.mbutt.function.command add command -label "Clear Log" -command Clear_Log
|
||||
|
||||
.mbutt.function.command add separator
|
||||
.mbutt.function.command add command -label "Exit GAG" -command {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Do you exit GAG?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
catch {puts $GEANT_ID exit}
|
||||
catch {close $GEANT_ID}
|
||||
destroy .msgskeleton
|
||||
exit
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {
|
||||
destroy .msgskeleton
|
||||
}
|
||||
}
|
||||
|
||||
frame .space0 -height 15 -relief flat -highlightthickness 0
|
||||
pack .space0 -side top -fill x
|
||||
|
||||
|
||||
frame .log -highlightthickness 0
|
||||
pack .log -side top -fill both -expand 1
|
||||
|
||||
text .log.text -width 85 -height 15 -bd 2 -relief raised \
|
||||
-yscrollcommand {.log.scroll set} -highlightthickness 0
|
||||
pack .log.text -side left -fill both -expand 1
|
||||
|
||||
scrollbar .log.scroll -command {.log.text yview} -highlightthickness 0
|
||||
pack .log.scroll -side left -fill y
|
||||
|
||||
|
||||
frame .space1 -height 5 -relief flat -highlightthickness 0
|
||||
pack .space1 -side top -fill x
|
||||
|
||||
|
||||
frame .comm -highlightthickness 0
|
||||
pack .comm -side top -fill x
|
||||
|
||||
label .comm.label -text Command -highlightthickness 0
|
||||
pack .comm.label -side left
|
||||
|
||||
entry .comm.ent -highlightthickness 0
|
||||
pack .comm.ent -side left -fill x -expand 1
|
||||
|
||||
|
||||
label .help -relief sunken -anchor w -highlightthickness 0
|
||||
pack .help -side top -fill x
|
||||
|
||||
## Dummy Button
|
||||
button .dummy -command {
|
||||
set PARA [.comm.ent get]
|
||||
if {$PARA != ""} {
|
||||
GAG_Connect $PARA
|
||||
} else {
|
||||
.log.text insert end \n>
|
||||
.log.text see end
|
||||
}
|
||||
}
|
||||
|
||||
## Binding & Focus
|
||||
# Binding on command line
|
||||
bind .comm.ent <Return> {.dummy invoke}
|
||||
bind .comm.ent <Control-c> {}
|
||||
bind .comm.ent <Enter> {.help configure -text "direct command typein"}
|
||||
bind .comm.ent <Leave> {.help configure -text "setup phase"}
|
||||
focus .comm.ent
|
||||
|
||||
# Binding on Log board
|
||||
bind .log <Enter> {
|
||||
.help configure -text "editable log window"
|
||||
}
|
||||
bind .log <Leave> {
|
||||
.help configure -text "setup phase"
|
||||
.log.text configure -relief raised
|
||||
focus .comm.ent
|
||||
}
|
||||
|
||||
bind .log.text <Button> {
|
||||
.log.text configure -relief sunken
|
||||
focus .log.text
|
||||
}
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .
|
||||
}
|
||||
Win_Size .
|
||||
Tab_off
|
||||
Del_Bind
|
||||
Control
|
||||
|
||||
# Out put on Logboard
|
||||
.log.text insert end "GEANT4 Adaptive GUI (GAG) : 1998 December \nGAG protocol version $Protocol.\n####### GOOD LUCK TO YOUR SIMULATION! #######\n> "
|
||||
|
||||
#bind Menubutton <Leave> {
|
||||
# foreach w [winfo children .mbutt] {
|
||||
# grab release $w
|
||||
# }
|
||||
#}
|
||||
#bind Menubutton <Motion> {}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,82 @@
|
||||
## GAGclearlog.proc
|
||||
## (GAG procedure)
|
||||
## clear the whole or marked part of GEANT4 log in.log.text
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1997.11.10
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998. July 5 Beta-01
|
||||
##
|
||||
## Procedures
|
||||
# Clear Log
|
||||
|
||||
proc Clear_Log {} {
|
||||
global FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .log.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if {![winfo exists .comm.ent]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
} else {
|
||||
.comm.ent delete 0 end
|
||||
}
|
||||
|
||||
set RANGE [.log.text tag range sel]
|
||||
if {$RANGE == ""} {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nClear whole log?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
.log.text delete 1.0 end
|
||||
destroy .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {
|
||||
destroy .msgskeleton
|
||||
}
|
||||
return
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nClear marked log?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
.log.text tag remove sel 1.0 end
|
||||
eval .log.text delete $RANGE
|
||||
destroy .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {
|
||||
destroy .msgskeleton
|
||||
}
|
||||
return
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,822 @@
|
||||
## GAGconnect
|
||||
## (GAG procedure)
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
## H. Yoshida
|
||||
##
|
||||
## 1998.3.17
|
||||
## Tcl/Tk version 8.0
|
||||
### 1998.6.19 patch for "NULLCOMMAND" in example34 of Alpha07 tag H. Y.
|
||||
## 1998.7.2 Added @@Ask protocol to ask user's typed-in answer
|
||||
## in the command line (.comm.ent).
|
||||
## ==> this shall be replaced with type-in dialog
|
||||
## 1998 December 3 Add @@G4UIterminal case to close the G4UIterminal session.
|
||||
# This remedies the infinite loop of GAG for G4UIterminal session.
|
||||
|
||||
## Procedures
|
||||
# Connect to GEANT
|
||||
proc GAG_Connect COMMAND {
|
||||
global HISTORY errorCode errorInfo env
|
||||
if [file isfile $env(G_PATH)/$COMMAND] {
|
||||
global GEANT_ID FLAG_B FLAG_P FLAG_D
|
||||
if [catch {open "|$env(G_PATH)/$COMMAND 2>@stdout" a+} GEANT_ID] {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.log.text insert end $COMMAND\n$GEANT_ID\n
|
||||
} else {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.comm.label configure -text $COMMAND
|
||||
.log.text insert end $COMMAND\n
|
||||
set HISTORY ""
|
||||
if [winfo exists .ch] {
|
||||
.ch.butt.func.menu invoke 0
|
||||
}
|
||||
fconfigure $GEANT_ID -blocking off -buffering none
|
||||
fileevent $GEANT_ID readable Parse_Line
|
||||
|
||||
.dummy configure -command {
|
||||
set PARA [.comm.ent get]
|
||||
if {$PARA != ""} {
|
||||
GAG_Command $PARA
|
||||
} else {
|
||||
.log.text insert end \n$PROMPT
|
||||
.log.text see end
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
}
|
||||
}
|
||||
set FLAG_B 0
|
||||
set FLAG_P 0
|
||||
set FLAG_D 0
|
||||
GAG_Command @@GAGmodeTcl
|
||||
}
|
||||
} else {
|
||||
if {$COMMAND == "exit"} {
|
||||
.mbutt.function.command invoke last
|
||||
} elseif [catch {eval exec $COMMAND} msg0] {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
catch {eval $COMMAND} msg1
|
||||
.log.text insert end $COMMAND\n$msg1\n
|
||||
.log.text insert end "> "
|
||||
} else {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.log.text insert end $COMMAND\n$msg0\n
|
||||
.log.text insert end "> "
|
||||
}
|
||||
if [winfo exists .cd] {
|
||||
Directory
|
||||
}
|
||||
}
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
.comm.ent delete 0 end
|
||||
.log.text see end
|
||||
}
|
||||
|
||||
# Send command to GEANT
|
||||
proc GAG_Command COMMAND {
|
||||
global HISTORY GEANT_ID FONT F_COLOR B_COLOR errorCode errorInfo
|
||||
|
||||
if {$GEANT_ID == ""} {
|
||||
return 0
|
||||
}
|
||||
|
||||
if [eof $GEANT_ID] {
|
||||
catch {close $GEANT_ID}
|
||||
Command_Passive
|
||||
if {$errorCode != "NONE" && $errorInfo != ""} {
|
||||
.log.text insert end "Error.\n\n$errorCode\n\n$errorInfo\n"
|
||||
set errorInfo ""
|
||||
set errorCode NONE
|
||||
} elseif {$errorCode != "NONE"} {
|
||||
.log.text insert end "Error.\n\n$errorCode\n"
|
||||
set errorCode NONE
|
||||
} elseif {$errorInfo != ""} {
|
||||
.log.text insert end "Error.\n\n$errorInfo\n"
|
||||
set errorInfo ""
|
||||
}
|
||||
.dummy configure -command {
|
||||
set PARA [.comm.ent get]
|
||||
if {$PARA != ""} {
|
||||
GAG_Connect $PARA
|
||||
} else {
|
||||
.log.text insert end \n>
|
||||
.log.text see end
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
}
|
||||
}
|
||||
Delete_Button
|
||||
} else {
|
||||
if {$COMMAND != "exit"} {
|
||||
if {[string first "@@" $COMMAND] != 0} {
|
||||
.log.text insert end $COMMAND\n
|
||||
lappend HISTORY "$COMMAND"
|
||||
if [winfo exists .ch] {
|
||||
.ch.main.text insert end $COMMAND\n
|
||||
}
|
||||
}
|
||||
Command_Active $COMMAND
|
||||
.comm.ent delete 0 end
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Do you exit GEANT?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
set COMMAND [.comm.ent get]
|
||||
.log.text insert end $COMMAND\n
|
||||
lappend HISTORY $COMMAND
|
||||
if [winfo exists .ch] {
|
||||
.ch.main.text insert end $COMMAND\n
|
||||
}
|
||||
puts $GEANT_ID $COMMAND
|
||||
catch {close $GEANT_ID}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.dummy configure -command {
|
||||
set PARA [.comm.ent get]
|
||||
if {$PARA != ""} {
|
||||
GAG_Connect $PARA
|
||||
} else {
|
||||
.log.text insert end \n>
|
||||
.log.text see end
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
}
|
||||
}
|
||||
Delete_Button
|
||||
destroy .msgskeleton
|
||||
.comm.ent delete 0 end
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {
|
||||
destroy .msgskeleton
|
||||
.comm.ent delete 0 end
|
||||
}
|
||||
}
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
}
|
||||
.log.text see end
|
||||
}
|
||||
|
||||
# Parse Line
|
||||
proc Parse_Line {} {
|
||||
global GEANT_ID PROMPT FLAG_B FLAG_P FLAG_D FONT F_COLOR B_COLOR \
|
||||
errorCode errorInfo PARAM COMMAND_NAME Protocol DISABLE \
|
||||
COMM_RANGE
|
||||
|
||||
if {![winfo exists .log.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 0
|
||||
}
|
||||
|
||||
if [eof $GEANT_ID] {
|
||||
catch {close $GEANT_ID}
|
||||
if {$errorCode != "NONE" && $errorInfo != ""} {
|
||||
.log.text insert end "Error.\n\n$errorCode\n\n$errorInfo\n"
|
||||
set errorInfo ""
|
||||
set errorCode NONE
|
||||
} elseif {$errorCode != "NONE"} {
|
||||
.log.text insert end "Error.\n\n$errorCode\n"
|
||||
set errorCode NONE
|
||||
} elseif {$errorInfo != ""} {
|
||||
.log.text insert end "Error.\n\n$errorInfo\n"
|
||||
set errorInfo ""
|
||||
}
|
||||
.dummy configure -command {
|
||||
set PARA [.comm.ent get]
|
||||
if {$PARA != ""} {
|
||||
GAG_Connect $PARA
|
||||
} else {
|
||||
.log.text insert end \n>
|
||||
.log.text see end
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
}
|
||||
}
|
||||
Command_Passive
|
||||
Delete_Button
|
||||
.log.text see end
|
||||
.comm.ent delete 0 end
|
||||
return
|
||||
} else {
|
||||
set Line [read $GEANT_ID]
|
||||
if {$Line == "\n"} {
|
||||
.log.text insert end \n
|
||||
}
|
||||
set LINES [split $Line \n]
|
||||
}
|
||||
set n [llength $LINES]
|
||||
for {set i 0} {$i < $n} {incr i} {
|
||||
set SWITCH [lindex $LINES $i]
|
||||
set SWITCH [string trimleft $SWITCH]
|
||||
set SWITCH [lindex [split $SWITCH] 0]
|
||||
switch -- $SWITCH {
|
||||
"@@G4UIterminal" {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "This program must run in the terminal mode. Let's close this session. GAG is ready to run other programs compiled with the GAG mode."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
set PID [pid $GEANT_ID]
|
||||
catch {exec kill $PID}
|
||||
destroy .msgskeleton
|
||||
#exit
|
||||
}
|
||||
#.msgskeleton.butt.0 configure -command {
|
||||
#set UIterminalMode 1
|
||||
#focus .comm.ent
|
||||
#.comm.ent delete 0 end
|
||||
#.dummy configure -command {
|
||||
# set PARA [.comm.ent get]
|
||||
# if {$PARA != ""} {
|
||||
# GAG_Command $PARA
|
||||
# } else {
|
||||
# .log.text insert end \n$PROMPT
|
||||
# .log.text see end
|
||||
# scan [.log.text index end] %d.%d L T
|
||||
# incr L -1
|
||||
# .log.text mark set insert $L.end
|
||||
# }
|
||||
#}
|
||||
|
||||
#destroy .msgskeleton
|
||||
########
|
||||
#}
|
||||
}
|
||||
"@@maketree_start" {
|
||||
if {[llength [winfo children .mbutt]] > 1} {
|
||||
Delete_Button
|
||||
}
|
||||
set FLAG_B 1
|
||||
}
|
||||
"@@maketree_end" {
|
||||
set FLAG_B 0
|
||||
}
|
||||
"@@PROMPT" {
|
||||
set PROMPT [lindex $LINES $i]
|
||||
set HEAD [expr [string first \" $PROMPT] + 1]
|
||||
set TAIL [expr [string last \" $PROMPT] - 1]
|
||||
if {$HEAD <= $TAIL} {
|
||||
set PROMPT [string range $PROMPT $HEAD $TAIL]>
|
||||
} else {
|
||||
set PROMPT ">"
|
||||
}
|
||||
}
|
||||
"@@Ask" {
|
||||
.log.text insert end $Line
|
||||
.log.text see end
|
||||
Command_Passive
|
||||
.dummy configure -command {
|
||||
focus .comm.ent
|
||||
set ANSWER [.comm.ent get]
|
||||
if {$ANSWER != ""} {
|
||||
GAG_Command $ANSWER
|
||||
.log.text insert end \n$ANSWER
|
||||
.log.text see end
|
||||
}
|
||||
}
|
||||
}
|
||||
"@@parameter_start" {
|
||||
set FLAG_P 1
|
||||
}
|
||||
"@@parameter_end" {
|
||||
if {[info exists COMM_RANGE]} {
|
||||
unset COMM_RANGE
|
||||
}
|
||||
if {[winfo exists .[join [split $FLAG_P "/"] ""]]} {
|
||||
Put_Param $FLAG_P
|
||||
.[join [split $FLAG_P "/"] ""].main.para.list selection set 0
|
||||
focus .[join [split $FLAG_P "/"] ""].main.val.in.ent
|
||||
set NAME [selection get]
|
||||
if {[info exists PARAM($FLAG_P.$NAME.candidate)] \
|
||||
&& $PARAM($FLAG_P.$NAME.candidate) != ""} {
|
||||
Candidate $NAME
|
||||
}
|
||||
}
|
||||
set FLAG_P 0
|
||||
}
|
||||
"@@DisableListBegin" {
|
||||
if {[info exists DISABLE]} {
|
||||
unset DISABLE
|
||||
}
|
||||
set FLAG_D 1
|
||||
}
|
||||
"@@DisableListEnd" {
|
||||
if {[llength [winfo children .mbutt]] > 1} {
|
||||
Command_Disable
|
||||
}
|
||||
set FLAG_D 0
|
||||
}
|
||||
"@@ErrResult" {
|
||||
set Err [lindex $LINES $i]
|
||||
set HEAD [expr [string first \" $Err] + 1]
|
||||
set TAIL [expr [string last \" $Err] - 1]
|
||||
if {$HEAD < $TAIL} {
|
||||
set Err [string range $Err $HEAD $TAIL]
|
||||
} elseif {$HEAND == $TAIL} {
|
||||
set Err " "
|
||||
} else {
|
||||
set Err ""
|
||||
}
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message $Err
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
"@@CurrentValue" {
|
||||
set INDEX [.log.text search -backwards -regexp -- "\\?/" end 1.0]
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set W [.log.text get $LINE.[expr $HEAD + 1] $LINE.end]
|
||||
set Current [lrange [split [lindex $LINES $i]] 1 end]
|
||||
.log.text insert end $Current\n
|
||||
if {[llength $PARAM($COMMAND_NAME($W))] != [llength $Current]} {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
for {set j 0} {$j < [llength $Current]} {incr j} {
|
||||
set PARAM($COMMAND_NAME($W).[lindex $PARAM($COMMAND_NAME($W)) $j].now) [lindex $Current $j]
|
||||
}
|
||||
if {[winfo exists .$W]} {
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
}
|
||||
"@@Version" {
|
||||
if {[lindex [split [lindex $LINES $i]] 1] != $Protocol} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nNo match this protocol version."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
"@@State" {}
|
||||
"" {}
|
||||
default {
|
||||
if {$SWITCH == $PROMPT} {
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
scan [.log.text index $L.end] %d.%d L T
|
||||
if {[.log.text get $L.0 $L.$T] != $PROMPT} {
|
||||
.log.text insert end $PROMPT
|
||||
Command_Passive
|
||||
}
|
||||
if {[string first "@@parameter_start" [lindex $LINES $i]] > 0} {
|
||||
set FLAG_P 1
|
||||
} elseif {[string first "@@maketree_start" [lindex $LINES $i]] > 0} {
|
||||
set FLAG_B 1
|
||||
} elseif {[string first "@@parameter_end" [lindex $LINES $i]] > 0} {
|
||||
set FLAG_P 0
|
||||
} elseif {[string first "@@maketree_end" [lindex $LINES $i]] > 0} {
|
||||
set FLAG_B 0
|
||||
}
|
||||
.log.text see end
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
} elseif {$FLAG_B == 1 && $FLAG_P != "0"} {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Error!\nCheck this GEANT code."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif {$FLAG_D == 1} {
|
||||
set DISABLE [lappend DISABLE $SWITCH]
|
||||
} elseif {$FLAG_B == 1} {
|
||||
Make_Button [lindex $LINES $i]
|
||||
} elseif {$FLAG_P != "0"} {
|
||||
Make_Param [lindex $LINES $i]
|
||||
} else {
|
||||
.log.text insert end [lindex $LINES $i]\n
|
||||
.log.text see end
|
||||
scan [.log.text index end] %d.%d L T
|
||||
incr L -1
|
||||
.log.text mark set insert $L.end
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if {[string index $Line [expr [string length $Line] -1]] != "\n"} {
|
||||
if {$Line != "\n"} {
|
||||
.log.text delete insert
|
||||
.log.text see insert
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Analyze command & Make button
|
||||
proc Make_Button LINE {
|
||||
global FONT F_COLOR B_COLOR HELP
|
||||
|
||||
if {![winfo exists .mbutt]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 0
|
||||
}
|
||||
if {![winfo exists .help]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 0
|
||||
}
|
||||
|
||||
set CUT [string first "@@" $LINE]
|
||||
if {$CUT >= 0} {
|
||||
set SWITCH [string range $LINE $CUT end]
|
||||
set CUT [string first " " $SWITCH]
|
||||
if {$CUT >= 0} {
|
||||
set SWITCH [string range $SWITCH 0 [expr $CUT - 1]]
|
||||
}
|
||||
} else {
|
||||
set SWITCH ""
|
||||
}
|
||||
|
||||
switch -glob -- $SWITCH {
|
||||
"@@title" {
|
||||
set CUT [string first "\"" $LINE]
|
||||
if {$CUT >= 0} {
|
||||
set HELP_STRING [string range $LINE [expr $CUT + 1] end]
|
||||
set HELP_STRING [Another_Line $HELP_STRING]
|
||||
set CUT [string last "\"" $HELP_STRING]
|
||||
if {$CUT >= 0} {
|
||||
set HELP_STRING [string range $HELP_STRING 0 [expr $CUT - 1]]
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Cannot find last \".\n$HELP_STRING"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
set HELP_STRING ""
|
||||
}
|
||||
set LINE [string trim [lindex [split $LINE] 0] /]
|
||||
if {[string first / $LINE] >= 0} {
|
||||
set LINE [string trim [lindex [split $LINE] 0] /]
|
||||
set CUT [string first / $LINE]
|
||||
set HEAD [string range $LINE 0 [expr $CUT - 1]]
|
||||
set PATH [string range $LINE $CUT end]
|
||||
set CUT [string last / $PATH]
|
||||
set TAIL [string range $PATH [expr $CUT + 1] end]
|
||||
set PATH [string range $PATH 0 [expr $CUT -1]]
|
||||
set PATH [join [split $PATH "/"] "."]
|
||||
set W .mbutt.$HEAD.menu$PATH
|
||||
set LAST [$W index last]
|
||||
set HELP($W.$LAST) $HELP_STRING
|
||||
} else {
|
||||
set W .mbutt.$LINE
|
||||
set HELP($W) $HELP_STRING
|
||||
}
|
||||
}
|
||||
"@@cascade" {
|
||||
set LINE [string trim [lindex [split $LINE] 0] /]
|
||||
set CUT [string first / $LINE]
|
||||
set HEAD [string range $LINE 0 [expr $CUT - 1]]
|
||||
set PATH [string range $LINE $CUT end]
|
||||
set CUT [string last / $PATH]
|
||||
set TAIL [string range $PATH [expr $CUT + 1] end]
|
||||
set PATH [string range $PATH 0 [expr $CUT -1]]
|
||||
set PATH [join [split $PATH "/"] "."]
|
||||
set W .mbutt.$HEAD.menu$PATH
|
||||
$W add cascade -label $TAIL -menu $W.$TAIL
|
||||
menu $W.$TAIL -tearoff 0
|
||||
set HELP($W.$TAIL.none) ""
|
||||
bind $W.$TAIL <Motion> {
|
||||
.help configure -text $HELP(%W.[%W index active])
|
||||
}
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT $W.$TAIL
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR $W.$TAIL
|
||||
}
|
||||
}
|
||||
"@@command" {
|
||||
set LINE [string trim [lindex [split $LINE] 0] /]
|
||||
set CUT [string first / $LINE]
|
||||
set HEAD [string range $LINE 0 [expr $CUT - 1]]
|
||||
set PATH [string range $LINE $CUT end]
|
||||
set CUT [string last / $PATH]
|
||||
set TAIL [string range $PATH [expr $CUT + 1] end]
|
||||
set PATH [string range $PATH 0 [expr $CUT -1]]
|
||||
set PATH [join [split $PATH "/"] "."]
|
||||
set W .mbutt.$HEAD.menu$PATH
|
||||
###### DEBUG 6-19
|
||||
set NULLCOMMAND [string match *..* $W]
|
||||
if {$NULLCOMMAND == 0} {
|
||||
$W add command -label $TAIL -command "Param /$LINE"
|
||||
} else {
|
||||
.log.text insert end "Invalid command: $LINE\n"
|
||||
}
|
||||
##### DEBUG 6-19 end
|
||||
}
|
||||
default {
|
||||
set LINE [string trim $LINE /]
|
||||
if {[string first / $LINE] >= 0} {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Error!\nCheck this GEANT code.\n\n$LINE"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
menubutton .mbutt.$LINE -text $LINE -relief raised \
|
||||
-bd 3 -menu .mbutt.$LINE.menu \
|
||||
-highlightthickness 0
|
||||
pack .mbutt.$LINE -side left
|
||||
|
||||
menu .mbutt.$LINE.menu -tearoff 0
|
||||
set HELP(.mbutt.$LINE.menu.none) ""
|
||||
bind .mbutt.$LINE <Enter> {
|
||||
if [info exists HELP(%W)] {
|
||||
.help configure -text $HELP(%W)
|
||||
}
|
||||
}
|
||||
bind .mbutt.$LINE <Leave> {
|
||||
.help configure -text ""
|
||||
}
|
||||
bind .mbutt.$LINE.menu <Motion> {
|
||||
if [info exists HELP(%W.[%W index active])] {
|
||||
.help configure -text $HELP(%W.[%W index active])
|
||||
}
|
||||
}
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .mbutt.$LINE
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .mbutt.$LINE
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Delete Button
|
||||
proc Delete_Button {} {
|
||||
global PARAM COMMAND_NAME FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .mbutt]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 0
|
||||
}
|
||||
|
||||
if [info exists PARAM] {
|
||||
unset PARAM
|
||||
}
|
||||
if [info exists COMMAND_NAME] {
|
||||
unset COMMAND_NAME
|
||||
}
|
||||
|
||||
eval destroy [lrange [winfo children .mbutt] 1 end]
|
||||
.comm.label configure -text Command
|
||||
.log.text insert end "> "
|
||||
.log.text see end
|
||||
|
||||
foreach W [winfo children .] {
|
||||
switch -- $W {
|
||||
\.msgskeleton -
|
||||
\.mbutt -
|
||||
\.space0 -
|
||||
\.log -
|
||||
\.space1 -
|
||||
\.comm -
|
||||
\.help -
|
||||
\.dummy -
|
||||
\.cd -
|
||||
\.ch -
|
||||
\.ss -
|
||||
\.sl {}
|
||||
default {
|
||||
destroy $W
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Command button state is normal
|
||||
proc Command_Passive {} {
|
||||
. configure -cursor ""
|
||||
.log.text configure -cursor ""
|
||||
.comm.ent configure -cursor "" -state normal
|
||||
.comm.ent delete 0 end
|
||||
|
||||
if [winfo exists .ch] {
|
||||
.ch.main.text configure -cursor "" -state normal
|
||||
}
|
||||
|
||||
.mbutt.function.command entryconfigure last -state normal
|
||||
|
||||
foreach W [lrange [winfo children .mbutt] 1 end] {
|
||||
$W configure -state normal
|
||||
}
|
||||
|
||||
foreach W [winfo children .] {
|
||||
switch -- $W {
|
||||
\.msgskeleton -
|
||||
\.mbutt -
|
||||
\.space0 -
|
||||
\.log -
|
||||
\.space1 -
|
||||
\.comm -
|
||||
\.help -
|
||||
\.dummy -
|
||||
\.cd -
|
||||
\.ch -
|
||||
\.ss -
|
||||
\.sl {}
|
||||
default {
|
||||
$W.butt.comm configure -state normal
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Command button state is disable
|
||||
proc Command_Active COMMAND {
|
||||
global GEANT_ID
|
||||
puts $GEANT_ID $COMMAND
|
||||
|
||||
. configure -cursor watch
|
||||
.log.text configure -cursor watch
|
||||
.comm.ent configure -cursor watch -state disabled
|
||||
|
||||
if [winfo exists .ch] {
|
||||
.ch.main.text configure -cursor watch -state disabled
|
||||
}
|
||||
|
||||
.mbutt.function configure -cursor ""
|
||||
.mbutt.function.command entryconfigure last -state disabled
|
||||
|
||||
foreach W [lrange [winfo children .mbutt] 1 end] {
|
||||
$W configure -state disabled
|
||||
}
|
||||
|
||||
foreach W [winfo children .] {
|
||||
switch -- $W {
|
||||
\.msgskeleton -
|
||||
\.mbutt -
|
||||
\.space0 -
|
||||
\.log -
|
||||
\.space1 -
|
||||
\.comm -
|
||||
\.help -
|
||||
\.dummy -
|
||||
\.cd -
|
||||
\.ch -
|
||||
\.ss -
|
||||
\.sl {}
|
||||
default {
|
||||
$W.butt.comm configure -state disabled
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Disable menu button
|
||||
proc Command_Disable {} {
|
||||
global DISABLE FONT F_COLOR B_COLOR
|
||||
|
||||
if {[llength [winfo children .mbutt]] <= 1} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
|
||||
foreach LIST $DISABLE {
|
||||
set END [expr [string length $LIST] - 1]
|
||||
if {[string index $LIST $END] == "/"} {
|
||||
incr END -1
|
||||
set LIST [string range $LIST 0 $END]
|
||||
}
|
||||
|
||||
set END [string last "\/" $LIST]
|
||||
if {$END == 0} {
|
||||
set LIST [join [split $LIST "/"] "."]
|
||||
$LIST configure -state disabled
|
||||
return
|
||||
} elseif {$END < 0} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!Check disable command list."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
|
||||
set Category [string range $LIST 0 [expr $END -1]]
|
||||
set Label [string range $LIST [expr $END + 1] end]
|
||||
set Category [join [split $Category "/"] "."]
|
||||
set Category [join [linsert [split $Category "\."] 2 menu] "\."]
|
||||
.mbutt$Category entryconfigure [.mbutt$Category index $Label] -state disabled
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,138 @@
|
||||
## GAGdirectory
|
||||
## (GAG procedure)
|
||||
## Procedures
|
||||
# make "cd" command window
|
||||
##
|
||||
# displaying current dir name only
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc Directory {} {
|
||||
global FONT F_COLOR B_COLOR env errorCode errorInfo
|
||||
|
||||
if {![winfo exists .comm.ent]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $BCOLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if [winfo exists .cd] {
|
||||
raise .cd
|
||||
focus .cd.name.ent
|
||||
.cd.butt.b1 invoke
|
||||
Put_File_List .cd
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
##supress .cd.info.label1 configure -text $PATH
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.cd.info.label1 configure -text $cdir
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
File_List_Skeleton .cd
|
||||
|
||||
.cd.butt.b0 configure -text "Change directory" -command {
|
||||
set NAME [.cd.name.ent get]
|
||||
if [file isdirectory $env(G_PATH)/$NAME] {
|
||||
Change_Path $NAME
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
##suppress .cd.info.label1 configure -text $PATH
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.cd.info.label1 configure -text $cdir
|
||||
|
||||
.cd.butt.b1 invoke
|
||||
Put_File_List .cd
|
||||
if [winfo exists .controlexecute] {
|
||||
.controlexecute.main.dir.current configure -text $PATH
|
||||
Put_File_List .controlexecute.main.dir
|
||||
}
|
||||
} elseif [file executable $env(G_PATH)/$NAME] {
|
||||
.comm.ent delete 0 end
|
||||
.comm.ent insert end $NAME
|
||||
.cd.name.ent delete 0 end
|
||||
}
|
||||
}
|
||||
|
||||
.cd.butt.b1 configure -text Clear -command {
|
||||
.cd.select.list see 0
|
||||
.cd.select.list selection clear 0 end
|
||||
focus .cd.name.ent
|
||||
.cd.name.ent delete 0 end
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
##supress .cd.info.label1 configure -text $PATH
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.cd.info.label1 configure -text $cdir
|
||||
Put_File_List .cd
|
||||
}
|
||||
|
||||
.cd.butt.b2 configure -text Cancel -command {
|
||||
if [winfo exists .cd] {
|
||||
destroy .cd
|
||||
}
|
||||
}
|
||||
|
||||
.cd.name.label configure -text Directory
|
||||
|
||||
.cd.info.label0 configure -text "Current Dir: "
|
||||
|
||||
# Binding
|
||||
bind .cd.select.list <ButtonRelease> {
|
||||
catch {.cd.name.ent delete 0 end}
|
||||
catch {.cd.name.ent insert end [selection get]}
|
||||
.cd.butt.b0 invoke
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
}
|
||||
|
||||
bind .cd.select.list <Double-Button> {
|
||||
if {[.comm.ent get] != ""} {
|
||||
.dummy invoke
|
||||
raise .
|
||||
focus .comm.ent
|
||||
}
|
||||
}
|
||||
|
||||
bind .cd.select.list <Double-ButtonRelease> {
|
||||
.comm.ent delete 0 end
|
||||
}
|
||||
|
||||
bind .cd.name.ent <Return> {.cd.butt.b0 invoke}
|
||||
|
||||
bind .cd <Enter> {
|
||||
raise .cd
|
||||
focus .cd.name.ent
|
||||
}
|
||||
|
||||
wm title .cd "File Chooser"
|
||||
Put_File_List .cd
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .cd
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .cd
|
||||
}
|
||||
Win_Size .cd
|
||||
Tab_off
|
||||
Control
|
||||
}
|
||||
@@ -0,0 +1,763 @@
|
||||
## GAGhistory
|
||||
## (GAG procedure)
|
||||
## Procedures
|
||||
## make Command History window, execute a memorised command, save to a file
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc Command_History {} {
|
||||
global HISTORY FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .log.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Chnage_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists HISTORY]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Chnage_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if [winfo exists .ch] {
|
||||
raise .ch
|
||||
focus .ch.main.text
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
toplevel .ch -highlightthickness 0
|
||||
wm title .ch "Command History Manager"
|
||||
wm protocol .ch WM_DELETEWINDOW {
|
||||
.comm.ent delete 0 end
|
||||
}
|
||||
|
||||
|
||||
frame .ch.butt -highlightthickness 0
|
||||
pack .ch.butt -side top -fill x
|
||||
|
||||
menubutton .ch.butt.func -text Function -menu .ch.butt.func.menu \
|
||||
-bd 3 -relief raised -highlightthickness 0
|
||||
pack .ch.butt.func -side left
|
||||
|
||||
menu .ch.butt.func.menu -tearoff 0
|
||||
.ch.butt.func.menu add command -label Clear -command {
|
||||
.ch.main.text delete 0.0 end
|
||||
.comm.ent delete 0 end
|
||||
}
|
||||
.ch.butt.func.menu add command -label Restore -command {
|
||||
.ch.butt.func.menu invoke 0
|
||||
foreach comm $HISTORY {
|
||||
.ch.main.text insert end $comm\n
|
||||
}
|
||||
}
|
||||
.ch.butt.func.menu add command -label "Save command history" \
|
||||
-command CH_Save_Window
|
||||
.ch.butt.func.menu add command -label Search -command Search_String_CH
|
||||
.ch.butt.func.menu add separator
|
||||
.ch.butt.func.menu add command -label "Close command history manager" \
|
||||
-command {destroy .ch}
|
||||
|
||||
|
||||
frame .ch.main -highlightthickness 0
|
||||
pack .ch.main -side top -fill both -expand 1
|
||||
|
||||
text .ch.main.text -width 50 -bd 2 -relief sunken \
|
||||
-yscrollcommand ".ch.main.scroll set" -highlightthickness 0
|
||||
pack .ch.main.text -side left -fill both -expand 1
|
||||
|
||||
scrollbar .ch.main.scroll -command ".ch.main.text yview" \
|
||||
-highlightthickness 0
|
||||
pack .ch.main.scroll -side left -fill y
|
||||
|
||||
|
||||
# Binding
|
||||
|
||||
bind .ch.main.text <ButtonRelease> {
|
||||
scan [.ch.main.text index insert] %%d.%%d LINE HEAD
|
||||
.comm.ent delete 0 end
|
||||
.comm.ent insert end [.ch.main.text get $LINE.0 $LINE.end]
|
||||
}
|
||||
|
||||
bind .ch.main.text <Double-Button> {
|
||||
scan [.ch.main.text index insert] %%d.%%d LINE HEAD
|
||||
.comm.ent delete 0 end
|
||||
.comm.ent insert end [.ch.main.text get $LINE.0 $LINE.end]
|
||||
.dummy invoke
|
||||
}
|
||||
|
||||
bind .ch.main.text <Double-ButtonRelease> {.comm.ent delete 0 end}
|
||||
|
||||
bind .ch <Enter> {
|
||||
focus .ch.main.text
|
||||
}
|
||||
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .ch
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .ch
|
||||
}
|
||||
Win_Size .ch
|
||||
Tab_off
|
||||
Control
|
||||
foreach comm $HISTORY {
|
||||
.ch.main.text insert end $comm\n
|
||||
}
|
||||
}
|
||||
|
||||
# make Save Command History window
|
||||
proc CH_Save_Window {} {
|
||||
global FONT F_COLOR B_COLOR errorCode errorInfo env
|
||||
|
||||
if [winfo exists .sach] {
|
||||
raise .sach
|
||||
focus .sach.name.ent
|
||||
return
|
||||
}
|
||||
|
||||
set DIR $env(G_PATH)
|
||||
File_List_Skeleton .sach
|
||||
|
||||
.sach.butt.b0 configure -text "Save command history" -command {
|
||||
set Name [.sach.name.ent get]
|
||||
if {$Name != ""} {
|
||||
if [file isdirectory $env(G_PATH)/$Name] {
|
||||
Change_Path $Name
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
### display the current dir name
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.sach.info.label1 configure -text $cdir
|
||||
|
||||
## .sach.info.label1 configure -text $PATH
|
||||
.sach.butt.b1 invoke
|
||||
Put_File_List .sach
|
||||
} elseif [file executable $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\n\"$Name\"is an executable file."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: Overwrite?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
CH_Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: New file?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
CH_Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
.sach.butt.b1 configure -text Clear -command {
|
||||
.sach.select.list see 0
|
||||
.sach.select.list selection clear 0 end
|
||||
focus .sach.name.ent
|
||||
.sach.name.ent delete 0 end
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
### display the current dir name
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.sach.info.label1 configure -text $cdir
|
||||
## .sach.info.label1 configure -text $PATH
|
||||
Put_File_List .sach
|
||||
}
|
||||
|
||||
.sach.butt.b2 configure -text Cancel -command {
|
||||
destroy .sach
|
||||
}
|
||||
|
||||
|
||||
# Binding
|
||||
|
||||
bind .sach.select.list <ButtonRelease> {
|
||||
if {![catch {selection get} GET]} {
|
||||
if [file isdirectory $env(G_PATH)/$GET] {
|
||||
Change_Path $GET
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
### display the current dir name
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.sach.info.label1 configure -text $cdir
|
||||
## .sach.info.label1 configure -text $PATH
|
||||
.sach.butt.b1 invoke
|
||||
Put_File_List .sach
|
||||
} else {
|
||||
.sach.name.ent delete 0 end
|
||||
.sach.name.ent insert end $GET
|
||||
}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
bind .sach.select.list <Double-Button> {
|
||||
set Name [.sach.name.ent get]
|
||||
if {$Name != ""} {
|
||||
if [file executable $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\n\"$Name\"is an executable file."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: Overwrite?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
CH_Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: New file?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
CH_Save
|
||||
}
|
||||
.msgekeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bind .sach.select.list <Double-ButtonRelease> {}
|
||||
|
||||
bind .sach.name.ent <Return> {.sach.butt.b0 invoke}
|
||||
|
||||
bind .sach <Enter> {
|
||||
raise .sach
|
||||
focus .sach.name.ent
|
||||
}
|
||||
|
||||
|
||||
wm title .sach "Save command history"
|
||||
wm protocol .sach WM_DELETEWINDOW {
|
||||
grab release .sach
|
||||
Change_Path $DIR
|
||||
}
|
||||
Put_File_List .sach
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .sach
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .sach
|
||||
}
|
||||
Win_Size .sach
|
||||
Tab_off
|
||||
Control
|
||||
grab set .sach
|
||||
}
|
||||
|
||||
# save Command Histry & Check file open
|
||||
proc CH_Save {} {
|
||||
global FONT F_COLOR B_COLOR errorCode errorInfo env
|
||||
|
||||
if {![winfo exists .sach]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set Name [.sach.name.ent get]
|
||||
|
||||
if {![catch {open $env(G_PATH)/$Name w} file_ID]} {
|
||||
puts $file_ID [.ch.main.text get 0.0 end]
|
||||
close $file_ID
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot open."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
# make Search Command History window
|
||||
proc Search_String_CH {} {
|
||||
global FONT SEARCH REPLACE F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .ch.main.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if [winfo exists .sech] {
|
||||
raise .sech
|
||||
focus .sech.ent.search
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
toplevel .sech -highlightthickness 0
|
||||
wm title .sech "Search Command History"
|
||||
wm protocol .sech WM_DELETE_WINDOW {
|
||||
.ch.main.text tag remove SEARCH_TAG 1.0 end
|
||||
.ch.main.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
destroy .sech
|
||||
}
|
||||
|
||||
frame .sech.butt -highlightthickness 0
|
||||
pack .sech.butt -side top -fill x
|
||||
|
||||
button .sech.butt.b0 -text Search -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if {[.sech.ent.search get] != ""} {
|
||||
if {![Search_CH]} {
|
||||
set STRING [.sech.ent.search get]
|
||||
Message_Skeleton -icon info -button O.K. \
|
||||
-message "$STRING:No match."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Input String."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
button .sech.butt.b1 -text Replace -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if {[.sech.ent.search get] != ""} {
|
||||
if {[.sech.ent.replace get] == ""} {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nDelete [.sech.ent.search get]?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Replace_CH
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Replace_CH
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Input String."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
|
||||
menubutton .sech.butt.b2 -text Option -menu .sech.butt.b2.set \
|
||||
-relief raised -bd 3 -highlightthickness 0
|
||||
|
||||
menu .sech.butt.b2.set -tearoff 0
|
||||
.sech.butt.b2.set add cascade -label Search -menu .sech.butt.b2.set.search
|
||||
.sech.butt.b2.set add cascade -label Replace \
|
||||
-menu .sech.butt.b2.set.replace
|
||||
|
||||
menu .sech.butt.b2.set.search -tearoff 0
|
||||
.sech.butt.b2.set.search add radiobutton -label Up \
|
||||
-variable SEARCH -value Up
|
||||
.sech.butt.b2.set.search add radiobutton -label Down \
|
||||
-variable SEARCH -value Down
|
||||
|
||||
menu .sech.butt.b2.set.replace -tearoff 0
|
||||
.sech.butt.b2.set.replace add radiobutton -label "Only One" \
|
||||
-variable REPLACE -value One
|
||||
.sech.butt.b2.set.replace add radiobutton -label "About All" \
|
||||
-variable REPLACE -value All
|
||||
|
||||
button .sech.butt.b3 -text Clear -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
.sech.ent.search delete 0 end
|
||||
.sech.ent.replace delete 0 end
|
||||
.ch.main.text tag remove SEARCH_TAG 1.0 end
|
||||
.ch.main.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
focus .sech.ent.search
|
||||
.ch.main.text see end
|
||||
}
|
||||
button .sech.butt.b4 -text Cancel -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if [winfo exists .sech] {destroy .sech}
|
||||
.ch.main.text tag remove SEARCH_TAG 1.0 end
|
||||
.ch.main.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
}
|
||||
|
||||
pack .sech.butt.b0 .sech.butt.b1 .sech.butt.b2 \
|
||||
.sech.butt.b3 .sech.butt.b4 -side left -fill x
|
||||
|
||||
|
||||
frame .sech.space -highlightthickness 0
|
||||
pack .sech.space -side top -fill both -expand 1
|
||||
|
||||
|
||||
frame .sech.label -highlightthickness 0
|
||||
pack .sech.label -side left
|
||||
|
||||
label .sech.label.search -text Search -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .sech.label.search -side top -fill x
|
||||
|
||||
label .sech.label.replace -text Replace -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .sech.label.replace -side top -fill x
|
||||
|
||||
|
||||
frame .sech.ent -highlightthickness 0
|
||||
pack .sech.ent -side left -fill x -expand 1
|
||||
|
||||
entry .sech.ent.search -highlightthickness 0
|
||||
pack .sech.ent.search -side top -fill x
|
||||
|
||||
entry .sech.ent.replace -highlightthickness 0
|
||||
pack .sech.ent.replace -side top -fill x
|
||||
|
||||
|
||||
focus .sech.ent.search
|
||||
Tab_off
|
||||
Control
|
||||
|
||||
foreach BIND {Return Tab Shift-Tab Down Control-n} {
|
||||
bind .sech.ent.search <$BIND> {focus .sech.ent.replace}
|
||||
}
|
||||
foreach BIND {Return Tab Shift-Tab Up Control-p} {
|
||||
bind .sech.ent.replace <$BIND> {focus .sech.ent.search}
|
||||
}
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .sech
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .sech
|
||||
}
|
||||
Win_Size .sech
|
||||
wm resizable .sech 1 0
|
||||
}
|
||||
|
||||
# Search string on Command Histry window
|
||||
proc Search_CH {} {
|
||||
global SEARCH FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .sech.ent.search]} {
|
||||
Message_Skeleton -icon warning -button O.K.\
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 1
|
||||
}
|
||||
|
||||
|
||||
.ch.main.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
.ch.main.text tag configure SEARCH_ALL_TAG \
|
||||
-foreground #fffffffff -background #000000000
|
||||
set CURSOL [.ch.main.text index insert]
|
||||
set CUR 1.0
|
||||
set STRING [.sech.ent.search get]
|
||||
if {$STRING != ""} {
|
||||
while {[set CUR [.ch.main.text search -count LENGTH -regexp --\
|
||||
$STRING $CUR end]] != ""} {
|
||||
.ch.main.text tag add SEARCH_ALL_TAG \
|
||||
$CUR "$CUR + $LENGTH char"
|
||||
set CUR [.ch.main.text index "$CUR + $LENGTH char"]
|
||||
}
|
||||
}
|
||||
.ch.main.text index $CURSOL
|
||||
|
||||
switch $SEARCH {
|
||||
Up {
|
||||
if [Search_Up_CH] {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
Down {
|
||||
if [Search_Down_CH] {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
default {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Click \"Option\" button.\nAnd check search up or down."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Chane_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 1
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Search mode is "up"
|
||||
proc Search_Up_CH {} {
|
||||
.ch.main.text tag remove SEARCH_TAG 1.0 end
|
||||
.ch.main.text tag configure SEARCH_TAG \
|
||||
-foreground #fffffffff -background #ccc000000
|
||||
|
||||
set CURSOL [.ch.main.text index insert]
|
||||
set STRING [.sech.ent.search get]
|
||||
set STOP 1.0
|
||||
|
||||
set INDEX [.ch.main.text search -backwards \
|
||||
-count LENGTH -regexp -- $STRING $CURSOL $STOP]
|
||||
|
||||
if {$INDEX != ""} {
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set TAIL [expr $HEAD + $LENGTH]
|
||||
.ch.main.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
.ch.main.text mark set insert $LINE.$HEAD
|
||||
.ch.main.text yview -pickplace insert
|
||||
} else {
|
||||
.ch.main.text mark set insert 1.0
|
||||
return 0
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Search mode is "down"
|
||||
proc Search_Down_CH {} {
|
||||
.ch.main.text tag remove SEARCH_TAG 1.0 end
|
||||
.ch.main.text tag configure SEARCH_TAG \
|
||||
-foreground #fffffffff -background #ccc000000
|
||||
|
||||
set CURSOL [.ch.main.text index insert]
|
||||
set STRING [.sech.ent.search get]
|
||||
set STOP [.ch.main.text index end]
|
||||
|
||||
set INDEX [.ch.main.text search -count LENGTH -regexp \
|
||||
-- $STRING $CURSOL $STOP]
|
||||
|
||||
if {$INDEX != ""} {
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set TAIL [expr $HEAD + $LENGTH]
|
||||
.ch.main.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
.ch.main.text mark set insert $LINE.$TAIL
|
||||
.ch.main.text yview -pickplace insert
|
||||
} else {
|
||||
.ch.main.text mark set insert end
|
||||
return 0
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Replace string on Command Histry window
|
||||
proc Replace_CH {} {
|
||||
global REPLACE FONT F_COLOR B_COLOR errorCode errorInfo
|
||||
|
||||
if {![winfo exists .sech.ent.replace]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set STRING [.sech.ent.search get]
|
||||
|
||||
switch $REPLACE {
|
||||
One {
|
||||
if {![Replace_One_CH]} {
|
||||
Message_Skeleton -icon info -button O.K. \
|
||||
-message "$STRING:No match."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
All {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nReplace all?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Replace_All_CH
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
default {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Click \"Option\" button.\nAnd check replace one or all."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Replace mode is "one"
|
||||
proc Replace_One_CH {} {
|
||||
if {[set RANGE [.ch.main.text tag range SEARCH_TAG]] == ""} {
|
||||
if {![Search_CH]} {
|
||||
return 0
|
||||
} else {
|
||||
return 1
|
||||
}
|
||||
}
|
||||
|
||||
if {[.sech.ent.search get] != [eval ".ch.main.text get $RANGE"]} {
|
||||
if {![Search_CH]} {
|
||||
return 0
|
||||
} else {
|
||||
set RANGE [.ch.main.text tag range SEARCH_TAG]
|
||||
}
|
||||
}
|
||||
|
||||
.ch.main.text tag remove SEARCH_TAG 1.0 end
|
||||
eval .ch.main.text delete $RANGE
|
||||
set INSERT [lindex [split $RANGE] 0]
|
||||
|
||||
if {![catch {.sech.ent.replace get} STRING]} {
|
||||
.ch.main.text insert $INSERT $STRING
|
||||
scan $INSERT %d.%d LINE HEAD
|
||||
set TAIL [expr [string length $STRING] + $HEAD]
|
||||
.ch.main.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
if {![Search_CH]} {return 0}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Replace mode is "all"
|
||||
proc Replace_All_CH {} {
|
||||
while {[Replace_One_CH] != 0} {}
|
||||
}
|
||||
@@ -0,0 +1,953 @@
|
||||
## GAGparam
|
||||
## (GAG procedure)
|
||||
# make Parameter window
|
||||
##
|
||||
# 1998 7 5 ; display only the curr dir name in the macro filechooser
|
||||
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.19
|
||||
## Tcl/Tk version 8.0
|
||||
# 1998 July 5 GEANT4 Beta-01
|
||||
##
|
||||
|
||||
proc Param NAME {
|
||||
global FONT F_COLOR B_COLOR PARAM COMMAND_NAME \
|
||||
errorCode errorInfo env
|
||||
|
||||
set W $NAME
|
||||
|
||||
if [winfo exists .$W] {
|
||||
raise .$W
|
||||
focus .$W.main.val.in.ent
|
||||
return
|
||||
}
|
||||
|
||||
if {![info exists PARAM($NAME)]} {
|
||||
GAG_Command $NAME
|
||||
return
|
||||
}
|
||||
|
||||
set COMMAND_NAME($W) $NAME
|
||||
toplevel .$W
|
||||
|
||||
frame .$W.butt -highlightthickness 0
|
||||
pack .$W.butt -side top -fill x
|
||||
|
||||
button .$W.butt.comm -text $NAME -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
set LENGTH [.$W.main.para.list index end]
|
||||
for {set i 0} {$i < $LENGTH} {incr i} {
|
||||
set P [.$W.main.para.list get $i]
|
||||
set V [.$W.main.val.list get $i]
|
||||
if {$P == ""} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif {$V == ""} {
|
||||
if {$PARAM($COMMAND_NAME($W).$P.omit) == "1"} {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $PARAM($COMMAND_NAME($W).$P.default)]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot omit this parameter"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $V]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
}
|
||||
}
|
||||
set P [join [.$W.main.val.list get 0 end]]
|
||||
GAG_Command "$COMMAND_NAME($W) $P"
|
||||
}
|
||||
button .$W.butt.now -text Current -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
GAG_Command ?$COMMAND_NAME($W)
|
||||
}
|
||||
button .$W.butt.def -text Default -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
set LIST [.$W.main.para.in.ent get]
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
.$W.main.val.in.ent insert end $PARAM($COMMAND_NAME($W).$LIST.default)
|
||||
}
|
||||
button .$W.butt.clear -text Clear -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
.$W.main.para.list see 0
|
||||
.$W.main.val.list see 0
|
||||
.$W.main.para.list selection clear 0 end
|
||||
.$W.main.val.list selection clear 0 end
|
||||
focus .$W.main.val.in.ent
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
.$W.main.para.in.ent insert end [.$W.main.para.list get 0]
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
set GET [.$W.main.para.list get 0]
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.range)
|
||||
}
|
||||
.$W.main.val.list delete 0 end
|
||||
set END [.$W.main.para.list index end]
|
||||
for {set i 0} {$i < $END} {incr i} {
|
||||
.$W.main.val.list insert end ""
|
||||
}
|
||||
}
|
||||
button .$W.butt.cancel -text Cancel -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
destroy .$W
|
||||
}
|
||||
button .$W.butt.clear1 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
.$W.main.para.list see 0
|
||||
.$W.main.val.list see 0
|
||||
.$W.main.para.list selection clear 0 end
|
||||
.$W.main.val.list selection clear 0 end
|
||||
focus .$W.main.val.in.ent
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
.$W.main.para.in.ent insert end [.$W.main.para.list get 0]
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
.$W.main.val.in.ent insert end [.$W.main.val.list get 0]
|
||||
set GET [.$W.main.para.list get 0]
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.range)
|
||||
}
|
||||
}
|
||||
pack .$W.butt.comm .$W.butt.now .$W.butt.def \
|
||||
.$W.butt.clear .$W.butt.cancel -side left
|
||||
|
||||
|
||||
frame .$W.main -highlightthickness 0
|
||||
pack .$W.main -side top -fill both -expand 1
|
||||
|
||||
|
||||
frame .$W.main.para -highlightthickness 0
|
||||
pack .$W.main.para -side left -fill both -expand 1
|
||||
|
||||
|
||||
frame .$W.main.para.in -bd 1 -relief raised -highlightthickness 0
|
||||
pack .$W.main.para.in -side top -fill x
|
||||
|
||||
label .$W.main.para.in.lb -text Parameter -highlightthickness 0
|
||||
pack .$W.main.para.in.lb -side left
|
||||
|
||||
entry .$W.main.para.in.ent -state disabled -highlightthickness 0
|
||||
pack .$W.main.para.in.ent -side left -fill x -expand 1
|
||||
|
||||
listbox .$W.main.para.list -height 3 \
|
||||
-yscrollcommand ".$W.main.scroll.scroll set" \
|
||||
-highlightthickness 0
|
||||
pack .$W.main.para.list -side top -fill both -expand 1
|
||||
|
||||
|
||||
frame .$W.main.val -highlightthickness 0
|
||||
pack .$W.main.val -side left -fill both -expand 1
|
||||
|
||||
|
||||
frame .$W.main.val.in -bd 1 -relief raised -highlightthickness 0
|
||||
pack .$W.main.val.in -side top -fill x
|
||||
|
||||
label .$W.main.val.in.lb -text Value -highlightthickness 0
|
||||
pack .$W.main.val.in.lb -side left
|
||||
|
||||
entry .$W.main.val.in.ent -highlightthickness 0
|
||||
pack .$W.main.val.in.ent -side left -fill x -expand 1
|
||||
|
||||
listbox .$W.main.val.list -height 3 \
|
||||
-yscrollcommand ".$W.main.scroll.scroll set" \
|
||||
-highlightthickness 0
|
||||
pack .$W.main.val.list -side top -fill both -expand 1
|
||||
|
||||
frame .$W.main.scroll -bd 1 -highlightthickness 0
|
||||
pack .$W.main.scroll -side left -fill y
|
||||
|
||||
entry .$W.main.scroll.dummy -state disabled -relief flat \
|
||||
-width 0 -highlightthickness 0
|
||||
pack .$W.main.scroll.dummy -side top
|
||||
|
||||
scrollbar .$W.main.scroll.scroll -highlightthickness 0 \
|
||||
-command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
Scroll_Link ".$W.main.para.list .$W.main.val.list"
|
||||
}
|
||||
pack .$W.main.scroll.scroll -side top -fill y -expand 1
|
||||
|
||||
|
||||
frame .$W.left -highlightthickness 0
|
||||
pack .$W.left -side left
|
||||
|
||||
label .$W.left.type -text Type -anchor w -highlightthickness 0
|
||||
pack .$W.left.type -side top -fill x
|
||||
|
||||
label .$W.left.info -text Guidance -anchor w -highlightthickness 0
|
||||
pack .$W.left.info -side top -fill x
|
||||
|
||||
label .$W.left.range -text Range -anchor w -highlightthickness 0
|
||||
pack .$W.left.range -side top -fill x
|
||||
|
||||
|
||||
frame .$W.right -highlightthickness 0
|
||||
pack .$W.right -side left -fill x -expand 1
|
||||
|
||||
label .$W.right.type -anchor w \
|
||||
-bd 1 -relief sunken -highlightthickness 0
|
||||
pack .$W.right.type -side top -fill x
|
||||
|
||||
label .$W.right.info -anchor w \
|
||||
-bd 1 -relief sunken -highlightthickness 0
|
||||
pack .$W.right.info -side top -fill x
|
||||
|
||||
label .$W.right.range -anchor w \
|
||||
-bd 1 -relief sunken -highlightthickness 0
|
||||
pack .$W.right.range -side top -fill x
|
||||
|
||||
|
||||
# Binding
|
||||
bind .$W.main.para.list <ButtonRelease> {
|
||||
scan %W .%%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
focus .$W.main.val.in.ent
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
if {![catch {selection get} GET]} {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.$W.main.para.in.ent insert end $GET
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.range)
|
||||
}
|
||||
if {[info exists PARAM($COMMAND_NAME($W).$GET.candidate)] \
|
||||
&& ($PARAM($COMMAND_NAME($W).$GET.candidate) != "")} {
|
||||
Candidate $GET
|
||||
} else {
|
||||
Delete_Candidate $W
|
||||
}
|
||||
}
|
||||
if {![catch {.$W.main.val.list get [.$W.main.para.list index @%x,%y]} VALUE]} {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.$W.main.val.in.ent insert end $VALUE
|
||||
}
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
}
|
||||
bind .$W.main.val.list <ButtonRelease> {
|
||||
scan %W .%%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
focus .$W.main.val.in.ent
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
if {![catch {selection get} GET]} {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.$W.main.val.in.ent insert end $GET
|
||||
}
|
||||
if {![catch {.$W.main.para.list get [.$W.main.val.list index @%x,%y]} VARIABLE]} {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.$W.main.para.in.ent insert end $VARIABLE
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.range)
|
||||
}
|
||||
if {[info exists PARAM($COMMAND_NAME($W).$VARIABLE.candidate)] \
|
||||
&& ($PARAM($COMMAND_NAME($W).$VARIABLE.candidate) != "")} {
|
||||
Candidate $VARIABLE
|
||||
} else {
|
||||
Delete_Candidate $W
|
||||
}
|
||||
}
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
}
|
||||
bind .$W <Enter> {
|
||||
scan %W .%%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
raise .$W
|
||||
focus .$W.main.val.in.ent
|
||||
}
|
||||
foreach BIND {Return Tab Down Control-n} {
|
||||
bind .$W.main.val.in.ent <$BIND> {
|
||||
scan %W .%%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
set P [.$W.main.para.in.ent get]
|
||||
set V [.$W.main.val.in.ent get]
|
||||
if {$P == ""} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif {$V == ""} {
|
||||
if {$PARAM($COMMAND_NAME($W).$P.omit) == "1"} {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $PARAM($COMMAND_NAME($W).$P.default)]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot omit this parameter."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $V]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
}
|
||||
set P_END [.$W.main.para.list index end]
|
||||
for {set Num 0} {$Num <= $P_END} {incr Num} {
|
||||
if {$P == [.$W.main.para.list get $Num]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$Num < 0} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
incr Num
|
||||
if {$Num >= $P_END} {set Num 0}
|
||||
.$W.butt.clear1 invoke
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
set VARIABLE [.$W.main.para.list get $Num]
|
||||
.$W.main.para.in.ent insert end $VARIABLE
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
.$W.main.val.in.ent insert end [.$W.main.val.list get $Num]
|
||||
.$W.main.para.list selection set $Num
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.range)
|
||||
}
|
||||
if {[info exists PARAM($COMMAND_NAME($W).$VARIABLE.candidate)] \
|
||||
&& ($PARAM($COMMAND_NAME($W).$VARIABLE.candidate) != "")} {
|
||||
Candidate $VARIABLE
|
||||
} else {
|
||||
Delete_Candidate $W
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
foreach BIND {Shift-Tab Up Control-p} {
|
||||
bind .$W.main.val.in.ent <$BIND> {
|
||||
scan %W .%%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
set P [.$W.main.para.in.ent get]
|
||||
set V [.$W.main.val.in.ent get]
|
||||
if {$P == ""} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif {$V == ""} {
|
||||
if {$PARAM($COMMAND_NAME($W).$P.omit) == "1"} {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $PARAM($COMMAND_NAME($W).$P.default)]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot omitt this parameter."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $V]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
}
|
||||
set P_END [.$W.main.para.list index end]
|
||||
for {set Num 0} {$Num <= $P_END} {incr Num} {
|
||||
if {$P == [.$W.main.para.list get $Num]} {
|
||||
break
|
||||
}
|
||||
}
|
||||
if {$Num < 0} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
incr Num -1
|
||||
if {$Num < 0} {set Num [expr $P_END - 1]}
|
||||
.$W.butt.clear1 invoke
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
set VARIABLE [.$W.main.para.list get $Num]
|
||||
.$W.main.para.in.ent insert end $VARIABLE
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
.$W.main.val.in.ent insert end [.$W.main.val.list get $Num]
|
||||
.$W.main.para.list selection set $Num
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$VARIABLE.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$VARIABLE.range)
|
||||
}
|
||||
if {[info exists PARAM($COMMAND_NAME($W).$VARIABLE.candidate)] \
|
||||
&& ($PARAM($COMMAND_NAME($W).$VARIABLE.candidate) != "")} {
|
||||
Candidate $VARIABLE
|
||||
} else {
|
||||
Delete_Candidate $W
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Put_Param $NAME
|
||||
focus .$W.main.val.in.ent
|
||||
wm title .$W Command
|
||||
wm protocol .$W WM_DELETEWINDOW {
|
||||
.$W.butt.cancel invoke
|
||||
}
|
||||
Tab_off
|
||||
Control
|
||||
set GET [.$W.main.para.in.ent get]
|
||||
if {[info exists PARAM($COMMAND_NAME($W).$GET.candidate)] \
|
||||
&& ($PARAM($COMMAND_NAME($W).$GET.candidate) != "")} {
|
||||
Candidate $GET
|
||||
} else {
|
||||
Delete_Candidate $W
|
||||
}
|
||||
if {$W == "/control/execute"} {
|
||||
Command_Dir $W
|
||||
.$W.butt.comm configure -command {
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
set P [.$W.main.para.in.ent get]
|
||||
set V [.$W.main.val.list get 0]
|
||||
if {$P == ""} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif {$V == ""} {
|
||||
if {$PARAM($COMMAND_NAME($W).$P.omit) != "1"} {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $PARAM($COMMAND_NAME($W).$P.default)]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot omit this parameter."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
set ANSWER [Value_Check $PARAM($COMMAND_NAME($W).$P.type) $V]
|
||||
if {$ANSWER != "ERROR"} {
|
||||
set PARAM($COMMAND_NAME($W).$P.now) $ANSWER
|
||||
Put_Param $COMMAND_NAME($W)
|
||||
}
|
||||
}
|
||||
set P [.$W.main.val.list get 0]
|
||||
GAG_Command "$COMMAND_NAME($W) $P"
|
||||
}
|
||||
}
|
||||
|
||||
Win_Size .$W
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .$W
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .$W
|
||||
}
|
||||
.$W.main.para.list selection set 0
|
||||
}
|
||||
|
||||
# Putout Parameter on Param window
|
||||
proc Put_Param NAME {
|
||||
global PARAM COMMAND_NAME FONT F_COLOR B_COLOR
|
||||
|
||||
set W $NAME
|
||||
|
||||
if {![winfo exists .$W]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
.$W.main.para.list delete 0 end
|
||||
.$W.main.val.list delete 0 end
|
||||
foreach LIST $PARAM($NAME) {
|
||||
.$W.main.para.list insert end $LIST
|
||||
if {[info exists PARAM($NAME.$LIST.now)]} {
|
||||
.$W.main.val.list insert end $PARAM($NAME.$LIST.now)
|
||||
} elseif {[info exists PARAM($NAME.$LIST.default)]} {
|
||||
.$W.main.val.list insert end $PARAM($NAME.$LIST.default)
|
||||
} else {
|
||||
.$W.main.val.list insert end ""
|
||||
}
|
||||
}
|
||||
set GET [.$W.main.para.list get 0]
|
||||
.$W.main.para.in.ent configure -state normal
|
||||
.$W.main.para.in.ent delete 0 end
|
||||
.$W.main.para.in.ent insert end $GET
|
||||
.$W.main.para.in.ent configure -state disabled
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
.$W.main.val.in.ent insert end [.$W.main.val.list get 0]
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.type)] {
|
||||
.$W.right.type configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.type)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.guide)] {
|
||||
.$W.right.info configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.guide)
|
||||
}
|
||||
if [info exists PARAM($COMMAND_NAME($W).$GET.range)] {
|
||||
.$W.right.range configure -text \
|
||||
$PARAM($COMMAND_NAME($W).$GET.range)
|
||||
}
|
||||
}
|
||||
|
||||
# Analyze parameter
|
||||
proc Make_Param LINE {
|
||||
global PARAM PRE COMMAND_NAME Win_Name FONT F_COLOR B_COLOR \
|
||||
COMM_RANGE FLAG_P
|
||||
|
||||
set LINE [string trimleft $LINE]
|
||||
set LINE [string trimleft $LINE "\{"]
|
||||
set SWITCH [lindex [split $LINE] 0]
|
||||
|
||||
switch -- $SWITCH {
|
||||
"@@command_range" {
|
||||
set HEAD [expr [string first \" $LINE] + 1]
|
||||
set TAIL [expr [string last \" $LINE] - 1]
|
||||
set COMM_RANGE [string range $LINE $HEAD $TAIL]
|
||||
if {$COMM_RANGE == ""} {
|
||||
unset COMM_RANGE
|
||||
}
|
||||
}
|
||||
"@@param_name" {
|
||||
set PRE(name) [Pick_Up_Param $LINE]
|
||||
}
|
||||
"@@param_guide" {
|
||||
set PRE(guide) [Another_Line [Pick_Up_Param $LINE]]
|
||||
}
|
||||
"@@param_type" {
|
||||
set PRE(type) [Pick_Up_Param $LINE]
|
||||
}
|
||||
"@@param_omit" {
|
||||
set PRE(omit) [Pick_Up_Param $LINE]
|
||||
}
|
||||
"@@param_default" {
|
||||
set PRE(default) [Pick_Up_Param $LINE]
|
||||
}
|
||||
"@@param_range" {
|
||||
set PRE(range) [Pick_Up_Param $LINE]
|
||||
if {$PRE(range) == ""} {
|
||||
unset PRE(range)
|
||||
}
|
||||
if {[info exists COMM_RANGE] && [info exists PRE(range)]} {
|
||||
set PRE(range) "$COMM_RANGE\n[Pick_Up_Param $LINE]"
|
||||
} elseif {[info exists COMM_RANGE] && ![info exists PRE(range)]} {
|
||||
set PRE(range) $COMM_RANGE
|
||||
}
|
||||
}
|
||||
"@@param_candidate" {
|
||||
set PRE(candidate) [Pick_Up_Param $LINE]
|
||||
}
|
||||
"\}" {
|
||||
if {![info exists Win_Name]} {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Error!\nCheck this GEANT code."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
if {[lsearch [array name PARAM] $COMMAND_NAME($Win_Name).$PRE(name).guide] < 0} {
|
||||
lappend PARAM($COMMAND_NAME($Win_Name)) $PRE(name)
|
||||
}
|
||||
foreach LIST {guide type omit default range candidate} {
|
||||
if {[info exists PRE($LIST)]} {
|
||||
set PARAM($COMMAND_NAME($Win_Name).$PRE(name).$LIST) $PRE($LIST)
|
||||
} else {
|
||||
set PARAM($COMMAND_NAME($Win_Name).$PRE(name).$LIST) ""
|
||||
}
|
||||
}
|
||||
if {$PARAM($COMMAND_NAME($Win_Name).$PRE(name).type) == "boolean" || $PARAM($COMMAND_NAME($Win_Name).$PRE(name).type) == "b"} {
|
||||
if {$PARAM($COMMAND_NAME($Win_Name).$PRE(name).candidate) == ""} {
|
||||
set PARAM($COMMAND_NAME($Win_Name).$PRE(name).candidate) "TRUE FALSE"
|
||||
}
|
||||
}
|
||||
unset PRE
|
||||
}
|
||||
default {
|
||||
if {[string index $SWITCH 0] == "\/"} {
|
||||
set FLAG_P $SWITCH
|
||||
set Win_Name $SWITCH
|
||||
set COMMAND_NAME($Win_Name) $SWITCH
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Pick up Parameter from parameter data
|
||||
proc Pick_Up_Param LINE {
|
||||
set HEAD [expr [string first : $LINE] + 1]
|
||||
set LINE [string range $LINE $HEAD end]
|
||||
set LINE [string trimleft $LINE]
|
||||
if {[string index $LINE 0] == "\""} {
|
||||
set LINE [string range $LINE 1 end]
|
||||
}
|
||||
set LINE [string trimright $LINE "\""]
|
||||
return $LINE
|
||||
}
|
||||
|
||||
# add Candidate list box in Parameter window
|
||||
proc Candidate PARA_NAME {
|
||||
global FONT F_COLOR B_COLOR
|
||||
|
||||
update
|
||||
scan [focus] .%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
if {![winfo exists .$W]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if {![winfo exists .$W.main.candidate]} {
|
||||
frame .$W.main.candidate -highlightthickness 0
|
||||
pack .$W.main.candidate -side left -fill y
|
||||
|
||||
label .$W.main.candidate.lb -text Candidate -anchor w \
|
||||
-bd 2 -relief flat -highlightthickness 0
|
||||
pack .$W.main.candidate.lb -side top -fill x
|
||||
|
||||
listbox .$W.main.candidate.list -height 3 \
|
||||
-yscrollcommand ".$W.main.candidate.scroll set" \
|
||||
-highlightthickness 0
|
||||
pack .$W.main.candidate.list -side left -fill y
|
||||
|
||||
scrollbar .$W.main.candidate.scroll \
|
||||
-command ".$W.main.candidate.list yview" \
|
||||
-highlightthickness 0
|
||||
pack .$W.main.candidate.scroll -side left -fill y
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .$W
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .$W
|
||||
}
|
||||
Win_Size .$W
|
||||
Tab_off
|
||||
Control
|
||||
|
||||
bind .$W.main.candidate.list <ButtonRelease> {
|
||||
scan %W .%%s W
|
||||
set W [lindex [split $W \.] 0]
|
||||
focus .$W.main.val.in.ent
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
if {![catch {selection get} GET]} {
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
.$W.main.val.in.ent insert end $GET
|
||||
}
|
||||
}
|
||||
} else {
|
||||
.$W.main.candidate.list delete 0 end
|
||||
}
|
||||
|
||||
global PARAM COMMAND_NAME
|
||||
|
||||
foreach L [split $PARAM($COMMAND_NAME($W).$PARA_NAME.candidate)] {
|
||||
.$W.main.candidate.list insert end $L
|
||||
}
|
||||
}
|
||||
|
||||
# delete Candidate list box from Parameter window
|
||||
proc Delete_Candidate W {
|
||||
global FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .$W]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if [winfo exists .$W.main.candidate] {
|
||||
destroy .$W.main.candidate
|
||||
}
|
||||
}
|
||||
|
||||
# add Directry(& File) list in Parameter window
|
||||
proc Command_Dir W {
|
||||
global env FONT F_COLOR B_COLOR errorCode errorInfo
|
||||
|
||||
if {![winfo exists .$W]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
frame .$W.main.dir -highlightthickness 0
|
||||
pack .$W.main.dir -side right -fill both -expand 1
|
||||
|
||||
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
## only current dir name
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
label .$W.main.dir.current -text $cdir -anchor w -highlightthickness 0
|
||||
## label .$W.main.dir.current -text $PATH -anchor w -highlightthickness 0
|
||||
pack .$W.main.dir.current -side top -fill x
|
||||
|
||||
|
||||
frame .$W.main.dir.select -highlightthickness 0
|
||||
pack .$W.main.dir.select -side top -fill both -expand 1
|
||||
|
||||
listbox .$W.main.dir.select.list -width 20 -height 3 \
|
||||
-yscrollcommand ".$W.main.dir.select.scroll set" \
|
||||
-highlightthickness 0
|
||||
pack .$W.main.dir.select.list -side left -fill both -expand 1
|
||||
|
||||
scrollbar .$W.main.dir.select.scroll -command ".$W.main.dir.select.list yview" \
|
||||
-highlightthickness 0
|
||||
pack .$W.main.dir.select.scroll -side left -fill y
|
||||
|
||||
|
||||
Put_File_List .$W.main.dir
|
||||
|
||||
|
||||
# Binding
|
||||
bind .$W.main.dir.select.list <ButtonRelease> {
|
||||
set W /control/execute
|
||||
if {![catch {selection get} GET]} {
|
||||
if [file isdirectory $env(G_PATH)/$GET] {
|
||||
Change_Path $GET
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
## only current dir name
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.$W.main.dir.current configure -text $cdir
|
||||
## .$W.main.dir.current configure -text $PATH
|
||||
.$W.main.dir.select.list see 0
|
||||
.$W.main.dir.select.list selection clear 0 end
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
Put_File_List .$W.main.dir
|
||||
if [winfo exists .cd] {
|
||||
## only current dir name
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.cd.info.label1 configure -text $cdir
|
||||
## .cd.info.label1 configure -text $PATH
|
||||
Put_File_List .cd
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
bind .$W.main.dir.select.list <Double-Button> {
|
||||
set W /control/execute
|
||||
if {![catch {selection get} Name]} {
|
||||
if {[file isfile $env(G_PATH)/$Name] && ![file executable $env(G_PATH)/$Name]} {
|
||||
.$W.main.val.in.ent delete 0 end
|
||||
.$W.main.val.in.ent insert end $env(G_PATH)/$Name
|
||||
## .$W.main.val.in.ent insert end $Name
|
||||
}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
bind .$W.main.dir.select.list <Double-ButtonRelease> {}
|
||||
}
|
||||
@@ -0,0 +1,303 @@
|
||||
## GAGsavelog
|
||||
## (GAG procedure)
|
||||
## Save log to a file. check before Save
|
||||
##
|
||||
# 1998 7 5 ; display only the current dir name
|
||||
|
||||
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc Before_Save {} {
|
||||
global SAVE_RANGE FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .log.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if {[.log.text tag range SEARCH_ALL_TAG] != ""} {
|
||||
Message_Skeleton -icon question -button {O.K. Cancel} \
|
||||
-message "Save only searched strings."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
set SAVE_RANGE [.log.text tag range SEARCH_ALL_TAG]
|
||||
Save_Window
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} elseif {[.log.text tag range sel] != ""} {
|
||||
Message_Skeleton -icon question -button {O.K. Cancel} \
|
||||
-message "Save only selected range."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
set SAVE_RANGE [.log.text tag range sel]
|
||||
Save_Window
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
set SAVE_RANGE [list 0.0 [.log.text index end]]
|
||||
Save_Window
|
||||
}
|
||||
}
|
||||
|
||||
# make Save window
|
||||
proc Save_Window {} {
|
||||
if [winfo exists .sl] {
|
||||
raise .sl
|
||||
focus .sl.name.ent
|
||||
return
|
||||
}
|
||||
|
||||
global FONT F_COLOR B_COLOR errorCode errorInfo env
|
||||
|
||||
set DIR $env(G_PATH)
|
||||
File_List_Skeleton .sl
|
||||
|
||||
.sl.butt.b0 configure -text "Save Log" -command {
|
||||
set Name [.sl.name.ent get]
|
||||
if {$Name != ""} {
|
||||
if [file isdirectory $env(G_PATH)/$Name] {
|
||||
Change_Path $Name
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
### split the current dir
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.sl.info.label1 configure -text $cdir
|
||||
|
||||
### .sl.info.label1 configure -text $PATH
|
||||
.sl.butt.b1 invoke
|
||||
Put_File_List .sl
|
||||
} elseif [file executable $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\n\"$Name\" is an executable file."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: Overwrite?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: New file?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
.sl.butt.b1 configure -text Clear -command {
|
||||
.sl.select.list see 0
|
||||
.sl.select.list selection clear 0 end
|
||||
focus .sl.name.ent
|
||||
.sl.name.ent delete 0 end
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
### split the current dir
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.sl.info.label1 configure -text $cdir
|
||||
|
||||
## .sl.info.label1 configure -text $PATH
|
||||
Put_File_List .sl
|
||||
}
|
||||
|
||||
.sl.butt.b2 configure -text Cancel -command {
|
||||
destroy .sl
|
||||
}
|
||||
|
||||
|
||||
# Binding
|
||||
|
||||
bind .sl.select.list <ButtonRelease> {
|
||||
if {![catch {selection get} GET]} {
|
||||
if [file isdirectory $env(G_PATH)/$GET] {
|
||||
Change_Path $GET
|
||||
set END [string length $env(HOME)]
|
||||
set PATH ~[string range $env(G_PATH) $END end]
|
||||
### split the current dir
|
||||
set dlist [file split $PATH]
|
||||
set cdir [lindex $dlist end]
|
||||
.sl.info.label1 configure -text $cdir
|
||||
|
||||
## .sl.info.label1 configure -text $PATH
|
||||
.sl.butt.b1 invoke
|
||||
Put_File_List .sl
|
||||
} else {
|
||||
.sl.name.ent delete 0 end
|
||||
.sl.name.ent insert end $GET
|
||||
}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
bind .sl.select.list <Double-Button> {
|
||||
set Name [.sl.name.ent get]
|
||||
if {$Name != ""} {
|
||||
if [file executable $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\n\"$Name\" is executable file."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
} elseif [file isfile $env(G_PATH)/$Name] {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: Overwrite?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "$Name: New file?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Save
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bind .sl.select.list <Double-ButtonRelease> {}
|
||||
|
||||
bind .sl.name.ent <Return> {.sl.butt.b0 invoke}
|
||||
|
||||
bind .sl <Enter> {
|
||||
raise .sl
|
||||
focus .sl.name.ent
|
||||
}
|
||||
|
||||
|
||||
wm title .sl "Save Log"
|
||||
wm protocol .sl WM_DELETEWINDOW {
|
||||
grab release .sl
|
||||
Change_Path $DIR
|
||||
}
|
||||
Put_File_List .sl
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .sl
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .sl
|
||||
}
|
||||
Win_Size .sl
|
||||
Tab_off
|
||||
Control
|
||||
grab set .sl
|
||||
}
|
||||
|
||||
# Save log
|
||||
proc Save {} {
|
||||
global SAVE_RANGE FONT F_COLOR B_COLOR errorCode errorInfo env
|
||||
|
||||
if {![winfo exists .sl]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set Name [.sl.name.ent get]
|
||||
|
||||
if {![catch {open $env(G_PATH)/$Name w} file_ID]} {
|
||||
set LENGTH [llength $SAVE_RANGE]
|
||||
for {set i 0} {$i < $LENGTH} {incr i} {
|
||||
puts $file_ID [.log.text get [lindex $SAVE_RANGE $i] [lindex $SAVE_RANGE [expr $i + 1]]]
|
||||
incr i
|
||||
}
|
||||
close $file_ID
|
||||
} else {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Cannot open."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,411 @@
|
||||
## GAGsearchstring
|
||||
## (GAGlogterm procedure)
|
||||
# make Search String window
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1997.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc Search_String {} {
|
||||
global FONT SEARCH REPLACE F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .log.text]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
if [winfo exists .ss] {
|
||||
raise .ss
|
||||
focus .ss.ent.search
|
||||
return
|
||||
}
|
||||
|
||||
|
||||
toplevel .ss -highlightthickness 0
|
||||
wm title .ss "Search String"
|
||||
wm protocol .ss WM_DELETE_WINDOW {
|
||||
.log.text tag remove SEARCH_TAG 1.0 end
|
||||
.log.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
destroy .ss
|
||||
}
|
||||
|
||||
frame .ss.butt -highlightthickness 0
|
||||
pack .ss.butt -side top -fill x
|
||||
|
||||
button .ss.butt.b0 -text Search -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if {[.ss.ent.search get] != ""} {
|
||||
if {![Search]} {
|
||||
set STRING [.ss.ent.search get]
|
||||
Message_Skeleton -icon info -button O.K. \
|
||||
-message "$STRING: No match."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Input String."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
button .ss.butt.b1 -text Replace -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if {[.ss.ent.search get] != ""} {
|
||||
if {[.ss.ent.replace get] == ""} {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nDelete [.ss.ent.search get]?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Replace
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
} else {
|
||||
Replace
|
||||
}
|
||||
} else {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Input String."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
|
||||
menubutton .ss.butt.b2 -text Option -menu .ss.butt.b2.set \
|
||||
-relief raised -bd 3 -highlightthickness 0
|
||||
|
||||
menu .ss.butt.b2.set -tearoff 0
|
||||
.ss.butt.b2.set add cascade -label Search -menu .ss.butt.b2.set.search
|
||||
.ss.butt.b2.set add cascade -label Replace \
|
||||
-menu .ss.butt.b2.set.replace
|
||||
|
||||
menu .ss.butt.b2.set.search -tearoff 0
|
||||
.ss.butt.b2.set.search add radiobutton -label Up \
|
||||
-variable SEARCH -value Up
|
||||
.ss.butt.b2.set.search add radiobutton -label Down \
|
||||
-variable SEARCH -value Down
|
||||
|
||||
menu .ss.butt.b2.set.replace -tearoff 0
|
||||
.ss.butt.b2.set.replace add radiobutton -label "Only One" \
|
||||
-variable REPLACE -value One
|
||||
.ss.butt.b2.set.replace add radiobutton -label "About All" \
|
||||
-variable REPLACE -value All
|
||||
|
||||
button .ss.butt.b3 -text Clear -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
.ss.ent.search delete 0 end
|
||||
.ss.ent.replace delete 0 end
|
||||
.log.text tag remove SEARCH_TAG 1.0 end
|
||||
.log.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
focus .ss.ent.search
|
||||
.log.text see end
|
||||
}
|
||||
button .ss.butt.b4 -text Cancel -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if [winfo exists .ss] {destroy .ss}
|
||||
.log.text tag remove SEARCH_TAG 1.0 end
|
||||
.log.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
}
|
||||
|
||||
pack .ss.butt.b0 .ss.butt.b1 .ss.butt.b2 .ss.butt.b3 .ss.butt.b4 \
|
||||
-side left -fill x
|
||||
|
||||
|
||||
frame .ss.space -highlightthickness 0
|
||||
pack .ss.space -side top -fill both -expand 1
|
||||
|
||||
|
||||
frame .ss.label -highlightthickness 0
|
||||
pack .ss.label -side left
|
||||
|
||||
label .ss.label.search -text Search -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .ss.label.search -side top -fill x
|
||||
|
||||
label .ss.label.replace -text Replace -anchor w \
|
||||
-highlightthickness 0
|
||||
pack .ss.label.replace -side top -fill x
|
||||
|
||||
|
||||
frame .ss.ent -highlightthickness 0
|
||||
pack .ss.ent -side left -fill x -expand 1
|
||||
|
||||
entry .ss.ent.search -highlightthickness 0
|
||||
pack .ss.ent.search -side top -fill x
|
||||
|
||||
entry .ss.ent.replace -highlightthickness 0
|
||||
pack .ss.ent.replace -side top -fill x
|
||||
|
||||
|
||||
focus .ss.ent.search
|
||||
Tab_off
|
||||
Control
|
||||
|
||||
foreach BIND {Return Tab Shift-Tab Down Control-n} {
|
||||
bind .ss.ent.search <$BIND> {focus .ss.ent.replace}
|
||||
}
|
||||
foreach BIND {Return Tab Shift-Tab Up Control-p} {
|
||||
bind .ss.ent.replace <$BIND> {focus .ss.ent.search}
|
||||
}
|
||||
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .ss
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .ss
|
||||
}
|
||||
Win_Size .ss
|
||||
wm resizable .ss 1 0
|
||||
}
|
||||
|
||||
# Search string on GAG main window
|
||||
proc Search {} {
|
||||
global SEARCH FONT F_COLOR B_COLOR
|
||||
|
||||
if {![winfo exists .ss.ent.search]} {
|
||||
Message_Skeleton -icon warning -button O.K.\
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 1
|
||||
}
|
||||
|
||||
|
||||
.log.text tag remove SEARCH_ALL_TAG 1.0 end
|
||||
.log.text tag configure SEARCH_ALL_TAG \
|
||||
-foreground #fffffffff -background #000000000
|
||||
set CURSOL [.log.text index insert]
|
||||
set CUR 1.0
|
||||
set STRING [.ss.ent.search get]
|
||||
if {$STRING != ""} {
|
||||
while {[set CUR [.log.text search -count LENGTH -regexp --\
|
||||
$STRING $CUR end]] != ""} {
|
||||
.log.text tag add SEARCH_ALL_TAG \
|
||||
$CUR "$CUR + $LENGTH char"
|
||||
set CUR [.log.text index "$CUR + $LENGTH char"]
|
||||
}
|
||||
}
|
||||
.log.text index $CURSOL
|
||||
|
||||
switch $SEARCH {
|
||||
Up {
|
||||
if [Search_Up] {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
Down {
|
||||
if [Search_Down] {
|
||||
return 1
|
||||
} else {
|
||||
return 0
|
||||
}
|
||||
}
|
||||
default {
|
||||
Message_Skeleton -icon error -button O.K. \
|
||||
-message "Click \"Option\" button.\nAnd check search up or down."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Chane_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return 1
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Search mode is "up"
|
||||
proc Search_Up {} {
|
||||
.log.text tag remove SEARCH_TAG 1.0 end
|
||||
.log.text tag configure SEARCH_TAG \
|
||||
-foreground #fffffffff -background #ccc000000
|
||||
|
||||
set CURSOL [.log.text index insert]
|
||||
set STRING [.ss.ent.search get]
|
||||
set STOP 1.0
|
||||
|
||||
set INDEX [.log.text search -backwards \
|
||||
-count LENGTH -regexp -- $STRING $CURSOL $STOP]
|
||||
|
||||
if {$INDEX != ""} {
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set TAIL [expr $HEAD + $LENGTH]
|
||||
.log.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
.log.text mark set insert $LINE.$HEAD
|
||||
.log.text yview -pickplace insert
|
||||
} else {
|
||||
.log.text mark set insert 1.0
|
||||
return 0
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Search mode is "down"
|
||||
proc Search_Down {} {
|
||||
.log.text tag remove SEARCH_TAG 1.0 end
|
||||
.log.text tag configure SEARCH_TAG \
|
||||
-foreground #fffffffff -background #ccc000000
|
||||
|
||||
set CURSOL [.log.text index insert]
|
||||
set STRING [.ss.ent.search get]
|
||||
set STOP [.log.text index end]
|
||||
|
||||
set INDEX [.log.text search -count LENGTH -regexp \
|
||||
-- $STRING $CURSOL $STOP]
|
||||
|
||||
if {$INDEX != ""} {
|
||||
scan $INDEX %d.%d LINE HEAD
|
||||
set TAIL [expr $HEAD + $LENGTH]
|
||||
.log.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
.log.text mark set insert $LINE.$TAIL
|
||||
.log.text yview -pickplace insert
|
||||
} else {
|
||||
.log.text mark set insert end
|
||||
return 0
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Replace string on GAG main window
|
||||
proc Replace {} {
|
||||
global REPLACE FONT F_COLOR B_COLOR errorCode errorInfo
|
||||
|
||||
if {![winfo exists .ss.ent.replace]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set STRING [.ss.ent.search get]
|
||||
|
||||
switch $REPLACE {
|
||||
One {
|
||||
if {![Replace_One]} {
|
||||
Message_Skeleton -icon info -button O.K. \
|
||||
-message "$STRING:No match."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
All {
|
||||
Message_Skeleton -icon question -button {Yes No} \
|
||||
-message "Check!\nReplace all?"
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {
|
||||
destroy .msgskeleton
|
||||
Replace_All
|
||||
}
|
||||
.msgskeleton.butt.1 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
default {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Click \"Option\" button.\nAnd check replace one or all."
|
||||
if {$FONT != ""} {
|
||||
Change_Font $FONT .msgskeleton
|
||||
}
|
||||
if {$F_COLOR != "" && $B_COLOR != ""} {
|
||||
Change_Color $F_COLOR $B_COLOR .msgskeleton
|
||||
}
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Replace mode is "one"
|
||||
proc Replace_One {} {
|
||||
if {[set RANGE [.log.text tag range SEARCH_TAG]] == ""} {
|
||||
if {![Search]} {
|
||||
return 0
|
||||
} else {
|
||||
return 1
|
||||
}
|
||||
}
|
||||
|
||||
if {[.ss.ent.search get] != [eval ".log.text get $RANGE"]} {
|
||||
if {![Search]} {
|
||||
return 0
|
||||
} else {
|
||||
set RANGE [.log.text tag range SEARCH_TAG]
|
||||
}
|
||||
}
|
||||
|
||||
.log.text tag remove SEARCH_TAG 1.0 end
|
||||
eval .log.text delete $RANGE
|
||||
set INSERT [lindex [split $RANGE] 0]
|
||||
|
||||
if {![catch {.ss.ent.replace get} STRING]} {
|
||||
.log.text insert $INSERT $STRING
|
||||
scan $INSERT %d.%d LINE HEAD
|
||||
set TAIL [expr [string length $STRING] + $HEAD]
|
||||
.log.text tag add SEARCH_TAG $LINE.$HEAD $LINE.$TAIL
|
||||
if {![Search]} {return 0}
|
||||
}
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Replace mode is "all"
|
||||
proc Replace_All {} {
|
||||
while {[Replace_One] != 0} {}
|
||||
}
|
||||
@@ -0,0 +1,73 @@
|
||||
## global variable
|
||||
env
|
||||
TEXT_LOG
|
||||
FONT
|
||||
SEARCH
|
||||
REPLACE
|
||||
GEANT_ID
|
||||
F_COLOR
|
||||
B_COLOR
|
||||
PROMPT
|
||||
HOME
|
||||
HELP()
|
||||
FLAG_B
|
||||
FLAG_P
|
||||
PARAM()
|
||||
PRE()
|
||||
COMMAND_NAME()
|
||||
Win_Name
|
||||
HISTORY
|
||||
errorCode
|
||||
errorInfo
|
||||
|
||||
## procedures
|
||||
#GAGclearlog.proc
|
||||
Clear_Log
|
||||
|
||||
#GAGconnect.proc
|
||||
GAG_Connect COMMAND
|
||||
GAG_Command COMMAND
|
||||
Parse_Line
|
||||
Make_Button LINE
|
||||
Delete_Button
|
||||
Make_Param LINE
|
||||
Command_Passive
|
||||
Command_Active COMMAND
|
||||
|
||||
#GAGdirectory
|
||||
Directory
|
||||
|
||||
#GAGparam.proc
|
||||
Param NAME
|
||||
Put_Param NAME
|
||||
Make_Param LINE
|
||||
Pick_Up_Param LINE
|
||||
Candidate PARA_NAME
|
||||
Delete_Candidate W
|
||||
Command_Dir W
|
||||
|
||||
#GAGsavelog.proc
|
||||
Before_Save
|
||||
Save_Window
|
||||
Save
|
||||
|
||||
#GAGsearchstring.proc
|
||||
Search_String
|
||||
Search
|
||||
Search_Up
|
||||
Search_Down
|
||||
Replace
|
||||
Replace_One
|
||||
Replace_All
|
||||
|
||||
#GAGhistory.proc
|
||||
Command_History
|
||||
CH_Save_Window
|
||||
CH_Save
|
||||
Search_String_CH
|
||||
Search_CH
|
||||
Search_Up_CH
|
||||
Search_Down_CH
|
||||
Replace_CH
|
||||
Replace_One_CH
|
||||
Replace_All_CH
|
||||
@@ -0,0 +1,45 @@
|
||||
# Tcl autoload index file, version 2.0
|
||||
# This file is generated by the "auto_mkindex" command
|
||||
# and sourced to set up indexing information for one or
|
||||
# more commands. Typically each line is a command that
|
||||
# sets an element in the auto_index array, where the
|
||||
# element name is the name of a command and the value is
|
||||
# a script that loads the command.
|
||||
|
||||
set auto_index(Clear_Log) [list source [file join $dir GAGclearlog.proc]]
|
||||
set auto_index(Directory) [list source [file join $dir GAGdirectory.proc]]
|
||||
set auto_index(Param) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(Put_Param) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(Make_Param) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(Pick_Up_Param) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(Candidate) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(Delete_Candidate) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(Command_Dir) [list source [file join $dir GAGparam.proc]]
|
||||
set auto_index(GAG_Connect) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(GAG_Command) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Parse_Line) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Make_Button) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Delete_Button) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Command_Passive) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Command_Active) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Command_Disable) [list source [file join $dir GAGconnect.proc]]
|
||||
set auto_index(Before_Save) [list source [file join $dir GAGsavelog.proc]]
|
||||
set auto_index(Save_Window) [list source [file join $dir GAGsavelog.proc]]
|
||||
set auto_index(Save) [list source [file join $dir GAGsavelog.proc]]
|
||||
set auto_index(Search_String) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Search) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Search_Up) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Search_Down) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Replace) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Replace_One) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Replace_All) [list source [file join $dir GAGsearchstring.proc]]
|
||||
set auto_index(Command_History) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(CH_Save_Window) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(CH_Save) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Search_String_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Search_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Search_Up_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Search_Down_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Replace_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Replace_One_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
set auto_index(Replace_All_CH) [list source [file join $dir GAGhistory.proc]]
|
||||
@@ -0,0 +1,43 @@
|
||||
## global variable
|
||||
env
|
||||
HOME
|
||||
FC
|
||||
FR
|
||||
FG
|
||||
FB
|
||||
BC
|
||||
BR
|
||||
BG
|
||||
BB
|
||||
|
||||
|
||||
## procedures
|
||||
#Momo.tcl
|
||||
Style_Pack
|
||||
Position_Pack
|
||||
|
||||
#Public.proc
|
||||
File_List_Skeleton w
|
||||
Change_Path DIR
|
||||
Put_File_List w
|
||||
Win_Size w
|
||||
Chenge_Font {FONT WIDGET}
|
||||
Scroll_Link {WIDGET args}
|
||||
Chenge_Color {F B WIDGET}
|
||||
Value_Check {TYPE VALUE}
|
||||
Tab_off
|
||||
Message_Skeleton args
|
||||
|
||||
#SelectFont.proc
|
||||
Select_Font
|
||||
Get_Font_List
|
||||
|
||||
#DefineColor.proc
|
||||
Define_Color
|
||||
Make_Color {w args}
|
||||
Set_Color
|
||||
Reset_Color SWITCH
|
||||
|
||||
#SetEnv.proc
|
||||
List_Env
|
||||
Put_Env
|
||||
@@ -0,0 +1,293 @@
|
||||
## Momo.tcl
|
||||
# Momo main proc
|
||||
## !!!!!!!!! This is obsolete !!!!!! Use tMomo.tcl instead
|
||||
# Tcl/Tk version and JAVA version are separated.
|
||||
# tMomo.tcl is the "pure" Tcl/Tk Momo
|
||||
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## NO MORE SUPPORTED FOR GEANT4 BETA
|
||||
|
||||
## Set global variable
|
||||
# $MOMOPATH/Momo/tcltk/GAG structure is assumed
|
||||
|
||||
if [info exists env(MOMOPATH)] {
|
||||
set END [expr [string length $env(MOMOPATH)] - 1]
|
||||
if {[string index $env(MOMOPATH) $END] == "/"} {
|
||||
set HOME [string range $env(MOMOPATH) 0 [expr $END - 1]]
|
||||
} else {
|
||||
set HOME $env(MOMOPATH)
|
||||
}
|
||||
} else {
|
||||
set HOME $env(HOME)/Momo/tcltk
|
||||
}
|
||||
set WISH wish$tk_version
|
||||
set JAVA java
|
||||
set env(G_PATH) $env(PWD)
|
||||
|
||||
set Env_Name [list FONT GUI_STYLE GUI_POSITION FORE_GROUND_COLOR BACK_GROUND_COLOR]
|
||||
|
||||
# .Momorc to save fonts and colors, .Momoext to save Momo extension
|
||||
set SAVE_FILE .Momorc
|
||||
set ENV_FILE .Momoext
|
||||
|
||||
set errorCode NONE
|
||||
set errorInfo ""
|
||||
|
||||
## tclIndex
|
||||
set auto_path [linsert $auto_path 0 $HOME/]
|
||||
|
||||
if [file exists $env(HOME)/$SAVE_FILE] {
|
||||
set file_ID [open $env(HOME)/$SAVE_FILE r]
|
||||
while {![eof $file_ID]} {
|
||||
set STRING [gets $file_ID]
|
||||
while {[string index $STRING 0] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
set STRING [string range $STRING 1 end]
|
||||
}
|
||||
set LAST [string length $STRING]
|
||||
incr LAST -1
|
||||
while {[string index $STRING $LAST] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
incr LAST -1
|
||||
set STRING [string range $STRING 0 $LAST]
|
||||
}
|
||||
set LAST [string first " " $STRING]
|
||||
set FIRST [expr $LAST + 1]
|
||||
incr LAST -1
|
||||
set env([string range $STRING 0 $LAST]) [string range $STRING $FIRST end]
|
||||
}
|
||||
unset env([string range $STRING 0 $LAST])
|
||||
close $file_ID
|
||||
}
|
||||
|
||||
if {[lsearch [array names env] GUI_STYLE] < 0} {
|
||||
set env(GUI_STYLE) horizontal
|
||||
}
|
||||
if {[lsearch [array names env] GUI_POSITION] < 0} {
|
||||
set env(GUI_POSITION) left
|
||||
}
|
||||
if {[lsearch [array names env] FORE_GROUND_COLOR] < 0} {
|
||||
set env(FORE_GROUND_COLOR) #000000000
|
||||
set FC env(FORE_GROUND_COLOR)
|
||||
set FR 0
|
||||
set FG 0
|
||||
set FB 0
|
||||
} else {
|
||||
set FC $env(FORE_GROUND_COLOR)
|
||||
if {[string index $FC 0] == "#"} {
|
||||
Reset_Color F
|
||||
} else {
|
||||
set FR 0
|
||||
set FG 0
|
||||
set FB 0
|
||||
}
|
||||
}
|
||||
if {[lsearch [array names env] BACK_GROUND_COLOR] < 0} {
|
||||
set env(BACK_GROUND_COLOR) #d90d90d90
|
||||
set BC env(BACK_GROUND_COLOR)
|
||||
set BR 0.848
|
||||
set BG 0.848
|
||||
set BB 0.848
|
||||
} else {
|
||||
set BC $env(BACK_GROUND_COLOR)
|
||||
if {[string index $BC 0] == "#"} {
|
||||
Reset_Color B
|
||||
} else {
|
||||
set BR 0.848
|
||||
set BG 0.848
|
||||
set BB 0.848
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
## Make window
|
||||
. configure -highlightthickness 0
|
||||
|
||||
menubutton .function -text Function -menu .function.menu -bd 3 \
|
||||
-relief raised -highlightthickness 0
|
||||
|
||||
menu .function.menu -tearoff 0
|
||||
.function.menu add cascade -label Position \
|
||||
-menu .function.menu.position
|
||||
.function.menu add cascade -label Style \
|
||||
-menu .function.menu.style
|
||||
.function.menu add separator
|
||||
.function.menu add command -label Exit -command {
|
||||
set file_ID [open $env(HOME)/$SAVE_FILE w]
|
||||
foreach VARIABLE $Env_Name {
|
||||
if [info exists env($VARIABLE)] {
|
||||
puts $file_ID "$VARIABLE $env($VARIABLE)"
|
||||
}
|
||||
}
|
||||
close $file_ID
|
||||
exit
|
||||
}
|
||||
|
||||
menu .function.menu.position -tearoff 0
|
||||
.function.menu.position add radiobutton -label Left \
|
||||
-variable env(GUI_POSITION) -value left -command Position_Pack
|
||||
.function.menu.position add radiobutton -label Right \
|
||||
-variable env(GUI_POSITION) -value right -command Position_Pack
|
||||
|
||||
menu .function.menu.style -tearoff 0
|
||||
.function.menu.style add radiobutton -label Horizontal \
|
||||
-variable env(GUI_STYLE) -value horizontal -command Style_Pack
|
||||
.function.menu.style add radiobutton -label Vertical \
|
||||
-variable env(GUI_STYLE) -value vertical -command Style_Pack
|
||||
|
||||
|
||||
menubutton .env -text Environment -menu .env.menu -bd 3 \
|
||||
-relief raised -highlightthickness 0
|
||||
|
||||
menu .env.menu -tearoff 0
|
||||
.env.menu add command -label Color -command Define_Color
|
||||
.env.menu add command -label Font -command Select_Font
|
||||
.env.menu add separator
|
||||
.env.menu add command -label "ENV variables" -command List_Env
|
||||
#.env.menu entryconfigure Font -state disabled
|
||||
|
||||
menubutton .gag -text "GAG(GEANT4 Adaptive GUI)" -bd 3 -menu .gag.menu \
|
||||
-relief raised -highlightthickness 0
|
||||
|
||||
menu .gag.menu -tearoff 0
|
||||
.gag.menu add command -label "Tcl/Tk(8.0) version" \
|
||||
-command {
|
||||
raise .
|
||||
exec $WISH $HOME/GAG/GAG.tcl &
|
||||
}
|
||||
.gag.menu add command -label "Java version" \
|
||||
-command {
|
||||
raise .
|
||||
exec $JAVA $HOME/GAG/GAG &
|
||||
}
|
||||
|
||||
menubutton .gge -text "GGE(GEANT4 Geometry Editor)" -bd 3 \
|
||||
-relief raised -menu .gge.menu -highlightthickness 0
|
||||
|
||||
menu .gge.menu -tearoff 0
|
||||
.gge.menu add command -label "Tcl/Tk(8.0) version" \
|
||||
-command {
|
||||
raise .
|
||||
exec $WISH $HOME/GGE/GGE.tcl &
|
||||
}
|
||||
.gge.menu add command -label "Java version" \
|
||||
-command {
|
||||
raise .
|
||||
exec $JAVA $HOME/GGE/GAG &
|
||||
}
|
||||
|
||||
|
||||
button .fb -text "File Browser" -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
raise .
|
||||
FBmain
|
||||
}
|
||||
|
||||
if [file exists $env(HOME)/$ENV_FILE] {
|
||||
menubutton .ext -text Extension -bd 3 -menu .ext.menu \
|
||||
-relief raised -highlightthickness 0
|
||||
menu .ext.menu -tearoff 0
|
||||
|
||||
set file_ID [open $env(HOME)/$ENV_FILE r]
|
||||
|
||||
while {![eof $file_ID]} {
|
||||
set STRING [gets $file_ID]
|
||||
while {[string index $STRING 0] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
set STRING [string range $STRING 1 end]
|
||||
}
|
||||
set LAST [string length $STRING]
|
||||
incr LAST -1
|
||||
while {[string index $STRING $LAST] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
incr LAST -1
|
||||
set STRING [string range $STRING 0 $LAST]
|
||||
}
|
||||
if {$STRING == "Momoseparator"} {
|
||||
.ext.menu add separator
|
||||
} elseif {$STRING != "" && [string index $STRING 0] != "#"} {
|
||||
.ext.menu add command -label $STRING -command "exec $STRING &"
|
||||
}
|
||||
}
|
||||
close $file_ID
|
||||
|
||||
bind .ext <ButtonRelease> {
|
||||
raise .
|
||||
raise .ext.menu
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
## Procedures
|
||||
# Change Style
|
||||
proc Style_Pack {} {
|
||||
global env
|
||||
|
||||
set WIDGET [winfo children .]
|
||||
pack forget .
|
||||
switch $env(GUI_STYLE) {
|
||||
horizontal {eval pack $WIDGET -side left -fill both
|
||||
.gag configure -text "GAG(GEANT4 Adaptive GUI)"
|
||||
.gge configure -text "GGE(GEANT4 Geometry Editor)"
|
||||
}
|
||||
vertical {eval pack $WIDGET -side top -fill both
|
||||
.gag configure -text "GAG\n(GEANT4 Adaptive GUI)"
|
||||
.gge configure -text "GGE\n(GEANT4 Geometry Editor)"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Change Position
|
||||
proc Position_Pack {} {
|
||||
global env
|
||||
|
||||
switch $env(GUI_POSITION) {
|
||||
left {wm geometry . +0+0}
|
||||
right {wm geometry . -0+0}
|
||||
}
|
||||
}
|
||||
|
||||
wm deiconify .
|
||||
wm geometry . +0+0
|
||||
wm overrideredirect . 1
|
||||
wm resizable . 0 0
|
||||
|
||||
# Binding
|
||||
bind .function <ButtonRelease> {
|
||||
raise .
|
||||
raise .function.menu
|
||||
}
|
||||
bind .env <ButtonRelease> {
|
||||
raise .
|
||||
raise .env.menu
|
||||
}
|
||||
bind .gag <ButtonRelease> {
|
||||
raise .
|
||||
raise .gag.menu
|
||||
}
|
||||
bind .gge <ButtonRelease> {
|
||||
raise .
|
||||
raise .gge.menu
|
||||
}
|
||||
bind .fb <ButtonRelease> {
|
||||
raise .
|
||||
}
|
||||
|
||||
if {[lsearch [array names env] FONT] >= 0} {
|
||||
Change_Font $env(FONT) .
|
||||
}
|
||||
|
||||
Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .
|
||||
Tab_off
|
||||
|
||||
Style_Pack
|
||||
Position_Pack
|
||||
Del_Bind
|
||||
Control
|
||||
|
||||
#bind Menubutton <Leave> {
|
||||
# foreach w [winfo children .] {
|
||||
# grab release $w
|
||||
# }
|
||||
#}
|
||||
#bind Menubutton <Motion> {}
|
||||
@@ -0,0 +1,547 @@
|
||||
## 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)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,82 @@
|
||||
README Tcl/Tk Momo and GAG
|
||||
|
||||
--22 July 1998 at Niigata WS
|
||||
- standard MOMOPATH is $G4INSTALL/environments/Momo/tcltk
|
||||
- type %$MOMOPATH/tmomo to invoke Momo and GAG
|
||||
- Add "New Shell" button
|
||||
- Add "Continue" button
|
||||
- example .Momoext and .Momorc files included in the repository
|
||||
|
||||
--5 July 1998
|
||||
|
||||
- All relevant file contains a line including "Beta-01"
|
||||
- Unnecessary files removed.
|
||||
- Tcl/Tk GGE is left as it was, though its development has been
|
||||
stopped. See GGE/README file.
|
||||
|
||||
Improvements
|
||||
- GAG can now defend itself from some illegal command hierarchy
|
||||
- GAG has "Exit, Kill GEANT4" menu buttons.
|
||||
- GAG menu structures and displayed labels are more
|
||||
understandable, we hope.
|
||||
|
||||
|
||||
--16 Apr 1998
|
||||
|
||||
Momo and GAG(Geant4 Adaptive GUI) are developed under tcl8.0, tk8.0.
|
||||
The older versions (Tcl7.6/Tk7.4 etc.) are no longer supported.
|
||||
|
||||
Momo.tcl which can invoke both Java and Tcl/Tk GAG is now obsolete.
|
||||
tMomo.tcl is a pure Tcl/Tk version which invokes only Tcl/Tk scripts.
|
||||
|
||||
A) How to invoke.
|
||||
|
||||
%wish8.0 ~/Momo/tcltk/tMomo.tcl
|
||||
|
||||
The older version of wish 7.4 can be used.
|
||||
|
||||
The version of wish to invoke ~/Momo/tcltk/GAG/GAG.tcl and
|
||||
~/Momo/tcltk/GGE/GGE.tcl from ~/Momo/tcltk/tMomo.tcl is the same
|
||||
as that used to invoke ~/Momo/tcltk/Momo.tcl.
|
||||
|
||||
|
||||
B) Environmental variable MOMOPATH
|
||||
|
||||
This variable is used to specify the directory to which tMomo.tcl
|
||||
refers. If not setenved, users home directory becomes the MOMOPATH.
|
||||
MOMOHOME is no longer valid.
|
||||
|
||||
|
||||
|
||||
C) Save working environments
|
||||
|
||||
The following working environments of Momo are saved automatically
|
||||
in a file .Momorc under the user's home directory, when Momo is
|
||||
terminated normally. .Momorc is automatically used at the next
|
||||
invocation.
|
||||
|
||||
If the file .Momorc is deleted, the default values are used.
|
||||
|
||||
|
||||
|
||||
D) Extensions/Plug-ins
|
||||
|
||||
You can use any plug-ins by writing a file .Momoext under the
|
||||
home directory. This allows you to extend Momo's function as you like.
|
||||
|
||||
|
||||
Momo/tcltk/tMomo.tcl analyses commands in .Momoext and creates menu
|
||||
buttons "Extension". The extended commands are registered to Extension
|
||||
as menu buttons and can be invoked upon mouse clicks.
|
||||
|
||||
Rule to write .Momoext)
|
||||
1) a command per line
|
||||
2) a line starting with "#" is a comment line
|
||||
3) the reserved command "Momoseparator" creates a separator in the munu
|
||||
|
||||
See an example ~/Momo/tcltk/.Momoext for further details.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,146 @@
|
||||
## SelectFont
|
||||
## (Momo procedure)
|
||||
# make Change Font window
|
||||
##
|
||||
# NOTE: proc Get_Font_List {} uses X command "xlsfonts"
|
||||
# to have a list of available fonts.
|
||||
# ==> This must be changed for Windows
|
||||
#
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1997.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
|
||||
proc Select_Font {} {
|
||||
if [winfo exists .cf] {
|
||||
raise .cf
|
||||
focus .cf.info.ent.font
|
||||
return
|
||||
}
|
||||
|
||||
global env
|
||||
|
||||
toplevel .cf -highlightthickness 0
|
||||
wm title .cf "Select Font"
|
||||
|
||||
|
||||
frame .cf.butt -highlightthickness 0
|
||||
pack .cf.butt -side top -fill x
|
||||
|
||||
button .cf.butt.b0 -text "Change Font" -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
set env(FONT) [.cf.info.ent.font get]
|
||||
Change_Font $env(FONT) .
|
||||
Win_Size .cf
|
||||
if [winfo exists .dc] {
|
||||
Change_Font $env(FONT) .dc
|
||||
Win_Size .dc
|
||||
}
|
||||
if [winfo exists .se] {
|
||||
Change_Font $env(FONT) .se
|
||||
Put_Env
|
||||
Win_Size .se
|
||||
}
|
||||
}
|
||||
button .cf.butt.b1 -text Clear -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
.cf.select.list see 0
|
||||
.cf.select.list selection clear 0 end
|
||||
focus .cf.info.ent.font
|
||||
.cf.info.ent.font delete 0 end
|
||||
}
|
||||
button .cf.butt.b2 -text Cancel -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
if [winfo exists .cf] {destroy .cf}
|
||||
}
|
||||
pack .cf.butt.b0 .cf.butt.b1 .cf.butt.b2 -side left
|
||||
|
||||
|
||||
frame .cf.info -highlightthickness 0
|
||||
pack .cf.info -side top -fill x
|
||||
|
||||
frame .cf.info.lb -highlightthickness 0
|
||||
pack .cf.info.lb -side left
|
||||
|
||||
label .cf.info.lb.ex -text Example -anchor w \
|
||||
-bd 1 -relief raised -highlightthickness 0
|
||||
pack .cf.info.lb.ex -side top
|
||||
|
||||
label .cf.info.lb.font -text Font -anchor w \
|
||||
-bd 1 -relief raised -highlightthickness 0
|
||||
pack .cf.info.lb.font -side top -fill x
|
||||
|
||||
|
||||
frame .cf.info.ent -highlightthickness 0
|
||||
pack .cf.info.ent -side left -fill x -expand 1
|
||||
|
||||
label .cf.info.ent.ex -text "This is font style." -anchor w \
|
||||
-relief sunken -highlightthickness 0
|
||||
pack .cf.info.ent.ex -side top -fill x -expand 1
|
||||
|
||||
entry .cf.info.ent.font -highlightthickness 0
|
||||
pack .cf.info.ent.font -side top -fill x -expand 1
|
||||
|
||||
|
||||
frame .cf.select -highlightthickness 0
|
||||
pack .cf.select -side top -fill both -expand 1
|
||||
|
||||
listbox .cf.select.list -width 80 -height 20 \
|
||||
-yscrollcommand {.cf.select.scroll set} \
|
||||
-highlightthickness 0
|
||||
pack .cf.select.list -side left -fill both -expand 1
|
||||
|
||||
scrollbar .cf.select.scroll -command {.cf.select.list yview} \
|
||||
-highlightthickness 0
|
||||
pack .cf.select.scroll -side left -fill y
|
||||
|
||||
focus .cf.info.ent.font
|
||||
|
||||
# Binding
|
||||
bind .cf.select.list <ButtonRelease> {
|
||||
.cf.info.ent.font delete 0 end
|
||||
set FONT [selection get]
|
||||
.cf.info.ent.font insert end $FONT
|
||||
catch {.cf.info.lb.ex configure -font $FONT}
|
||||
catch {.cf.info.ent.ex configure -font $FONT}
|
||||
|
||||
global errorCode errorInfo
|
||||
if {$errorCode != "NONE"} {
|
||||
set errorCode NONE
|
||||
}
|
||||
if {$errorInfo != ""} {
|
||||
set errorInfo ""
|
||||
}
|
||||
}
|
||||
|
||||
bind .cf.select.list <Double-Button> {.cf.butt.b0 invoke}
|
||||
|
||||
bind .cf.info.ent.font <Return> {.cf.butt.b0 invoke}
|
||||
|
||||
|
||||
Get_Font_List
|
||||
if {[lsearch [array names env] FONT] >= 0} {
|
||||
Change_Font $env(FONT) .cf
|
||||
}
|
||||
Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .cf
|
||||
Win_Size .cf
|
||||
Tab_off
|
||||
Control
|
||||
}
|
||||
|
||||
# Get Font List
|
||||
# NOTE: Use X command "xlsfonts"
|
||||
proc Get_Font_List {} {
|
||||
if {![winfo exists .cf.select.list]} {
|
||||
Message_Skeleton -icon warning -button O.K. \
|
||||
-message "Warning!\nWhat's happen?"
|
||||
.msgskeleton.butt.0 configure -command {destroy .msgskeleton}
|
||||
return
|
||||
}
|
||||
|
||||
set List [exec xlsfonts]
|
||||
foreach l $List {
|
||||
.cf.select.list insert end $l
|
||||
}
|
||||
}
|
||||
@@ -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)
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,305 @@
|
||||
## tMomo.tcl
|
||||
## This can invoke Tcl/Tk GAG, File borwser and Extensions.
|
||||
## This replaces Momo.tcl, an obsolete Momo
|
||||
##
|
||||
## k.ohtubo(Tubocky)
|
||||
##
|
||||
## 1998.3.16
|
||||
## Tcl/Tk version 8.0
|
||||
## 1998 July 5 GEANT4 Beta-01
|
||||
## 1998 July 20 added "New Shell" and "continue" commands
|
||||
## Set global variable
|
||||
# MOMOPATH/tcltk/Momo/GAG hierarchy is required
|
||||
|
||||
if [info exists env(MOMOPATH)] {
|
||||
set END [expr [string length $env(MOMOPATH)] - 1]
|
||||
if {[string index $env(MOMOPATH) $END] == "/"} {
|
||||
set HOME [string range $env(MOMOPATH) 0 [expr $END - 1]]
|
||||
} else {
|
||||
set HOME $env(MOMOPATH)
|
||||
}
|
||||
} else {
|
||||
set HOME $env(HOME)/Momo/tcltk
|
||||
}
|
||||
set WISH wish$tk_version
|
||||
set env(G_PATH) $env(PWD)
|
||||
|
||||
set Env_Name [list FONT GUI_STYLE GUI_POSITION FORE_GROUND_COLOR BACK_GROUND_COLOR]
|
||||
|
||||
## init files for Momo settings (font and color) and extension
|
||||
set SAVE_FILE .Momorc
|
||||
set ENV_FILE .Momoext
|
||||
|
||||
set errorCode NONE
|
||||
set errorInfo ""
|
||||
|
||||
## tclIndex
|
||||
set auto_path [linsert $auto_path 0 $HOME/]
|
||||
|
||||
if [file exists $env(HOME)/$SAVE_FILE] {
|
||||
set file_ID [open $env(HOME)/$SAVE_FILE r]
|
||||
while {![eof $file_ID]} {
|
||||
set STRING [gets $file_ID]
|
||||
while {[string index $STRING 0] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
set STRING [string range $STRING 1 end]
|
||||
}
|
||||
set LAST [string length $STRING]
|
||||
incr LAST -1
|
||||
while {[string index $STRING $LAST] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
incr LAST -1
|
||||
set STRING [string range $STRING 0 $LAST]
|
||||
}
|
||||
set LAST [string first " " $STRING]
|
||||
set FIRST [expr $LAST + 1]
|
||||
incr LAST -1
|
||||
set env([string range $STRING 0 $LAST]) [string range $STRING $FIRST end]
|
||||
}
|
||||
unset env([string range $STRING 0 $LAST])
|
||||
close $file_ID
|
||||
}
|
||||
|
||||
if {[lsearch [array names env] GUI_STYLE] < 0} {
|
||||
set env(GUI_STYLE) horizontal
|
||||
}
|
||||
if {[lsearch [array names env] GUI_POSITION] < 0} {
|
||||
set env(GUI_POSITION) left
|
||||
}
|
||||
if {[lsearch [array names env] FORE_GROUND_COLOR] < 0} {
|
||||
set env(FORE_GROUND_COLOR) #000000000
|
||||
set FC env(FORE_GROUND_COLOR)
|
||||
set FR 0
|
||||
set FG 0
|
||||
set FB 0
|
||||
} else {
|
||||
set FC $env(FORE_GROUND_COLOR)
|
||||
if {[string index $FC 0] == "#"} {
|
||||
Reset_Color F
|
||||
} else {
|
||||
set FR 0
|
||||
set FG 0
|
||||
set FB 0
|
||||
}
|
||||
}
|
||||
if {[lsearch [array names env] BACK_GROUND_COLOR] < 0} {
|
||||
set env(BACK_GROUND_COLOR) #d90d90d90
|
||||
set BC env(BACK_GROUND_COLOR)
|
||||
set BR 0.848
|
||||
set BG 0.848
|
||||
set BB 0.848
|
||||
} else {
|
||||
set BC $env(BACK_GROUND_COLOR)
|
||||
if {[string index $BC 0] == "#"} {
|
||||
Reset_Color B
|
||||
} else {
|
||||
set BR 0.848
|
||||
set BG 0.848
|
||||
set BB 0.848
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
## Make window
|
||||
. configure -highlightthickness 0
|
||||
|
||||
menubutton .function -text Function -menu .function.menu -bd 3 \
|
||||
-relief raised -highlightthickness 0
|
||||
|
||||
menu .function.menu -tearoff 0
|
||||
.function.menu add cascade -label Position \
|
||||
-menu .function.menu.position
|
||||
.function.menu add cascade -label Style \
|
||||
-menu .function.menu.style
|
||||
.function.menu add separator
|
||||
.function.menu add command -label Exit -command {
|
||||
set file_ID [open $env(HOME)/$SAVE_FILE w]
|
||||
foreach VARIABLE $Env_Name {
|
||||
if [info exists env($VARIABLE)] {
|
||||
puts $file_ID "$VARIABLE $env($VARIABLE)"
|
||||
}
|
||||
}
|
||||
close $file_ID
|
||||
exit
|
||||
}
|
||||
|
||||
menu .function.menu.position -tearoff 0
|
||||
.function.menu.position add radiobutton -label Left \
|
||||
-variable env(GUI_POSITION) -value left -command Position_Pack
|
||||
.function.menu.position add radiobutton -label Right \
|
||||
-variable env(GUI_POSITION) -value right -command Position_Pack
|
||||
|
||||
menu .function.menu.style -tearoff 0
|
||||
.function.menu.style add radiobutton -label Horizontal \
|
||||
-variable env(GUI_STYLE) -value horizontal -command Style_Pack
|
||||
.function.menu.style add radiobutton -label Vertical \
|
||||
-variable env(GUI_STYLE) -value vertical -command Style_Pack
|
||||
|
||||
|
||||
menubutton .env -text Environment -menu .env.menu -bd 3 \
|
||||
-relief raised -highlightthickness 0
|
||||
|
||||
menu .env.menu -tearoff 0
|
||||
.env.menu add command -label Color -command Define_Color
|
||||
.env.menu add command -label Font -command Select_Font
|
||||
.env.menu add separator
|
||||
.env.menu add command -label "Env Variables" -command List_Env
|
||||
#.env.menu entryconfigure Font -state disabled
|
||||
|
||||
button .gag -text "GAG" -highlightthickness 0 \
|
||||
-command {
|
||||
raise .
|
||||
exec $WISH $HOME/GAG/GAG.tcl &
|
||||
} -bd 3
|
||||
#menubutton .gag -text "GAG(GEANT4 Adaptive GUI)" -bd 3 -menu .gag.menu \
|
||||
# -relief raised -highlightthickness 0
|
||||
|
||||
#menu .gag.menu -tearoff 0
|
||||
#.gag.menu add command -label "Tcl/Tk(8.0) version" \
|
||||
# -command {
|
||||
# raise .
|
||||
# exec $WISH $HOME/GAG/GAG.tcl &
|
||||
# }
|
||||
###### JAVA GAG removed
|
||||
#.gag.menu add command -label "Java version" \
|
||||
# -command {
|
||||
# raise .
|
||||
# exec $JAVA $HOME/GAG/GAG &
|
||||
# }
|
||||
##### GGE removed for Beta-01
|
||||
#menubutton .gge -text "GGE(GEANT4 Geometry Editor)" -bd 3 \
|
||||
# -relief raised -menu .gge.menu -highlightthickness 0
|
||||
|
||||
#menu .gge.menu -tearoff 0
|
||||
#.gge.menu add command -label "Tcl/Tk(8.0) version" \
|
||||
# -command {
|
||||
# raise .
|
||||
# exec $WISH $HOME/GGE/GGE.tcl &
|
||||
# }
|
||||
#.gge.menu add command -label "Java version" \
|
||||
# -command {
|
||||
# raise .
|
||||
# exec $JAVA $HOME/GGE/GAG &
|
||||
# }
|
||||
|
||||
|
||||
button .fb -text "File Browser" -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
raise .
|
||||
FBmain
|
||||
}
|
||||
|
||||
# added 1998 July 20
|
||||
|
||||
button .shel -text "New Shell" -bd 3 -highlightthickness 0 \
|
||||
-command {
|
||||
raise .
|
||||
exec xterm &
|
||||
}
|
||||
|
||||
|
||||
|
||||
if [file exists $env(HOME)/$ENV_FILE] {
|
||||
menubutton .ext -text Plugins -bd 3 -menu .ext.menu \
|
||||
-relief raised -highlightthickness 0
|
||||
menu .ext.menu -tearoff 0
|
||||
|
||||
set file_ID [open $env(HOME)/$ENV_FILE r]
|
||||
|
||||
while {![eof $file_ID]} {
|
||||
set STRING [gets $file_ID]
|
||||
while {[string index $STRING 0] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
set STRING [string range $STRING 1 end]
|
||||
}
|
||||
set LAST [string length $STRING]
|
||||
incr LAST -1
|
||||
while {[string index $STRING $LAST] == " " || [string index $STRING 0 ] == "\t"} {
|
||||
incr LAST -1
|
||||
set STRING [string range $STRING 0 $LAST]
|
||||
}
|
||||
if {$STRING == "Momoseparator"} {
|
||||
.ext.menu add separator
|
||||
} elseif {$STRING != "" && [string index $STRING 0] != "#"} {
|
||||
.ext.menu add command -label $STRING -command "exec $STRING &"
|
||||
}
|
||||
}
|
||||
close $file_ID
|
||||
|
||||
bind .ext <ButtonRelease> {
|
||||
raise .
|
||||
raise .ext.menu
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
## Procedures
|
||||
# Change Style
|
||||
proc Style_Pack {} {
|
||||
global env
|
||||
|
||||
set WIDGET [winfo children .]
|
||||
pack forget .
|
||||
switch $env(GUI_STYLE) {
|
||||
horizontal {eval pack $WIDGET -side left -fill both
|
||||
.gag configure -text "GAG"
|
||||
# .gge configure -text "GGE(GEANT4 Geometry Editor)"
|
||||
}
|
||||
vertical {eval pack $WIDGET -side top -fill both
|
||||
.gag configure -text "GAG\n"
|
||||
# .gge configure -text "GGE\n(GEANT4 Geometry Editor)"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Change Position
|
||||
proc Position_Pack {} {
|
||||
global env
|
||||
|
||||
switch $env(GUI_POSITION) {
|
||||
left {wm geometry . +0+0}
|
||||
right {wm geometry . -0+0}
|
||||
}
|
||||
}
|
||||
|
||||
wm deiconify .
|
||||
wm geometry . +0+0
|
||||
wm overrideredirect . 1
|
||||
wm resizable . 0 0
|
||||
|
||||
# Binding
|
||||
bind .function <ButtonRelease> {
|
||||
raise .
|
||||
raise .function.menu
|
||||
}
|
||||
bind .env <ButtonRelease> {
|
||||
raise .
|
||||
raise .env.menu
|
||||
}
|
||||
#bind .gag <ButtonRelease> {
|
||||
# raise .
|
||||
# raise .gag.menu
|
||||
#}
|
||||
#bind .gge <ButtonRelease> {
|
||||
# raise .
|
||||
# raise .gge.menu
|
||||
#}
|
||||
bind .fb <ButtonRelease> {
|
||||
raise .
|
||||
}
|
||||
|
||||
if {[lsearch [array names env] FONT] >= 0} {
|
||||
Change_Font $env(FONT) .
|
||||
}
|
||||
|
||||
Change_Color $env(FORE_GROUND_COLOR) $env(BACK_GROUND_COLOR) .
|
||||
Tab_off
|
||||
|
||||
Style_Pack
|
||||
Position_Pack
|
||||
Del_Bind
|
||||
Control
|
||||
|
||||
#bind Menubutton <Leave> {
|
||||
# foreach w [winfo children .] {
|
||||
# grab release $w
|
||||
# }
|
||||
#}
|
||||
#bind Menubutton <Motion> {}
|
||||
@@ -0,0 +1,30 @@
|
||||
# Tcl autoload index file, version 2.0
|
||||
# This file is generated by the "auto_mkindex" command
|
||||
# and sourced to set up indexing information for one or
|
||||
# more commands. Typically each line is a command that
|
||||
# sets an element in the auto_index array, where the
|
||||
# element name is the name of a command and the value is
|
||||
# a script that loads the command.
|
||||
|
||||
set auto_index(Define_Color) [list source [file join $dir DefineColor.proc]]
|
||||
set auto_index(Make_Color) [list source [file join $dir DefineColor.proc]]
|
||||
set auto_index(Set_Color) [list source [file join $dir DefineColor.proc]]
|
||||
set auto_index(Reset_Color) [list source [file join $dir DefineColor.proc]]
|
||||
set auto_index(FBmain) [list source [file join $dir FBmain.proc]]
|
||||
set auto_index(File_List_Skeleton) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Change_Path) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Put_File_List) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Win_Size) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Change_Font) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Scroll_Link) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Change_Color) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Value_Check) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Tab_off) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Del_Bind) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Message_Skeleton) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Another_Line) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Control) [list source [file join $dir Public.proc]]
|
||||
set auto_index(Select_Font) [list source [file join $dir SelectFont.proc]]
|
||||
set auto_index(Get_Font_List) [list source [file join $dir SelectFont.proc]]
|
||||
set auto_index(List_Env) [list source [file join $dir SetEnv.proc]]
|
||||
set auto_index(Put_Env) [list source [file join $dir SetEnv.proc]]
|
||||
Executable
+2
@@ -0,0 +1,2 @@
|
||||
## invoke tMomo.tcl
|
||||
wish $MOMOPATH/tMomo.tcl
|
||||
Reference in New Issue
Block a user