Changeset 1166 for trunk/gsascmds.tcl


Ignore:
Timestamp:
Aug 17, 2011 6:17:04 PM (9 years ago)
Author:
toby
Message:

bring sandbox changes over to main release

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gsascmds.tcl

    r1034 r1166  
    464464    afterputontop
    465465    return $makenew(result)
     466}
     467
     468# format numbers & errors in crystallographic notation
     469proc formatSU {num err} {
     470    # errors less or equal to t are expressed as 2 digits
     471    set T 19
     472    set lnT [expr { log10($T) }] 
     473    # error is zero
     474    if {$err == 0} {
     475        # is this an integer?
     476        if {int($num) == $num} {
     477            return [format %d [expr int($num)]]
     478        }
     479        # allow six sig figs with a zero error (except for 0.0)
     480        set dec [expr int(5.999999-log10( abs($num) ))]
     481        if {$dec < -2 || $dec > 9} {
     482            return [format %.5E $num]
     483        } elseif {$dec <= 0} {
     484            return [format %d [expr int($num)]]
     485        } else {
     486            return [format %.${dec}f $num]
     487        }
     488    } else {
     489        #set sigfigs [expr log10( abs(10) / abs(.012/$T) ) + 1]
     490        # should the number be expressed in scientific notation?
     491        if {$err > $T || abs($num) < 0.0001} {
     492            # get the exponent
     493            set exp [lindex [split [format %E $num] E] end]
     494            # strip leading zeros
     495            regsub {([-\+])0+} $exp {\1} exp
     496            # number of decimals in exponetial notation
     497            set dec [expr int($lnT - log10( abs($err) ) + $exp)]
     498            # should the error be displayed?
     499            if {$err < 0} {
     500                return [format "%.${dec}E" $num]
     501            } else {
     502                # scale the error into a decimal number
     503                set serr [expr int(0.5 + $err * pow(10,$dec-$exp))]
     504                return [format "%.${dec}E(%d)" $num $serr]
     505            }
     506        } else {
     507            # number of digits
     508            set dec [expr int($lnT - log10( abs($err) ))]
     509            # should the error be displayed?
     510            if {$err < 0} {
     511                return [format "%.${dec}f" $num]
     512            } else {
     513                set serr [expr int(0.5 + $err * pow(10,$dec))]
     514                return [format "%.${dec}f(%d)" $num $serr]
     515            }
     516        }
     517    }
    466518}
    467519
     
    9741026            }
    9751027        }
    976         # so sorry, have to use Internet Explorer
     1028        # so sorry, have to use Safari, even if not default
    9771029        set url [file nativename $url]; # replace ~/ if present
    9781030        if {[file pathtype $url] == "relative"} {
    9791031            set url [file join [pwd] $url]
    9801032        }
    981         exec osascript -e "tell application \"Internet Explorer\"\rGetURL \"file://$url\"\rend tell"
     1033        exec osascript -e "tell application \"Safari\" to open location \"file://$url\""
    9821034    } elseif {$tcl_platform(platform) == "unix"} {
    9831035        set browserlist {}
     
    19592011proc SetEXPfile {expfile "newOK 0"} {
    19602012    global expgui tcl_platform
    1961     set expgui(expfile) {}
    19622013    if {[string trim $expfile] == ""} return
    19632014
     
    20152066    # force exp files to be upper case, set to force save if name changes
    20162067    set origexp $expname
    2017     if {$expname != [string toupper $expfile]} {
    2018         set expname [string toupper [file tail $expfile]]
    2019         if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1}
    2020     }
    2021     if {[file extension $expname] != ".EXP"} {
     2068    if {$expname != [file tail $expfile] && $tcl_platform(platform) != "windows"} {
     2069        set expgui(changed) 1
     2070    }
     2071    #puts $expgui(expfile)
     2072    if {[string match {.O[0-9A-F][0-9A-F]} [file extension $expname]]} {
     2073        set expname [ArchiveChoice $expname]
     2074        set dirname ""
     2075        if {$expname == ""} return
     2076    } elseif {[file extension $expname] != ".EXP"} {
    20222077        append expname ".EXP"
    20232078    }
    2024     if {$dirname == "."} {
     2079    if {$dirname == "." || $dirname == ""} {
    20252080        set newexpfile $expname
    20262081    } else {
     
    20812136        if {[string tolower $ans] == "create"} {
    20822137            # you've been warned this .EXP does not exist!
    2083             # create an "empty" exp file
    2084             createexp $newexpfile \
    2085                 [getstring "title for experiment $expname" 60 0]
    2086             if {! [file exists [file join $dirname $expname]]} {
    2087                 update
    2088                 MyMessageBox -parent . -title "File Creation Error" \
    2089                     -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
    2090                     -icon warning -type Continue -default continue
    2091                 set expgui(resize) 1
    2092                 return
    2093             }
     2138            if [CreateMTexpfile $newexpfile] return
    20942139        } else {
    20952140            return
    20962141        }
    20972142    }
    2098     set expgui(expfile) $newexpfile
    2099     catch {cd [string trim [file dirname $expgui(expfile)]]}
     2143    catch {cd [string trim [file dirname $newexpfile]]}
     2144    return $newexpfile
     2145}
     2146
     2147proc ArchiveChoice {expfile} {
     2148    set expnam [file rootname $expfile]
     2149    set ans [MyMessageBox -parent . -title "Load Archived File" \
     2150        -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
     2151        -icon question -type "{Use New Name} {Continue with current}" \
     2152        -default {Use New Name} \
     2153        -helplink "expguierr.html LoadArchived"
     2154    ]
     2155    # archive the current .EXP file
     2156    if {$ans != "use new name" && [file exists $expfile]} {
     2157        # get the last archived version
     2158        set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
     2159        if {$lastf == ""} {
     2160            set num 01
     2161        } else {
     2162            regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
     2163            scan $num %x num
     2164            if {$num >= 255} {
     2165                set num FF
     2166            } else {
     2167                set num [string toupper [format %.2x [incr num]]]
     2168            }
     2169        }
     2170        catch {
     2171            set newfile $expnam.O$num
     2172            file rename -force $expnam.EXP $newfile
     2173            set fp [open $expnam.LST a+]
     2174            puts $fp "\n----------------------------------------------"
     2175            puts $fp "     Regressing to archive file [file tail $expfile]"
     2176            puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
     2177            puts $fp "----------------------------------------------\n"
     2178            close $fp
     2179        }
     2180        file copy -force $expfile $expnam.EXP
     2181        set expfile $expnam.EXP
     2182    }
     2183    if {$ans == "use new name"} {
     2184        set newexpfile [getExpFileName new]
     2185        if {$newexpfile == ""} {
     2186            set expgui(FileMenuEXPNAM) ""
     2187            return
     2188        }
     2189        file copy -force $expfile $newexpfile
     2190        set expgui(needpowpref) 2
     2191        set expgui(needpowpref_why) "\tA new .EXP file was created\n"
     2192        return $newexpfile
     2193    } else {
     2194        return $expfile
     2195    }
     2196}
     2197
     2198# create an "empty" exp file
     2199proc CreateMTexpfile {newexpfile} {
     2200    set expname [file tail $newexpfile]
     2201    createexp $newexpfile \
     2202        [getstring "title for experiment $expname" 60 0]
     2203    if {! [file exists $newexpfile]} {
     2204        update
     2205        MyMessageBox -parent . -title "File Creation Error" \
     2206            -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
     2207            -icon warning -type Continue -default continue
     2208        set ::expgui(resize) 1
     2209        return 1
     2210    }
     2211    return 0
    21002212}
    21012213
     
    21292241                -side top -fill both -expand yes -pady 5
    21302242    } elseif {$mode != "new"} {
    2131         # for initial read, don't access archived files
     2243        # for initial read, don't offer access to archived files
    21322244        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
    21332245                -class SmallFont] \
     
    21582270    afterputontop
    21592271    if {$expgui(FileMenuEXPNAM) == ""} return
    2160     # is there a space in the EXP name?
    2161 #    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
    2162 #       update
    2163 #       MyMessageBox -parent . -title "File Name Error" \
    2164 #           -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \
    2165 #           -icon warning -type Continue -default continue
    2166 #               -helplink "expguierr.html OpenErr"
    2167 #       return
    2168 #    }
    2169 #    if {[string first " " $expgui(FileMenuDir)] != -1} {
    2170 #       set warn 1
    2171 #       catch {set warn $expgui(warnonexpdirspace)}
    2172 #       if $warn {
    2173 #           update
    2174 #           MyMessageBox -parent . -title "Good luck..." \
    2175 #               -message "You are using a directory with a space in the name ($expgui(FileMenuDir)) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \
    2176 #               -icon warning -type Continue -default continue
    2177 #           #           -helplink "expguierr.html OpenErr"
    2178 #           set expgui(warnonexpdirspace) 0
    2179 #       }
    2180 #    }
     2272    #puts "end getexp $expgui(expfile)"
    21812273    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
    21822274}
    21832275
    21842276# validation routine
     2277# called from getExpFileName, either from Read button or from SelectExpFil (see expfilebox)
    21852278proc valid_exp_file {frm mode} {
    21862279    global expgui tcl_platform
     
    22082301        return
    22092302    }
    2210     # append a .EXP if not present
    2211     if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
     2303    set ext [string toupper [file extension $expgui(FileMenuEXPNAM)]]
     2304    if {$ext == ""} {
     2305        # append a .EXP if not present
    22122306        append expgui(FileMenuEXPNAM) ".EXP"
    2213     }
    2214     # is there a space in the name?
    2215 #    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
    2216 #       MyMessageBox -parent . -title "File Name Error" \
    2217 #               -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
    2218 #               -icon warning -type Continue -default continue
    2219 #               -helplink "expguierr.html OpenErr"
    2220 #       return
    2221 #    }
    2222     # check for archive files
    2223     if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
     2307    } elseif {[string match {*.O[0-9A-F][0-9A-F]} $ext] && \
    22242308            $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
     2309        # check for archive files
    22252310        destroy .file
    22262311        return
    2227     } elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
     2312    } elseif {$ext != ".EXP"} {
    22282313        # check for files that end in something other than .EXP .exp or .Exp...
    22292314        MyMessageBox -parent . -title "File Open Error" \
     
    22582343                -helplink "expguierr.html OpenErr"
    22592344        ]
    2260         if {[string tolower $ans] == "create"} {destroy .file}
     2345        if {[string tolower $ans] == "create"} {
     2346            if [CreateMTexpfile $file] return
     2347            destroy .file
     2348        }
    22612349        return
    22622350    }
     
    24172505            - [winfo height $box.top] - [winfo height $box.scroll]-25]
    24182506}
    2419 
     2507proc RevertExpFile {} {
     2508    global expgui tcl_platform
     2509    set frm .file
     2510    catch {destroy $frm}
     2511    toplevel $frm
     2512    wm title $frm "Experiment file"
     2513    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
     2514    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
     2515    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
     2516            -fill y -expand yes
     2517    pack [button $frmC.help -text Help -bg yellow \
     2518            -command "MakeWWWHelp expguierr.html open"] \
     2519            -side top -anchor e
     2520    set expgui(filesort) 0
     2521    set expgui(includearchived) 1
     2522    set expgui(FileInfoBox) $frmC.info
     2523    pack [label $frmC.ar -text "(Showing Archived Files Only)"] -side top -pady 10
     2524    pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
     2525              -class SmallFont] \
     2526        -side top -fill both -expand yes -pady 5
     2527
     2528    pack [button $frmC.b -text Read \
     2529            -command "valid_exp_file $frmA old"] -side bottom
     2530    pack [button $frmC.q -text Cancel \
     2531            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
     2532    bind $frm <Return> "$frmC.b invoke"
     2533
     2534    pack [label $frmA.0 -text "Select an archived experiment file to read"] \
     2535                -side top -anchor center
     2536    set bx $frmA
     2537    pack [frame $bx.top] -side top
     2538    #pack [label $bx.top.a -text "Directory" ] -side left
     2539    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
     2540    #pack $bx.top.d -side left
     2541    #set expgui(FileMenuDir) [pwd]
     2542    # the icon below is from tk8.0/tkfbox.tcl
     2543    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
     2544    listbox $bx.a.files -relief raised -bd 2 \
     2545            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
     2546            -height 15 -width 0 -exportselection 0
     2547    listbox $bx.a.dates -relief raised -bd 2 \
     2548            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
     2549            -height 15 -width 0 -takefocus 0 -exportselection 0
     2550    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
     2551    ChooseExpFil $bx 1
     2552    if {[llength [$bx.a.files get 0 end]] == 0} {
     2553        destroy $frm
     2554        MyMessageBox -parent . -title "No Archives" \
     2555            -message "Sorry no archived versions of $::expgui(expfile) are present" \
     2556                    -icon warning -type ok -default ok
     2557        return
     2558    }
     2559    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
     2560    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
     2561    bind $bx.a.files <Double-1> "SelectExpFil $bx old"
     2562    bind $bx.a.dates <Double-1> "SelectExpFil $bx old"
     2563    pack $bx.a.scroll -side left -fill y
     2564    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
     2565    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
     2566    # force the window to stay on top
     2567    putontop $frm
     2568    focus $frmC.b
     2569    tkwait window $frm
     2570    afterputontop
     2571    if {$expgui(FileMenuEXPNAM) == ""} return
     2572    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
     2573}
    24202574
    24212575# support routine for SetHistUseFlags
     
    25422696    return
    25432697}
     2698
     2699proc ScanEXPforError {"ns {}"} {
     2700    # record types to ignore
     2701    set ignorelist {DESCR HSTRY PNAM HNAM "REFN STATS"}
     2702    set warn {}
     2703    set badkeylist {}
     2704    # scan file for warnings
     2705    foreach key [array names ${ns}::exparray] {
     2706        if {[string first "***" [set ${ns}::exparray($key)]] != -1 ||
     2707            [string first "#IN" [set ${ns}::exparray($key)]] != -1 ||
     2708            [string first "nan" [set ${ns}::exparray($key)]] != -1 ||
     2709            [string first "NAN" [set ${ns}::exparray($key)]] != -1
     2710        } {
     2711            #puts [set ${ns}::exparray($key)]
     2712            set OK 0
     2713            foreach i $ignorelist {
     2714                if {[string first $i $key] != -1} {
     2715                    set OK 1
     2716                    break
     2717                }
     2718            }
     2719            # ignore atom name section of Atom records
     2720            if {(! $OK) && [string match  "CRS*AT*A" $key]} {
     2721                foreach str [list [string range [set ${ns}::exparray($key)] 0 49]
     2722                             [string range [set ${ns}::exparray($key)] 58 end]] {
     2723                    if {[string first "***" $str] ||
     2724                        [string first "#INF" $str] ||
     2725                        [string first "nan" $str] ||
     2726                        [string first "NAN" $str]} {
     2727                        append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
     2728                        lappend badkeylist $key
     2729                        break
     2730                    }
     2731                }
     2732                continue
     2733            }
     2734            if {! $OK} {
     2735                append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
     2736                lappend badkeylist $key
     2737            }
     2738        }
     2739    }
     2740    if {$warn == ""} return
     2741    set hint ""
     2742    set unknown ""
     2743    foreach key $badkeylist {
     2744        if {[string match  "CRS*AT*" $key]} {
     2745            if {[string first "atomic parameter" $hint] == -1} {
     2746                append hint "\t* An atomic parameter (coordinate, occupancy or U) appears out of range\n"
     2747            }
     2748        } elseif {[string match  "CRS*ABC*" $key] ||
     2749                  [string match  "CRS*ANGLES*" $key] ||
     2750                  [string match  "CRS*CELVOL*" $key]} {
     2751            if {[string first "cell parameter" $hint] == -1} {
     2752                append hint "\t* A unit cell parameter appears out of range\n"
     2753            }
     2754        } elseif {[string match  "CRS*ODF*" $key]} {
     2755            if {[string first "spherical harmonic" $hint] == -1} {
     2756                append hint "\t* A spherical harmonic (ODF) parameter appears out of range\n"
     2757            }
     2758        } elseif {[string match  "HST*ICONS" $key]} {
     2759            if {[string first "diffractometer constant" $hint] == -1} {
     2760                append hint "\t* A diffractometer constant (wave, DIFC,...) appears out of range\n"
     2761            }
     2762        } elseif {[string match  "HST*TRNGE" $key]} {
     2763            if {[string first "histogram data range" $hint] == -1} {
     2764                append hint "\t* A histogram data range value appears out of range\n"
     2765            }
     2766        } elseif {[string match "*GNLS  RUN*" $key] ||
     2767                  [string match "*GNLS SHFTS" $key] ||
     2768                  [string match "HST*RPOWD" $key] ||
     2769                  [string match " REFN RPOWD " $key] ||
     2770                  [string match " REFN GDNFT " $key]
     2771              } {
     2772            if {[string first "refinement statistics" $hint] == -1} {
     2773                append hint "\t* The refinement statistics imply the last refinement diverged\n"
     2774            }
     2775        } else {
     2776            lappend unknown $key
     2777        }
     2778    }
     2779    if {$unknown != ""} {
     2780        append hint "\t* The following less common problem record(s) appear out of range:\n\t\t"
     2781        foreach key $unknown {
     2782            append hint "\"" [string trim $key] "\" "
     2783        }
     2784    }
     2785    return "Likely error(s) noted:\n$hint\nDetails of problem(s):\n$warn"
     2786}
     2787
     2788proc ExplainEXPerror {parent message file} {
     2789    if {$parent == "."} {
     2790        set w .experr
     2791    } else {
     2792        set w $parent.experr
     2793    }
     2794    catch {destroy $w}
     2795    toplevel $w -class Dialog
     2796    wm title $w "Corrupt .EXP file"
     2797    wm iconname $w Dialog
     2798    wm protocol $w WM_DELETE_WINDOW { }
     2799    # Make the message box transient if the parent is viewable.
     2800    if {[winfo viewable [winfo toplevel $parent]] } {
     2801        wm transient $w $parent
     2802    }
     2803    frame $w.bot
     2804    pack $w.bot -side bottom -fill both
     2805    frame $w.top
     2806    pack $w.top -side top -fill both -expand 1
     2807    frame $w.msg
     2808    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
     2809    set txt {Likely errors were noted when reading this file}
     2810    append txt " ([file tail $file]). "
     2811    append txt "These problems probably\narose from the last refinement, "
     2812    append txt "based on settings applied in the previous saved file.\n"
     2813    append txt "It is probably not possible to continue with this file.\n"
     2814    append txt "You likely need to revert at least two archived versions back."
     2815    grid [label $w.msg.s -text $txt -justify left] -row 0 -column 0 -sticky nws
     2816    grid [button $w.msg.1 -text Help -bg yellow \
     2817              -command "MakeWWWHelp expgui.html badexp"] -row 0 -column 1 -columnspan 2 -sticky ne
     2818    bind $w <Key-F1> "MakeWWWHelp expgui.html badexp"
     2819    set filelist [lsort -dictionary -decreasing \
     2820                      [glob -nocomplain \
     2821                           [file root $file.O* ]]]
     2822    grid [text  $w.msg.t -font {Times 12} \
     2823              -height 10 -width 90 -relief flat -wrap word \
     2824              -yscrollcommand "$w.msg.rscr set" \
     2825             ] -row 1 -column 0  -columnspan 2 -sticky news
     2826    grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
     2827             ] -row 1 -column 2 -sticky ns
     2828    # give extra space to the text box
     2829    grid columnconfigure $w.msg 0 -weight 1
     2830    grid rowconfigure $w.msg 1 -weight 1
     2831    $w.msg.t insert end $message
     2832    button $w.ok -command [list destroy $w] -text OK -default active
     2833    pack $w.ok -in $w.bot -side left -expand 1 -padx 3m -pady 2m
     2834    putontop $w
     2835    tkwait window $w
     2836    afterputontop
     2837}
     2838
    25442839proc UpdateInfoBox {} {
    25452840    global expgui
     
    25482843    set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
    25492844    if [file isdirectory $file] return
    2550     if [file exists $file] {
     2845    if [file exists $file] {   
    25512846        pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
    25522847                -side top
    25532848        catch {
     2849            # load the EXP file into a namespace & scan for errors
     2850            expload $file scan
     2851            set warnings [ScanEXPforError scan]
     2852            if {$warnings != ""} {
     2853                pack [frame $expgui(FileInfoBox).1a -bg yellow -padx 4 -pady 4] -side top
     2854                pack [label $expgui(FileInfoBox).1a.err -justify left \
     2855                          -text "WARNING: Likely corrupt" -bg yellow] \
     2856                    -side left -anchor w -fill both
     2857                pack [button $expgui(FileInfoBox).1a.show \
     2858                          -text "More..." -padx 0 \
     2859                          -command "ExplainEXPerror $expgui(FileInfoBox) [list $warnings] $file"\
     2860                         ] -side right -anchor w
     2861            }
    25542862            set fp [open $file r]
    25552863            global testline
     
    25622870                    -text "last GENLES run:\n  $last\n  total cycles: $cycles"] \
    25632871                -side top -anchor w
     2872            set chi2 ?
     2873            set vars ?
    25642874            regexp {REFN GDNFT.*= *([0-9]*\.[0-9]*) +for *([0-9]+) variables} \
    25652875                    $testline a chi2 vars
     
    26002910                    -text $lbl] \
    26012911                    -side top -anchor w     
    2602         }
     2912        } err
    26032913    }
    26042914}
     
    26342944# fill the files & dates & Directory selection box with current directory,
    26352945# also called when box is created to fill it
    2636 proc ChooseExpFil {frm} {
     2946proc ChooseExpFil {frm "archiveonly 0"} {
    26372947    global expgui
    26382948    set files $frm.a.files
     
    26412951    $files delete 0 end
    26422952    $dates delete 0 end
    2643     $files insert end {<Parent>}
    2644     $dates insert end {(Directory)}
    2645     set filelist [glob -nocomplain \
    2646             [file join [set expgui(FileMenuDir)] *] ]
    2647     foreach file [lsort -dictionary $filelist] {
    2648         if {[file isdirectory $file]} {
    2649             $files insert end [file tail $file]
    2650             $dates insert end {(Directory)}
    2651         }
     2953    if {$archiveonly == 0} {
     2954        $files insert end {<Parent>}
     2955        $dates insert end {(Directory)}
     2956        set filelist [glob -nocomplain \
     2957                          [file join [set expgui(FileMenuDir)] *] ]
     2958        foreach file [lsort -dictionary $filelist] {
     2959            if {[file isdirectory $file]} {
     2960                $files insert end [file tail $file]
     2961                $dates insert end {(Directory)}
     2962            }
     2963        }
     2964    } else {   
     2965        set filelist [glob -nocomplain \
     2966                          [file root $expgui(expfile)].O* ]
    26522967    }
    26532968    set pairlist {}
    26542969    foreach file [lsort -dictionary $filelist] {
    26552970        if {![file isdirectory $file]  && \
    2656                 [string toupper [file extension $file]] == ".EXP"} {
     2971                [string toupper [file extension $file]] == ".EXP" \
     2972                && $archiveonly == 0} {
    26572973            set modified [file mtime $file]
    26582974            lappend pairlist [list $file $modified]
     
    27043020        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
    27053021            $files selection set $i
     3022            set expgui(FileMenuEXPNAM) $file
     3023            UpdateInfoBox
    27063024        }
    27073025    }
     
    33983716    global expgui
    33993717    if {$expgui(MacroChanged)} {
     3718
    34003719        set ans [MyMessageBox -parent $txt -title "Save macro file?" \
    34013720                     -message "Macro file has been changed, do you want to save it?" \
Note: See TracChangeset for help on using the changeset viewer.