139 lines
3.1 KiB
PSL
139 lines
3.1 KiB
PSL
## 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
|
|
}
|