Changeset 20


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

# on 1999/01/06 04:15:12, toby did:
Many changes so that expgui incorporates tkgsas (gsas shell) capabilities

Allow expgui to create nearly empty .EXP files

Fix the various menus so that these blank files are treated properly

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/expgui

    • Property rcs:date changed from 1999/01/01 18:34:49 to 1999/01/06 04:15:12
    • Property rcs:lines changed from +136 -65 to +439 -266
    • Property rcs:rev changed from 1.4 to 1.5
    r16 r20  
    77# start out blank with a "load from option"?
    88#
    9 # access to GENLES & EXPEDT (merge in tkGSAS)
    10 #
    11 # look for external changes to the EXP file and warn/reload
    12 #     add a mtime to loadexp and chain a routine to check the mtime for a new value
    13 #     reset the mtime in SaveAsFile
    14 #
    159# idea:
    1610# a scroll list for all histogram refinement flags ; click on takes you to the
    1711# appropriate menu.
    1812#
    19 # to allow global access on phase page
     13# to allow "global" access on phase page
    2014#   change buttons from radio to multiple
    2115#   -- or display all 9 cell flag/damps and all atoms
    … …  
    3226
    3327if {$argv != ""} {
    34     set expfile [lindex $argv 0]
    35     if {[string toupper [file extension $expfile]] != ".EXP"} {
    36         append expfile ".EXP"
     28    set expgui(expfile) [lindex $argv 0]
     29    if {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
     30        append expgui(expfile) ".EXP"
    3731    }
    3832} else {
    3933    # windows needs this update or focus gets screwed up after tk_getOpenFile
    4034    update
    41     set expfile [tk_getOpenFile -defaultextension .EXP \
     35    set expgui(expfile) [tk_getOpenFile -defaultextension .EXP \
    4236        -filetypes {{"GSAS Experiment" ".EXP"}} -parent .]
    4337}
    44 if {$expfile == ""} exit
    45 if ![file exists $expfile] {
    46     tk_dialog .expFileErrorMsg "File Open Error" \
    47             "File $expfile does not exist" error 0 "Exit"
    48     exit
    49 }
     38if {$expgui(expfile) == ""} exit
    5039
    5140set expgui(debug) 0
    … …  
    6150# default is archive = on
    6251set expgui(archive) 1
    63 #----------------------------------------------------------------
    64 # where are we?
    65 set expgui(script) [info script]
    66 # translate links -- go six levels deep
    67 foreach i {1 2 3 4 5 6} {
    68     if {[file type $expgui(script)] == "link"} {
    69         set link [file readlink $expgui(script)]
    70         if { [file  pathtype  $link] == "absolute" } {
    71 h           set expgui(script) $link
    72         } {
    73             set expgui(script) [file dirname $expgui(script)]/$link
    74         }
    75     } else {
    76         break
    77     }
    78 }
    79 set expgui(scriptdir) [file dirname $expgui(script) ]
    80 #----------------------------------------------------------------
    81 # fetch EXP routines
    82 source [file join $expgui(scriptdir) readexp.tcl]
    83 
    84 # constants
     52# save the name of the wish executable
     53set wishshell [info nameofexecutable]
     54# misc constants
    8555set expgui(coordfont) "-*-courier-bold-r-normal--12-*"
    8656set expgui(histfont) "-*-courier-bold-r-normal--12-*"
     57set liveplot(hst) 1
     58set liveplot(legend) 1
    8759
    8860#=============================================================================
    … …  
    10577}
    10678# >>>>>>>>>>>>>>>> End of Profile Terms  >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
     79#----------------------------------------------------------------
     80# where are we?
     81set expgui(script) [info script]
     82# translate links -- go six levels deep
     83foreach i {1 2 3 4 5 6} {
     84    if {[file type $expgui(script)] == "link"} {
     85        set link [file readlink $expgui(script)]
     86        if { [file  pathtype  $link] == "absolute" } {
     87h           set expgui(script) $link
     88        } {
     89            set expgui(script) [file dirname $expgui(script)]/$link
     90        }
     91    } else {
     92        break
     93    }
     94}
     95set expgui(scriptdir) [file dirname $expgui(script) ]
     96set expgui(gsasdir) [file dirname $expgui(scriptdir)]
     97set expgui(gsasexe) [file join $ expgui(gsasdir) exe]
     98#----------------------------------------------------------------
     99# fetch EXP file processing routines
     100source [file join $expgui(scriptdir) readexp.tcl]
     101# commands for running GSAS programs
     102source [file join $expgui(scriptdir) gsascmds.tcl]
     103# contents of GSAS menus
     104source [file join $expgui(scriptdir) gsasmenu.tcl]
     105#---------------------------------------------------------------------------
     106# override options with locally defined values
     107if [file exists [file join $expgui(scriptdir) localconfig]] {
     108    source [file join $expgui(scriptdir) localconfig]
     109}
     110if [file exists [file join ~ .gsas_config]] {
     111    source [file join ~ .gsas_config]
     112}
     113#---------------------------------------------------------------------------
     114if ![file exists $expgui(expfile)] {
     115    set ans [tk_dialog .expFileErrorMsg "File Open Error" \
     116            "File $expgui(expfile) does not exist" error 0 "Exit" "Create"]
     117    if $ans {
     118        # create an "empty" exp file
     119        createexp $expgui(expfile) \
     120                [getstring "title for experiment $expgui(expfile)" 60 0]
     121    } else {
     122        exit
     123    }
     124}
     125
    107126#
    108127# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    … …  
    115134    catch {
    116135        unset exparray
    117         unset expmap
    118136    }
    119137    expload $expfile
    … …  
    121139    mapexp
    122140    set expgui(expModifiedLast) [file mtime $expfile]
    123     set expgui(last_History) [string trim [lindex [exphistory last] 1]]
     141    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
    124142    # set the window/icon title
    125143    wm title . $expfile
    … …  
    174192    set expgui(globalmode) 0
    175193    set expgui(printopt) "Print Options ([expinfo print])"
     194    set entryvar(title) [expinfo title]
    176195    global printopts
    177196    foreach num [array names printopts] {
    … …  
    181200    # enable traces on entryvar
    182201    set entrycmd(trace) 1
     202    # set fo extaction on LS page
     203    SetupExtractHist
    183204    # start checking for external changes
    184205    afterawhile
    … …  
    194215                {} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
    195216        switch $decision {
    196             0 { savearchiveexp $expfile }
    197             1 {                         }
    198             2 {                  return }
    199         }
    200     }
    201     loadexp $expfile
     217            0 { savearchiveexp }
     218            1 { }
     219            2 { return }
     220        }
     221    }
     222    loadexp $expgui(expfile)
     223}
     224
     225proc CreateNewExp {} {
     226    global expgui
     227    set newexpfile [newexp]
     228    if {$newexpfile == ""} return
     229    # create an "empty" exp file
     230    createexp $newexpfile \
     231                [getstring "title for experiment $newexpfile" 60 0]
     232    set expgui(expfile) $newexpfile
     233    loadexp $expgui(expfile)
    202234}
    203235
    204236proc SaveAsFile {} {
    205     global expfile expgui
     237    global expgui
    206238    set newexpfile [tk_getSaveFile -defaultextension .EXP \
    207239        -filetypes {{"GSAS Experiment" ".EXP"}} -parent . \
    208         -initialdir [file dirname $expfile] \
    209         -initialfile [file tail $expfile] ]
     240        -initialdir [file dirname $expgui(expfile)] \
     241        -initialfile [file tail $expgui(expfile)] ]
    210242    if {$newexpfile == ""} return
    211     set expfile $newexpfile
    212     expwrite $expfile
     243    set expgui(expfile) $newexpfile
     244    expwrite $expgui(expfile)
    213245    set expgui(changed) 0
    214     set expgui(expModifiedLast) [file mtime $expfile]
    215     set expgui(last_History) [string trim [lindex [exphistory last] 1]]
     246    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
     247    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
    216248    # set the window/icon title
    217     wm title . $expfile
     249    wm title . $expgui(expfile)
    218250    set expgui(titleunchanged) 1
    219     wm iconname . [file tail $expfile]
     251    wm iconname . [file tail $expgui(expfile)]
    220252}
    221253
    222254# called to read a different .EXP file
    223255proc readnewexp {} {
    224     global expgui expfile
     256    global expgui
    225257    if $expgui(changed) {
    226258        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
    … …  
    228260                {} 0 "Save and read" "Read without Save" "Cancel read command"]
    229261        switch $decision {
    230             0 { savearchiveexp $expfile }
    231             1 {                         }
    232             2 {                  return }
     262            0 { savearchiveexp }
     263            1 {                }
     264            2 { return }
    233265        }
    234266    }
    235267    set newexpfile [tk_getOpenFile -defaultextension .EXP \
    236268        -filetypes {{"GSAS Experiment" ".EXP"}} -parent . \
    237         -initialdir [file dirname $expfile] ]
     269        -initialdir [file dirname $expgui(expfile)] ]
    238270    if {$newexpfile == ""} return
    239     set expfile $newexpfile
    240     loadexp $expfile
     271    set expgui(expfile) $newexpfile
     272    loadexp $expgui(expfile)
    241273}
    242274
    … …  
    248280   
    249281    catch {
     282        if {$entrycmd($elem) == ""} return
    250283        incr expgui(changed)
    251284        if $expgui(debug) {puts "$entrycmd($elem)  set $entryvar($elem) "}
    252285        if {$entrycmd($elem) == ""} return
    253286        if [catch {
    254             eval $entrycmd($elem) set $entryvar($elem)
     287            eval $entrycmd($elem) set [list $entryvar($elem)]
    255288            if {[lindex $entrycmd($elem) 0] == "atominfo"} {
    256289                after idle {DisplayAllAtoms noreset}
    … …  
    274307# reset routine is used for debugging
    275308proc reset {} {
    276     global expgui script argv expfile
     309    global expgui script argv
    277310    set script $expgui(script)
    278     set argv $expfile
     311    set argv $expgui(expfile)
    279312    # remove traces
    280313    global entryvar
    … …  
    289322        eval trace vdelete entryvar $cmd
    290323    }
    291     foreach a {exparray expmap expgui entryvar entrycmd} {
     324    foreach a {
     325        exparray expmap expgui entryvar entrycmd 
     326        expgui_menulist expgui_cmdlist expgui_helplist
     327    } {
    292328        global $a
    293329        catch {unset  $a}
    … …  
    307343NIST Center for Neutron Research\n\n\
    3083441998, Not subject to copyright\n\n\
    309 Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])" \
     345Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
     346Generalized Structure Analysis System (GSAS)\n\
     347A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
     348" \
    310349        info 0 OK
    311350}
    … …  
    321360
    322361proc whenidle {} {
    323     global expgui expfile
     362    global expgui
    324363    if $expgui(titleunchanged) {
    325364        if {$expgui(changed) != 0} {
    326             wm title . "$expfile (modified)"
     365            wm title . "$expgui(expfile) (modified)"
    327366            set expgui(titleunchanged) 0
    328367        }
    329368    }
    330 #puts whenidle
    331     if {[file mtime $expfile] != $expgui(expModifiedLast)} {
     369    if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
    332370        if {$expgui(changed) == 0} {
    333371            set ans [tk_dialog .expFileErrorMsg "Reload?" \
    334                     "File $expfile has been modified by another program. \
     372                    "File $expgui(expfile) has been modified by another program. \
    335373Do you want to load the newer version or loose the modifications \
    336374by editing the current version?" \
    … …  
    338376        } else {
    339377            set ans [tk_dialog .expFileErrorMsg "Reload?" \
    340                     "File $expfile has been modified by another program \
     378                    "File $expgui(expfile) has been modified by another program \
    341379and you have made $expgui(changed) changes to this version. \
    342380Do you want to load the newer version or loose the modifications \
    … …  
    345383        }
    346384        if {$ans == 0} {
    347             loadexp $expfile
     385            loadexp $expgui(expfile)
    348386        } elseif {$ans == 1} {
    349387            # reset the time to the next version
    350             set expgui(expModifiedLast) [file mtime $expfile]
     388            set expgui(expModifiedLast) [file mtime $expgui(expfile)]
    351389        } elseif {$ans == 2} {
    352             savearchiveexp $expfile
     390            savearchiveexp
    353391        }
    354392    }
    … …  
    363401# save the .EXP file before exiting?
    364402proc confirmBeforeSave {} {
    365     global expgui expfile
     403    global expgui
    366404    if !$expgui(changed) {
    367405        return "Continue"
    … …  
    371409            {} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
    372410    switch $decision {
    373         0 { savearchiveexp $expfile;  return "Continue" }
    374         1 {                           return "Continue" }
    375         2 {                           return "Cancel"   }
    376     }
    377 }
    378 
    379 # save and optionally archive the expfile
    380 proc savearchiveexp {expfile} {
    381     global expgui tcl_platform expmap
    382     if !$expgui(changed) return
    383     if $expgui(archive) {
    384         catch {
    385             set expnam [file rootname $expfile]
    386             if {$tcl_platform(platform) == "windows"} {
    387                 if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
    388                     # archive w/o pkzip
    389                     set files [glob -nocomplain ${expnam}!*.exp]
    390                     if {$files == ""} {
    391                         set num -1
    392                     } else {
    393                         set file [lindex [lsort -decreasing $files] 0]
    394                         regexp {!([0-9]+)\.EXP} [string toupper $file] a num
     411        0 { savearchiveexp;  return "Continue" }
     412        1 {                  return "Continue" }
     413        2 {                  return "Cancel"   }
     414    }
     415}
     416
     417proc archiveexp {} {
     418    global expgui tcl_platform
     419    catch {
     420        set expnam [file rootname $expgui(expfile)]
     421        if {$tcl_platform(platform) == "windows"} {
     422            if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
     423                # archive w/o pkzip
     424                set files [glob -nocomplain ${expnam}!*.exp]
     425                if {$files == ""} {
     426                    set num -1
     427                } else {
     428                    set file [lindex [lsort -decreasing $files] 0]
     429                    regexp {!([0-9]+)\.EXP} [string toupper $file] a num
     430                }
     431                set file $expnam![format "%3.3d" [incr num]].EXP
     432                file copy $expnam.EXP $file
     433                set fp [open $expnam.lst a]
     434                puts $fp "\n--------------------------------------------------------------"
     435                puts $fp "Archiving $expnam.EXP as $file"
     436                puts $fp "--------------------------------------------------------------\n"
     437                close $fp
     438            } else {
     439                # archive with PKZIP           
     440                # need to limit expnam to 8 characters
     441                set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
     442                # PKZIP can't handle long dir names either
     443                cd [set dir [file dirname $expnam]]
     444                set num -1
     445                # get the versions from the listing
     446                if [file exists $sexp.zip] {
     447                    set fp [open "| [file join $expgui(scriptdir) pkzip.exe] -vb $sexp" r]
     448                    while {[gets $fp line] >= 0} {
     449                        regexp "$sexp\.0?0?(\[0-9\]+)" [string toupper $line] junk n
     450                        catch {if {$n > $num} {set num $n}}
    395451                    }
    396                     set file $expnam![format "%3.3d" [incr num]].EXP
    397                     file copy $expnam.EXP $file
    398                     set fp [open $expnam.lst a]
    399                     puts $fp "\n--------------------------------------------------------------"
    400                     puts $fp "Archiving $expnam.EXP as $file"
    401                     puts $fp "--------------------------------------------------------------\n"
    402                     close $fp
    403                 } else {
    404                     # archive with PKZIP               
    405                     # need to limit expnam to 8 characters
    406                     set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
    407                     # PKZIP can't handle long dir names either
    408                     cd [set dir [file dirname $expnam]]
    409                     set num -1
    410                     # get the versions from the listing
    411                     if [file exists $sexp.zip] {
    412                         set fp [open "| [file join $expgui(scriptdir) pkzip.exe] -vb $sexp" r]
    413                         while {[gets $fp line] >= 0} {
    414                             regexp "$sexp\.0?0?(\[0-9\]+)" [string toupper $line] junk n
    415                             catch {if {$n > $num} {set num $n}}
    416                         }
    417                         close $fp
    418                     }
    419                     incr num
    420                     set file $sexp.[format "%3.3d" $num]
    421                     file copy -force $expnam.EXP $file
    422                     exec [file join $expgui(scriptdir) pkzip.exe] -m $expnam $file > x.x &
    423                     set fp [open $expnam.lst a]
    424                     puts $fp "\n--------------------------------------------------------------"
    425                     puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
    426                     puts $fp "--------------------------------------------------------------\n"
    427452                    close $fp
    428453                }
     454                incr num
     455                set file $sexp.[format "%3.3d" $num]
     456                file copy -force $expnam.EXP $file
     457                exec [file join $expgui(scriptdir) pkzip.exe] -m $expnam $file > x.x &
     458                set fp [open $expnam.lst a]
     459                puts $fp "\n--------------------------------------------------------------"
     460                puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
     461                puts $fp "--------------------------------------------------------------\n"
     462                close $fp
     463            }
     464        } else {
     465            set files [glob -nocomplain $expnam.EXP.*]
     466            if {$files == ""} {
     467                set file $expnam.EXP.000
    429468            } else {
    430                 set files [glob -nocomplain $expnam.EXP.*]
    431                 if {$files == ""} {
    432                     set file $expnam.EXP.000
    433                 } else {
    434                     set file [lindex [lsort -decreasing $files] 0]
    435                     regexp {.*\.EXP.0?0?([0-9]*).*} $file junk number
    436                     incr number
    437                     set file $expnam.EXP.[format "%3.3d" $number]
    438                 }
    439                 exec cp $expfile $file
    440                 if [catch {exec gzip $file}] {
    441                     exec echo "\n----------------------------------------------" >> $expnam.LST
    442                     exec echo "     Archiving $expnam.EXP as $file " >> $expnam.LST
    443                     exec echo "----------------------------------------------\n" >> $expnam.LST
    444                 } else {
    445                     exec echo "\n----------------------------------------------" >> $expnam.LST
    446                     exec echo "     Archiving $expnam.EXP as $file.gz " >> $expnam.LST
    447                     exec echo "----------------------------------------------\n" >> $expnam.LST
    448                 }
     469                set file [lindex [lsort -decreasing $files] 0]
     470                regexp {.*\.EXP.0?0?([0-9]*).*} $file junk number
     471                incr number
     472                set file $expnam.EXP.[format "%3.3d" $number]
    449473            }
    450         } errmsg
    451         if {$errmsg != ""} {
    452             tk_dialog .warn Confirm "Error in archive: $errmsg" warning 0 OK
    453         }
    454     }
    455     # add a header
     474            exec cp $expgui(expfile) $file
     475            if [catch {exec gzip $file}] {
     476                exec echo "\n----------------------------------------------" >> $expnam.LST
     477                exec echo "     Archiving $expnam.EXP as $file " >> $expnam.LST
     478                exec echo "----------------------------------------------\n" >> $expnam.LST
     479            } else {
     480                exec echo "\n----------------------------------------------" >> $expnam.LST
     481                exec echo "     Archiving $expnam.EXP as $file.gz " >> $expnam.LST
     482                exec echo "----------------------------------------------\n" >> $expnam.LST
     483            }
     484        }
     485    } errmsg
     486    if {$errmsg != ""} {
     487        tk_dialog .warn Confirm "Error in archive: $errmsg" warning 0 OK
     488    }
     489}
     490
     491# save and optionally archive the expfile
     492proc savearchiveexp {} {
     493    global expgui expmap
     494    if !$expgui(changed) return
     495    if $expgui(archive) archiveexp
     496    # add a history record
    456497    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
    457498    # now save the file
    458     expwrite $expfile
     499    expwrite $expgui(expfile)
    459500    set expgui(changed) 0
    460     set expgui(expModifiedLast) [file mtime $expfile]
    461     set expgui(last_History) [string trim [lindex [exphistory last] 1]]
    462     wm title . $expfile
     501    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
     502    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
     503    wm title . $expgui(expfile)
    463504    set expgui(titleunchanged) 1
    464505}
    … …  
    472513                -command "SelectOnePhase $num"] -side left
    473514    }
    474     # set the default data to be the first phase and the first histogram
    475     set expgui(lasthist) [lindex $expmap(powderlist) 0]
    476515}
    477516
    … …  
    486525            $expgui(phaseFrame).top.ps.$n config -relief raised
    487526        }
    488     }   
     527    }
    489528    set crsPhase $num
    490     if {$crsPhase == ""} return
     529    # no phase is selected
     530    if {$crsPhase == ""} {
     531        # disable traces on entryvar
     532        set entrycmd(trace) 0
     533        set entrycmd(phasename) ""
     534        set entryvar(phasename) ""
     535        foreach ent {a b c alpha beta gamma cellref celldamp} {
     536            set entrycmd($ent) ""
     537            set entryvar($ent) ""
     538        }
     539        # enable traces on entryvar
     540        set entrycmd(trace) 1
     541        return
     542    }
     543
    491544    set expgui(curPhase) $crsPhase
    492545    # we have a phase
    … …  
    499552    ##########################################################
    500553    # phase title
    501     set entrycmd(phasename) {}
     554    set entrycmd(phasename) "phaseinfo $crsPhase name"
    502555    set entryvar(phasename) [phaseinfo $crsPhase name]
    503556    # cell parameters & flags
    … …  
    830883proc sethistlist {} {
    831884    global expgui expmap
    832     set expgui(curhist) 0
     885    set expgui(curhist) {}
    833886    foreach lbox $expgui(HistSelectList) {
    834887        $lbox.title delete 0 end
    … …  
    858911        }
    859912    }
     913    set histlist {}
    860914    if  {$expgui(hsorttype) == "type"} {
    861915        # sort on histogram type
    … …  
    892946        set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
    893947    }
     948    # select the first histogram in the list by default (if there are any)
     949    if {[llength $histlist] > 0} {set expgui(curhist) 0}
     950
    894951    # title field needs to match longest title
    895952    foreach lbox $expgui(HistSelectList) {
    … …  
    9631020        lappend histlist [lindex $expmap(powderlist) $item]
    9641021    }
     1022    # must have at least one histogram selected here
     1023    if {[llength $histlist] == 0} {
     1024        set expgui(backtermlbl) ""
     1025        set expgui(backtypelbl) ""
     1026        foreach var {bref bdamp} {
     1027            set entrycmd($var) ""
     1028            set entryvar($var) ""
     1029        }
     1030        $expgui(histFrame).top.txt config -text "No Selected Histograms"
     1031        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
     1032        set expgui(bkglbl) ""
     1033        eval destroy [grid slaves $expgui(diffBox)]
     1034        set entrycmd(trace) 1
     1035        return
     1036    }
     1037
    9651038    if {$expgui(globalmode) != 0} {
    9661039        set expgui(backtermlbl) ""
    … …  
    13171390    }
    13181391
     1392    # must have at least one histogram selected here
     1393    if {[llength $histlist] == 0} {
     1394        foreach var {scale sref sdamp} {
     1395            set entrycmd($var) ""
     1396            set entryvar($var) ""
     1397        }
     1398        set parm [grid info $expgui(scaleBox).but1]
     1399        if {$parm != ""} {
     1400            grid forget  $expgui(scaleBox).but1
     1401            eval grid $expgui(scaleBox).ent1 $parm
     1402        }
     1403        # destroy the contents of the frame
     1404        set phaseFractf1 $expgui(FracBox).f
     1405        eval destroy [grid slaves $phaseFractf1]
     1406        # reenable traces on entryvar
     1407        set entrycmd(trace) 1
     1408        return
     1409    }
     1410
    13191411    #--------------
    13201412    # Scale factor
    … …  
    14241516
    14251517    if {$expgui(globalmode) == 0} {
     1518        # must have at least one histogram selected here
     1519        if {[llength $expgui(curhist)] == 0} return
    14261520        set hist [lindex $expmap(powderlist) $expgui(curhist)]
    14271521        # Create one frame for each Phase.
    … …  
    14871581            lappend histlist [lindex $expmap(powderlist) $item]
    14881582        }
     1583        # must have at least one histogram selected here
     1584        if {[llength $histlist] == 0} return
    14891585        # loop through histograms & phases, set up an array by type
    14901586        catch {unset ptypearray histarray phasearray}
    … …  
    16231719    set expgui(printopt) "Print Options ([expinfo print])"
    16241720}
     1721
     1722# need to respond to mouse presses -- control variable associated with extract Fobs
     1723# and set the LeBail extraction flags
     1724proc SetupExtractHist {} {
     1725    global expgui entrycmd entryvar expmap
     1726
     1727    # display the selected histograms
     1728    $expgui(lsFrame).hs.lbox selection clear 0 end
     1729    foreach h $expgui(curhist) {
     1730        $expgui(lsFrame).hs.lbox selection set $h
     1731    }
     1732    # disable traces on entryvar for right now
     1733    set entrycmd(trace) 0
     1734
     1735    # get histogram list
     1736    set histlist {}
     1737    foreach item $expgui(curhist) {
     1738        lappend histlist [lindex $expmap(powderlist) $item]
     1739    }
     1740    set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
     1741    if {[llength $histlist] == 0} {
     1742        foreach phase {1 2 3 4 5 6 7 8 9} {
     1743            $expgui(lsFrame).f1.a.l$phase config -fg grey
     1744            set expgui(Fextract$phase) {}
     1745            #foreach item "a.ca$phase a.cb$phase a.cc$phase"
     1746            foreach item "a.ca$phase a.cc$phase" {
     1747                $expgui(lsFrame).f1.$item config -state disabled -bd 1
     1748            }
     1749        }
     1750    } elseif {[llength $histlist] == 1} {
     1751        set entryvar(fobsextract) [histinfo $histlist foextract]
     1752        foreach phase {1 2 3 4 5 6 7 8 9} {
     1753            # is the phase present?
     1754            if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
     1755                $expgui(lsFrame).f1.a.l$phase config -fg grey
     1756                set expgui(Fextract$phase) {}
     1757#               foreach item "a.ca$phase a.cb$phase a.cc$phase"
     1758                foreach item "a.ca$phase a.cc$phase" {
     1759                    $expgui(lsFrame).f1.$item config -state disabled -bd 1
     1760                }
     1761            } else {
     1762                $expgui(lsFrame).f1.a.l$phase config -fg black
     1763#               foreach item "a.ca$phase a.cb$phase a.cc$phase"
     1764                foreach item "a.ca$phase a.cc$phase" {
     1765                    $expgui(lsFrame).f1.$item config -state normal -bd 2
     1766                }
     1767                set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
     1768            }
     1769        }
     1770    } elseif {[llength $histlist] > 1} {
     1771        # multiple histograms need phases in any histogram
     1772        foreach phase {1 2 3 4 5 6 7 8 9} {
     1773            set gotphase($phase) 0
     1774        }           
     1775        foreach hist $histlist {
     1776            foreach phase $expmap(phaselist_$hist) {
     1777                set gotphase($phase) 1
     1778            }
     1779        }
     1780        foreach phase {1 2 3 4 5 6 7 8 9} {
     1781            set expgui(Fextract$phase) {}
     1782            if $gotphase($phase) {
     1783                $expgui(lsFrame).f1.a.l$phase config -fg black
     1784                foreach item "a.ca$phase a.cb$phase a.cc$phase" {
     1785                    $expgui(lsFrame).f1.$item config -state normal -bd 2
     1786                }
     1787            } else {
     1788                $expgui(lsFrame).f1.a.l$phase config -fg grey
     1789                foreach item "a.ca$phase a.cb$phase a.cc$phase" {
     1790                    $expgui(lsFrame).f1.$item config -state disabled -bd 1
     1791                }
     1792            }
     1793        }
     1794    }
     1795    # reenable traces
     1796    set entrycmd(trace) 1
     1797}
     1798# respond to a change in the fobs extraction method for a phase
     1799# force the main extraction flag on, if fobs extraction is selected for any phase
     1800proc HistExtractSet {phase} {
     1801    global expgui entryvar expmap
     1802    foreach item $expgui(curhist) {
     1803        lappend histlist [lindex $expmap(powderlist) $item]
     1804    }
     1805    hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
     1806    if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
     1807}
    16251808#---------------------------- Global Edit Functions ------------------------
    16261809proc editbackground {} {
    16271810    global expgui expmap entrycmd
     1811    set histlist {}
     1812    foreach n $expgui(curhist) {
     1813        lappend histlist [lindex $expmap(powderlist) $n]
     1814    }
     1815    if {[llength $histlist] == 0} return
     1816
    16281817    set w .back
    16291818    catch {destroy $w}
    16301819    toplevel $w -bg beige
    1631     set histlist {}
    1632     foreach n $expgui(curhist) {
    1633         lappend histlist [lindex $expmap(powderlist) $n]
    1634     }
    16351820    if {$expgui(globalmode) != 0} {
    16361821        wm title $w "Edit Background"
    … …  
    20402225pack $expgui(fm) -fill x -side top -anchor n
    20412226
     2227# create a button bar
     2228pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
     2229
    20422230# Creating the notebook with 5 panes: Phase, Histogram, Scaling, Profile
    20432231# & LS controls
    … …  
    20512239    .n pageconfigure phasePane -raisecmd \
    20522240                "set expgui(pagenow) phaseFrame; DisplayAllAtoms noreset"
     2241#    lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
    20532242    .n add histPane -label "Histogram" -underline 0
    20542243    .n pageconfigure histPane -raisecmd \
    … …  
    20722261    set expgui(lsFrame) [.n subwidget lsPane]
    20732262} else {
    2074     pack [frame .bar] -side top -anchor w
     2263    pack [frame .frmbar] -side top -anchor w
    20752264    pack [frame .n] -anchor w -fill both -expand yes
    20762265    foreach item {lsFrame phaseFrame histFrame fracFrame profFrame} \
    2077             page {Phase Histogram Scaling Profile "LS Controls"} {
    2078         pack [button .bar.$item -text $page -bd 2 \
     2266            page {"LS Controls" Phase Histogram Scaling Profile } {
     2267        pack [button .frmbar.$item -text $page -bd 2 \
    20792268                    -command "RaisePage $item"] -side left
    20802269        set expgui($item) [frame .n.$item -relief flat]
    20812270    }
    20822271    lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
     2272    lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
    20832273    lappend expgui(frameactionlist) "histFrame DisplayHistogram"
    20842274    lappend expgui(frameactionlist) "fracFrame DisplayFrac"
    20852275    lappend expgui(frameactionlist) "profFrame DisplayProfile"
    2086     lappend expgui(GlobalModeAllDisable) "histFrame {.bar.histFrame config}"
    2087     lappend expgui(GlobalModeAllDisable) "profFrame {.bar.profFrame config}"
     2276    lappend expgui(GlobalModeAllDisable) "histFrame {.frmbar.histFrame config}"
     2277    lappend expgui(GlobalModeAllDisable) "profFrame {.frmbar.profFrame config}"
    20882278}
    20892279
    … …  
    20942284    foreach item {phaseFrame histFrame fracFrame profFrame lsFrame} {
    20952285        if {$item == $nextpage} {
    2096             .bar.$item config -relief flat
     2286            .frmbar.$item config -relief flat
    20972287        } else {
    2098             .bar.$item config -relief raised
     2288            .frmbar.$item config -relief raised
    20992289        }
    21002290    }
    … …  
    21182308set frame3 [frame $expgui(phaseFrame).frame3 -width 100 -relief raised -borderwidth 4 -bg beige]
    21192309
    2120 grid $expgui(phaseFrame).top -sticky nws -row 0 -column 0
     2310grid $expgui(phaseFrame).top -sticky news -row 0 -column 0
    21212311grid $frameLatt -sticky news -row 2 -column 0
    21222312grid $fbig -sticky news -row 3 -column 0
    … …  
    21272317grid columnconfigure $expgui(phaseFrame) 0 -weight 1
    21282318grid rowconfigure $expgui(phaseFrame) 3 -weight 1
    2129 grid [frame  $expgui(phaseFrame).top.ps] -column 0 -row 0
     2319grid [frame  $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
    21302320# this is where the buttons will go
    21312321pack [label $expgui(phaseFrame).top.ps.0 -text "Phases: "] -side left
    21322322
    2133 
    2134 grid [label $expgui(phaseFrame).top.lA -textvariable entryvar(phasename) \
    2135         -fg blue -anchor center] -column 1 -row 0
     2323grid [label $expgui(phaseFrame).top.lA -text "  Phase name:" \
     2324        -fg blue ] -column 1 -row 0 -sticky e
     2325grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
     2326        -fg blue -width 45] -column 2 -row 0 -sticky e
    21362327grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
    21372328# ------------- Lattice Parameter Box ------------------
    … …  
    25322723    }
    25332724}
    2534 # need to respond to mouse presses -- control variable associated with extract Fobs
    2535 # and set the LeBail extraction flags
    2536 proc SetupExtractHist {} {
    2537     global expgui entrycmd entryvar expmap
    2538 
    2539     # display the selected histograms
    2540     $expgui(lsFrame).hs.lbox selection clear 0 end
    2541     foreach h $expgui(curhist) {
    2542         $expgui(lsFrame).hs.lbox selection set $h
    2543     }
    2544     # disable traces on entryvar for right now
    2545     set entrycmd(trace) 0
    2546 
    2547     # get histogram list
    2548     set histlist {}
    2549     foreach item $expgui(curhist) {
    2550         lappend histlist [lindex $expmap(powderlist) $item]
    2551     }
    2552     set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
    2553     if {[llength $histlist] == 1} {
    2554         set entryvar(fobsextract) [histinfo $histlist foextract]
    2555         foreach phase {1 2 3 4 5 6 7 8 9} {
    2556             # is the phase present?
    2557             if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
    2558                 $expgui(lsFrame).f1.a.l$phase config -fg grey
    2559                 set expgui(Fextract$phase) {}
    2560 #               foreach item "a.ca$phase a.cb$phase a.cc$phase"
    2561                 foreach item "a.ca$phase a.cc$phase" {
    2562                     $expgui(lsFrame).f1.$item config -state disabled -bd 1
    2563                 }
    2564             } else {
    2565                 $expgui(lsFrame).f1.a.l$phase config -fg black
    2566 #               foreach item "a.ca$phase a.cb$phase a.cc$phase"
    2567                 foreach item "a.ca$phase a.cc$phase" {
    2568                     $expgui(lsFrame).f1.$item config -state normal -bd 2
    2569                 }
    2570                 set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
    2571             }
    2572         }
    2573     } else {
    2574         # multiple histograms need phases in any histogram
    2575         foreach phase {1 2 3 4 5 6 7 8 9} {
    2576             set gotphase($phase) 0
    2577         }           
    2578         foreach hist $histlist {
    2579             foreach phase $expmap(phaselist_$hist) {
    2580                 set gotphase($phase) 1
    2581             }
    2582         }
    2583         foreach phase {1 2 3 4 5 6 7 8 9} {
    2584             set expgui(Fextract$phase) {}
    2585             if $gotphase($phase) {
    2586                 $expgui(lsFrame).f1.a.l$phase config -fg black
    2587                 foreach item "a.ca$phase a.cb$phase a.cc$phase" {
    2588                     $expgui(lsFrame).f1.$item config -state normal -bd 2
    2589                 }
    2590             } else {
    2591                 $expgui(lsFrame).f1.a.l$phase config -fg grey
    2592                 foreach item "a.ca$phase a.cb$phase a.cc$phase" {
    2593                     $expgui(lsFrame).f1.$item config -state disabled -bd 1
    2594                 }
    2595             }
    2596         }
    2597     }
    2598     # reenable traces
    2599     set entrycmd(trace) 1
    2600 }
    2601 # respond to a change in the fobs extraction method for a phase
    2602 # force the main extraction flag on, if fobs extraction is selected for any phase
    2603 proc HistExtractSet {phase} {
    2604     global expgui entryvar expmap
    2605     foreach item $expgui(curhist) {
    2606         lappend histlist [lindex $expmap(powderlist) $item]
    2607     }
    2608     hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
    2609     if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
    2610 }
    26112725
    26122726pack [frame $expgui(lsFrame).f1] -fill both -expand true
    26132727grid rowconfigure $expgui(lsFrame).f1  4 -weight 1
    2614 grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row 0 -column 0
     2728set row 0
     2729grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
    26152730grid [label $expgui(lsFrame).f1.his2 -relief sunken -bd 2 -pady 6 \
    26162731        -textvariable expgui(last_History)] \
    2617         -row 0 -column 1 -columnspan 5 -sticky w
     2732        -row $row -column 1 -columnspan 5 -sticky w
     2733incr row
     2734grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
     2735grid [entry $expgui(lsFrame).f1.tit2 \
     2736        -textvariable entryvar(title) -width 48] \
     2737        -row $row -column 1 -columnspan 5 -sticky w
     2738set entrycmd(title) "expinfo title"
     2739
     2740incr row
    26182741grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
    2619         -row 1 -column 0 -columnspan 2 -pady 3
     2742        -row $row -column 0 -columnspan 2 -pady 3
    26202743grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
    26212744grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
    … …  
    26232746grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
    26242747        -menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
    2625         ] -row 1 -column 2
     2748        ] -row $row -column 2
    26262749menu $expgui(lsFrame).f1.lprint.menu
    26272750foreach num [lsort [array names printopts]] {
    … …  
    26302753        -variable entryvar(printopt$num)
    26312754}
    2632 grid [frame $expgui(lsFrame).f1.c -bd 4 -relief groove] -row 1 -column 3
     2755grid [frame $expgui(lsFrame).f1.c -bd 4 -relief groove] -row $row -column 3
    26332756grid [label $expgui(lsFrame).f1.c.fol -text "Extract Fobs"] -row 0 -column 2
    26342757grid [checkbutton $expgui(lsFrame).f1.c.foc -variable entryvar(fobsextract)] -row 0 -column 3
    2635 
    2636 grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove] -row 3 -column 0 -columnspan 6
     2758incr row
     2759grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove] -row $row -column 0 -columnspan 6
    26372760foreach num {1 2 3 4 5 6 7 8 9} {
    26382761    grid [label $expgui(lsFrame).f1.a.l$num -text $num] -row 1 -column $num
    … …  
    26592782#grid [label $expgui(lsFrame).f1.a.t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
    26602783# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
     2784#-------------------------------------------------------------------------
     2785#-------------------------------------------------------------------------
    26612786#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
    26622787
    … …  
    26682793            -command "reset"
    26692794}
     2795$expgui(fm).file.menu add command -label "expnam" -underline 0 \
     2796        -command readnewexp
    26702797$expgui(fm).file.menu add command -label "Save" -underline 0 \
    2671         -command {savearchiveexp $expfile}
     2798        -command savearchiveexp
    26722799$expgui(fm).file.menu add command -label "Save As" -underline 1 \
    26732800        -command "SaveAsFile"
    26742801$expgui(fm).file.menu add command -label "Reread .EXP file"  -underline 0 \
    2675         -command {rereadexp $expfile}
    2676 $expgui(fm).file.menu add command -label "Other .EXP file"  -underline 0 \
    2677         -command {readnewexp}
     2802        -command {rereadexp $expgui(expfile)}
    26782803#$expgui(fm).file.menu add command -label "Close" -underline 0
    2679 $expgui(fm).file.menu add command -label "Exit"  -underline 1 -command catchQuit
    26802804
    26812805#---- help menu button
    26822806menubutton $expgui(fm).help -text Help -underline 0 -menu $expgui(fm).help.menu
    26832807menu $expgui(fm).help.menu
    2684 $expgui(fm).help.menu add command -label "About..." -underline 0 -command { About }
    2685 #$expgui(fm).help.menu add command -label "GSAStk" -underline 0 -command { GSAStkHelp }
     2808$expgui(fm).help.menu add command -command showhelp -label "Help on Command"
     2809$expgui(fm).help.menu add command -label "About..." -underline 0 -command About
    26862810
    26872811#---- options menu button
    … …  
    27522876
    27532877pack $expgui(fm).file $expgui(fm).option -side left  -in $expgui(fm)
     2878
     2879foreach menu $expgui(menunames) {
     2880    set m [string tolower $menu]
     2881    pack [menubutton $expgui(fm).$m -text $menu -underline 0 \
     2882            -menu $expgui(fm).$m.menu] -side left
     2883    menu $expgui(fm).$m.menu
     2884}
    27542885pack $expgui(fm).help  -side right -in $expgui(fm)
    27552886
     2887# add the commands in expgui_menulist
     2888foreach menu [array names expgui_menulist ] {
     2889    foreach cmd $expgui_menulist($menu) {
     2890        set action {}
     2891        catch {set action [lindex $expgui_cmdlist($cmd) 0]}
     2892        if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
     2893        if {$action != "" && $action != "-"} {
     2894            eval $expgui(fm).$menu.menu add command \
     2895                    -label $cmd -command [list [subst $action]]
     2896        }
     2897    }
     2898}
     2899# setup command help
     2900foreach cmd [array names expgui_cmdlist] {
     2901    set help {}
     2902    catch {set help [lindex $expgui_cmdlist($cmd) 1]}
     2903    if {$help == ""} {
     2904        if {$expgui(debug)} {puts "no help for $cmd"}
     2905    } else {
     2906        # remove
     2907        regsub -all \x09 $help " " help
     2908        # preserve blank lines
     2909        regsub -all \x0A\x0A $help "AAA1234567890AAA" help
     2910        regsub -all \x0A $help " " help
     2911        regsub -all "AAA1234567890AAA" $help \x0A\x0A help
     2912        regsub -all " +" $help " " help
     2913        set expgui_helplist($cmd) [string trim $help]
     2914    }
     2915}
     2916# set up button bar
     2917foreach cmd $expgui(buttonlist) {
     2918    set action {}
     2919    catch {set action [lindex $expgui_cmdlist($cmd) 0]}
     2920    if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
     2921    if {$action != ""} {
     2922        pack [eval button .bar.$cmd -bg beige \
     2923                -text $cmd -command [list [subst $action]]] -side left
     2924    }
     2925}
     2926
     2927$expgui(fm).file.menu add command -label "Exit"  -underline 1 -command catchQuit
    27562928#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
     2929
    27572930
    27582931# handle indirect exits
    … …  
    27602933bind . <Control-c> catchQuit
    27612934
    2762 loadexp $expfile
     2935loadexp $expgui(expfile)
Note: See TracChangeset for help on using the changeset viewer.