Changeset 29


Ignore:
Timestamp:
Dec 4, 2009 4:59:11 PM (11 years ago)
Author:
toby
Message:

# on 1999/01/20 19:27:48, toby did:
use custom file open box; fix GSAS env definition on -95 and -NT

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gsascmds.tcl

    • Property rcs:date changed from 1999/01/07 04:45:54 to 1999/01/20 19:27:48
    • Property rcs:lines changed from +29 -24 to +283 -104
    • Property rcs:rev changed from 1.2 to 1.3
    r22 r29  
    1010    }
    1111    if {$tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } {
     12        # this creates a DOS box to run a program in
    1213        proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
    1314            global env expgui
    1415            # Windows environment variables
    1516            # -95 does not seem to be able to use these
    16             set env(GSAS) [file nativename $expgui(gsasexe)]
     17            set env(GSAS) [file nativename $expgui(gsasdir)]
    1718            # PGPLOT_FONT is needed by PGPLOT
    1819            set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
     
    4647    } else {
    4748        # now for - brain-dead Windows-NT
     49        # this creates a DOS box to run a program in
    4850        proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
    4951            global env expgui
    5052            # Windows environment variables
    5153            # -95 does not seem to be able to use these
    52             set env(GSAS) [file nativename $expgui(gsasexe)]
     54            set env(GSAS) [file nativename $expgui(gsasdir)]
    5355            # PGPLOT_FONT is needed by PGPLOT
    5456            set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
     
    7577    if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1}
    7678
     79    # this creates a xterm window to run a program in
    7780    proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
    7881        global env expgui
     
    112115}
    113116
    114 
    115 proc newexp {} {
    116     global infile outfile
    117     set frm .file
    118     catch {destroy $frm}
    119     toplevel $frm
    120     pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
    121     pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
    122     pack [button $frmC.b -text Create -command "valid_new_exp_file"] -side top
    123     bind $frm <Return> "valid_new_exp_file"
    124     pack [button $frmC.q -text Quit -command "set infile(done) 2"] -side top
    125 
    126     pack [label $frmA.0 -text "Enter an experiment file"] -side top -anchor center
    127     expfilebox $frmA infile 2
    128     set infile(done) 0
    129     # force the window to stay on top
    130     wm transient $frm [winfo toplevel [winfo parent $frm]]
    131 
    132     wm withdraw $frm
    133     update idletasks
    134     # center the new window in the middle of the parent
    135     set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
    136             [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
    137     set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
    138             [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
    139     wm geom $frm +$x+$y
    140     wm deiconify $frm
    141 
    142     set oldFocus [focus]
    143     set oldGrab [grab current $frm]
    144     if {$oldGrab != ""} {
    145         set grabStatus [grab status $oldGrab]
    146     }
    147     grab $frm
    148     focus $frmC.b
    149     tkwait variable infile(done)
    150     destroy $frm
    151     catch {focus $oldFocus}
    152     if {$oldGrab != ""} {
    153         if {$grabStatus == "global"} {
    154             grab -global $oldGrab
    155         } else {
    156             grab $oldGrab
    157         }
    158     }
    159     if {$infile(done) == 2} return
    160     return [file join $infile(dir) $infile(name)]
    161 }
    162 
     117# get a value in a modal toplevel
    163118proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
    164119    global expgui expmap
     
    216171}
    217172
    218 
    219 proc next {direction} {
    220     global
    221     set filelist [lsort [glob *.EXP]]
    222     set ind [lsearch $filelist $expnam.EXP]
    223     if {$ind == -1 && $expnam != ""} return
    224     if $direction { # true positive
    225         incr ind
    226     } {
    227         incr ind -1
    228     }
    229     if {$ind < 0} {set ind [expr [llength $filelist]-1]}
    230     if {$ind >= [llength $filelist] } {set ind 0}
    231     set expnam [string toupper [file root [lindex $filelist $ind]]]
    232     showexp
    233 }
    234 
     173# run a GSAS program that does not require an experiment file
    235174proc runGSASprog {proglist} {
    236175    global expgui tcl_platform
     
    247186}
    248187
     188# run a GSAS program that requires an experiment file for input/output
    249189proc runGSASwEXP {proglist} {
    250190    global expgui tcl_platform
     
    266206}
    267207
     208# run liveplot
    268209proc liveplot {} {
    269210    global expgui liveplot wishshell
    270211    set expnam [file root [file tail $expgui(expfile)]]
    271212    exec $wishshell [file join $expgui(scriptdir) liveplot] \
    272             $expnam $expgui(gsasexe) $liveplot(hst) $liveplot(legend) &
    273 }
    274 
     213            $expnam $liveplot(hst) $liveplot(legend) &
     214}
     215
     216# run lstview
    275217proc lstview {} {
    276218    global expgui wishshell
     
    279221}
    280222
     223# run widplt
    281224proc widplt {} {
    282225    global expgui wishshell
    283     set expnam [file root [file tail $expgui(expfile)]]
    284     exec $wishshell [file join $expgui(scriptdir) widplt] $expgui(gsasexe) $expnam &
    285 }
    286 
    287 
     226    exec $wishshell [file join $expgui(scriptdir) widplt] \
     227            $expgui(expfile) &
     228}
     229
     230# show help information
    288231proc showhelp {} {
    289232    global expgui_helplist helpmsg
     
    322265}
    323266
     267# convert a file
    324268proc convfile {} {
    325269    global tcl_platform
     
    523467}
    524468
    525 # validate the files and make the conversion
    526 proc valid_new_exp_file {} {
    527     global infile
    528     if {$infile(name) == ""} return
    529     set infile(name) [file root [string toupper $infile(name)]].EXP
    530     if [file exists [file join $infile(dir) $infile(name)]] {
    531         tk_dialog .warn Notify \
    532                 "Sorry, file $infile(name) found in $infile(dir)" warning 0 OK
    533         return
    534     }
    535     set infile(done) 1
    536 }
    537 
    538 # create a file box
    539 proc expfilebox {bx filvar diropt} {
    540     global ${filvar}
    541     pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top
    542     set ${filvar}(dir) [pwd]
    543     pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
    544     listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \
    545             -height 15 -width 0
    546     scrollbar $bx.a.scroll -command "$bx.a.files yview"
    547     filchoose $bx $bx.a.files $filvar $diropt
    548     bind $bx.a.files <ButtonRelease-1> \
    549             "filchoose $bx $bx.a.files $filvar $diropt"
    550     pack $bx.a.scroll -side left -fill y
    551     pack $bx.a.files -side left -fill both -expand yes
    552     pack [entry $bx.c -textvariable ${filvar}(name)] -side top
    553 }
    554 
    555469# create a file box for conversions
    556470proc cnvfilebox {bx filvar diropt} {
     
    577491# select a file or directory, also called when box is created to fill it
    578492proc filchoose {frm box filvar {dironly 1}} {
    579     global expnam $filvar
     493    global $filvar
    580494    set select [$box curselection]
    581495    if {$select == ""} {
     
    609523}
    610524
    611 # set new file name from old
     525# set new file name from old -- used for convert
    612526proc setoutfile {} {
    613527    global infile outfile
     
    626540}
    627541
     542# set options for liveplot
    628543proc liveplotopt {} {
    629544    global liveplot
     
    669584    }
    670585}
     586
     587#------------------------------------------------------------------------------
     588# get an experiment file name
     589#------------------------------------------------------------------------------
     590proc getExpFileName {mode} {
     591    global expgui
     592    set frm .file
     593    catch {destroy $frm}
     594    toplevel $frm
     595    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
     596    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
     597    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
     598    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
     599            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
     600    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
     601            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
     602    pack [button $frmC.b -text Open \
     603            -command "valid_exp_file $frmA $mode"] -side top
     604    pack [button $frmC.q -text Quit \
     605            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top
     606    bind $frm <Return> "$frmC.b invoke"
     607
     608    pack [label $frmA.0 -text "Enter an experiment file"] -side top -anchor center
     609    expfilebox $frmA $mode
     610    # force the window to stay on top
     611    wm transient $frm [winfo toplevel [winfo parent $frm]]
     612
     613    wm withdraw $frm
     614    update idletasks
     615    # center the new window in the middle of the parent
     616    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
     617            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
     618    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
     619            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
     620    wm geom $frm +$x+$y
     621    wm deiconify $frm
     622
     623    set oldFocus [focus]
     624    set oldGrab [grab current $frm]
     625    if {$oldGrab != ""} {
     626        set grabStatus [grab status $oldGrab]
     627    }
     628    grab $frm
     629    focus $frmC.b
     630    tkwait window $frm
     631    catch {focus $oldFocus}
     632    if {$oldGrab != ""} {
     633        if {$grabStatus == "global"} {
     634            grab -global $oldGrab
     635        } else {
     636            grab $oldGrab
     637        }
     638    }
     639    if {$expgui(FileMenuEXPNAM) == ""} return
     640    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
     641}
     642
     643# validation routine
     644proc valid_exp_file {frm mode} {
     645    global expgui
     646    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
     647        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
     648        ChooseExpFil $frm
     649        return
     650    } elseif [file isdirectory \
     651            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
     652        if {$expgui(FileMenuEXPNAM) != "."} {
     653            set expgui(FileMenuDir) \
     654                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
     655        }
     656        ChooseExpFil $frm
     657        return
     658    }
     659    set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
     660    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
     661        append expgui(FileMenuEXPNAM) ".EXP"
     662    }
     663    if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} {
     664        tk_dialog .expFileErrorMsg "File Open Error" \
     665            "File $expgui(FileMenuEXPNAM) is not a valid name. Experiment files must end in \".EXP\"" \
     666            error 0 OK
     667        return
     668    }
     669    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
     670    if {$mode == "new" && [file exists $file]} {
     671        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
     672            "File $file already exists. OK to overwrite?" question 0 \
     673             "Select other name" "Overwrite"]
     674        if $ans {destroy .file}
     675        return
     676    }
     677    if {$mode == "old" && ![file exists $file]} {
     678        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
     679            "File $file does not exist. OK to create?" question 0 \
     680             "Select other name" "Create"]
     681        if $ans {destroy .file}
     682        return
     683    }
     684    destroy .file
     685}
     686
     687proc updir {} {
     688    global expgui
     689    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
     690}
     691
     692# create a file box
     693proc expfilebox {bx mode} {
     694    global expgui
     695    pack [frame $bx.top] -side top
     696    pack [label $bx.top.a -text "Directory" ] -side left
     697    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
     698    pack $bx.top.d -side left
     699    set expgui(FileMenuDir) [pwd]
     700    # the icon below is from tk8.0/tkfbox.tcl
     701    set upfolder [image create bitmap -data {
     702#define updir_width 28
     703#define updir_height 16
     704static char updir_bits[] = {
     705   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
     706   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
     707   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
     708   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
     709   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
     710   0xf0, 0xff, 0xff, 0x01};}]
     711
     712    pack [button $bx.top.b -image $upfolder \
     713            -command "updir; ChooseExpFil $bx" ]
     714    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
     715    listbox $bx.a.files -relief raised -bd 2 \
     716            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
     717            -height 15 -width 0
     718    listbox $bx.a.dates -relief raised -bd 2 \
     719            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
     720            -height 15 -width 0 -takefocus 0
     721    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
     722    ChooseExpFil $bx
     723    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
     724    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
     725    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
     726    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
     727    pack $bx.a.scroll -side left -fill y
     728    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
     729    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
     730}
     731proc sync2boxes {master slave scroll args} {
     732    $slave yview moveto [lindex [$master yview] 0]
     733    eval $scroll set $args
     734}
     735proc move2boxesY {boxlist args} {
     736    foreach listbox $boxlist {
     737        eval $listbox yview $args
     738    }
     739}
     740
     741# set the box or file in the selection window
     742proc ReleaseExpFil {frm} {
     743    global expgui
     744    set files $frm.a.files
     745    set dates $frm.a.dates
     746    set select [$files curselection]
     747    if {$select == ""} {
     748        set select [$dates curselection]
     749    }
     750    if {$select == ""} {
     751        set expgui(FileMenuEXPNAM) ""
     752    } else {
     753        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
     754    }
     755    return
     756}
     757
     758# select a file or directory -- called on double click
     759proc SelectExpFil {frm mode} {
     760    global expgui
     761    set files $frm.a.files
     762    set dates $frm.a.dates
     763    set select [$files curselection]
     764    if {$select == ""} {
     765        set select [$dates curselection]
     766    }
     767    if {$select == ""} {
     768        set file .
     769    } else {
     770        set file [string trim [$files get $select]]
     771    }
     772    if {$file == "<Parent>"} {
     773        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
     774        ChooseExpFil $frm
     775    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
     776        if {$file != "."} {
     777            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
     778            ChooseExpFil $frm
     779        }
     780    } else {
     781        set expgui(FileMenuEXPNAM) [file tail $file]
     782        valid_exp_file $frm $mode
     783    }
     784}
     785
     786# fill the files & dates & Directory selection box with current directory,
     787# also called when box is created to fill it
     788proc ChooseExpFil {frm} {
     789    global expgui
     790    set files $frm.a.files
     791    set dates $frm.a.dates
     792    set expgui(FileMenuEXPNAM) {}
     793    $files delete 0 end
     794    $dates delete 0 end
     795    $files insert end {<Parent>}
     796    $dates insert end {(Directory)}
     797    set filelist [glob -nocomplain \
     798            [file join [set expgui(FileMenuDir)] *] ]
     799    foreach file [lsort $filelist] {
     800        if {[file isdirectory $file]} {
     801            $files insert end [file tail $file]
     802            $dates insert end {(Directory)}
     803        }
     804    }
     805    set pairlist {}
     806    foreach file [lsort $filelist] {
     807        if {![file isdirectory $file]  && \
     808                [file extension $file] == ".EXP"} {
     809            set modified [file mtime $file]
     810            lappend pairlist "$file $modified"
     811        }
     812    }
     813    if {$expgui(filesort) == 0} {
     814        foreach pair [lsort -index 1 -integer $pairlist] {
     815            set file [lindex $pair 0]
     816            set modified [clock format [lindex $pair 1] -format "%T %D"]
     817            $files insert end [file tail $file]
     818            $dates insert end $modified
     819        }
     820    } else {
     821        foreach pair [lsort -index 0 $pairlist] {
     822            set file [lindex $pair 0]
     823            set modified [clock format [lindex $pair 1] -format "%T %D"]
     824            $files insert end [file tail $file]
     825            $dates insert end $modified
     826        }
     827    }
     828    $expgui(FileDirButtonMenu)  delete 0 end
     829    set list ""
     830    set dir ""
     831    foreach subdir [file split [set expgui(FileMenuDir)]] {
     832        set dir [file join $dir $subdir]
     833        lappend list $dir
     834    }
     835    foreach path $list {
     836        $expgui(FileDirButtonMenu) add command -label $path \
     837                -command "[list set expgui(FileMenuDir) $path]; \
     838                ChooseExpFil $frm"
     839    }
     840    # highlight the current experiment -- if present
     841    for {set i 0} {$i < [$files size]} {incr i} {
     842        set file [$files get $i]
     843        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
     844            $files selection set $i
     845        }
     846    }
     847    return
     848}
     849
Note: See TracChangeset for help on using the changeset viewer.