Changeset 1122 for branches/sandbox


Ignore:
Timestamp:
Mar 23, 2011 5:12:39 PM (10 years ago)
Author:
toby
Message:

resoved diffs w/merge problem

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/gsascmds.tcl

    r1119 r1122  
    26962696    return
    26972697}
    2698 <<<<<<< .mine
    26992698
    27002699proc ScanEXPforError {"ns {}"} {
     
    28382837}
    28392838
    2840 =======
    2841 
    2842 proc ScanEXPforError {"ns {}"} {
    2843     # record types to ignore
    2844     set ignorelist {DESCR HSTRY PNAM HNAM "REFN STATS"}
    2845     set warn {}
    2846     set badkeylist {}
    2847     # scan file for warnings
    2848     foreach key [array names ${ns}::exparray] {
    2849         if {[string first "***" [set ${ns}::exparray($key)]] != -1 ||
    2850             [string first "nan" [set ${ns}::exparray($key)]] != -1 ||
    2851             [string first "NAN" [set ${ns}::exparray($key)]] != -1
    2852         } {
    2853             #puts [set ${ns}::exparray($key)]
    2854             set OK 0
    2855             foreach i $ignorelist {
    2856                 if {[string first $i $key] != -1} {
    2857                     set OK 1
    2858                     break
    2859                 }
    2860             }
    2861             # ignore atom name section of Atom records
    2862             if {(! $OK) && [string match  "CRS*AT*A" $key]} {
    2863                 foreach str [list [string range [set ${ns}::exparray($key)] 0 49]
    2864                              [string range [set ${ns}::exparray($key)] 58 end]] {
    2865                     if {[string first "***" $str] || [string first "nan" $str] || [string first "NAN" $str]} {
    2866                         append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
    2867                         lappend badkeylist $key
    2868                         break
    2869                     }
    2870                 }
    2871                 continue
    2872             }
    2873             if {! $OK} {
    2874                 append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
    2875                 lappend badkeylist $key
    2876             }
    2877         }
    2878     }
    2879     if {$warn == ""} return
    2880     set hint ""
    2881     set unknown ""
    2882     foreach key $badkeylist {
    2883         if {[string match  "CRS*AT*" $key]} {
    2884             if {[string first "atomic parameter" $hint] == -1} {
    2885                 append hint "\t* An atomic parameter (coordinate, occupancy or U) appears out of range\n"
    2886             }
    2887         } elseif {[string match  "CRS*ABC*" $key] ||
    2888                   [string match  "CRS*ANGLES*" $key] ||
    2889                   [string match  "CRS*CELVOL*" $key]} {
    2890             if {[string first "cell parameter" $hint] == -1} {
    2891                 append hint "\t* A unit cell parameter appears out of range\n"
    2892             }
    2893         } elseif {[string match  "CRS*ODF*" $key]} {
    2894             if {[string first "spherical harmonic" $hint] == -1} {
    2895                 append hint "\t* A spherical harmonic (ODF) parameter appears out of range\n"
    2896             }
    2897         } elseif {[string match  "HST*ICONS" $key]} {
    2898             if {[string first "diffractometer constant" $hint] == -1} {
    2899                 append hint "\t* A diffractometer constant (wave, DIFC,...) appears out of range\n"
    2900             }
    2901         } elseif {[string match  "HST*TRNGE" $key]} {
    2902             if {[string first "histogram data range" $hint] == -1} {
    2903                 append hint "\t* A histogram data range value appears out of range\n"
    2904             }
    2905         } elseif {[string match "*GNLS  RUN*" $key] ||
    2906                   [string match "*GNLS SHFTS" $key] ||
    2907                   [string match "HST*RPOWD" $key] ||
    2908                   [string match " REFN RPOWD " $key] ||
    2909                   [string match " REFN GDNFT " $key]
    2910               } {
    2911             if {[string first "refinement statistics" $hint] == -1} {
    2912                 append hint "\t* The refinement statistics imply the last refinement diverged\n"
    2913             }
    2914         } else {
    2915             lappend unknown $key
    2916         }
    2917     }
    2918     if {$unknown != ""} {
    2919         append hint "\t* The following less common problem record(s) appear out of range:\n\t\t"
    2920         foreach key $unknown {
    2921             append hint "\"" [string trim $key] "\" "
    2922         }
    2923     }
    2924     return "Likely error(s) noted:\n$hint\nDetails of problem(s):\n$warn"
    2925 }
    2926 
    2927 proc ExplainEXPerror {parent message file} {
    2928     if {$parent == "."} {
    2929         set w .experr
    2930     } else {
    2931         set w $parent.experr
    2932     }
    2933     catch {destroy $w}
    2934     toplevel $w -class Dialog
    2935     wm title $w "Corrupt .EXP file"
    2936     wm iconname $w Dialog
    2937     wm protocol $w WM_DELETE_WINDOW { }
    2938     # Make the message box transient if the parent is viewable.
    2939     if {[winfo viewable [winfo toplevel $parent]] } {
    2940         wm transient $w $parent
    2941     }
    2942     frame $w.bot
    2943     pack $w.bot -side bottom -fill both
    2944     frame $w.top
    2945     pack $w.top -side top -fill both -expand 1
    2946     frame $w.msg
    2947     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    2948     set txt {Likely errors were noted when reading this file}
    2949     append txt " ([file tail $file]). "
    2950     append txt "These problems probably\narose from the last refinement, "
    2951     append txt "based on settings applied in the previous saved file.\n"
    2952     append txt "It is probably not possible to continue with this file.\n"
    2953     append txt "You likely need to revert at least two archived versions back."
    2954     grid [label $w.msg.s -text $txt -justify left] -row 0 -column 0 -sticky nws
    2955     grid [button $w.msg.1 -text Help -bg yellow \
    2956               -command "MakeWWWHelp expgui.html badexp"] -row 0 -column 1 -columnspan 2 -sticky ne
    2957     bind $w <Key-F1> "MakeWWWHelp expgui.html badexp"
    2958     set filelist [lsort -dictionary -decreasing \
    2959                       [glob -nocomplain \
    2960                            [file root $file.O* ]]]
    2961     grid [text  $w.msg.t -font {Times 12} \
    2962               -height 10 -width 90 -relief flat -wrap word \
    2963               -yscrollcommand "$w.msg.rscr set" \
    2964              ] -row 1 -column 0  -columnspan 2 -sticky news
    2965     grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
    2966              ] -row 1 -column 2 -sticky ns
    2967     # give extra space to the text box
    2968     grid columnconfigure $w.msg 0 -weight 1
    2969     grid rowconfigure $w.msg 1 -weight 1
    2970     $w.msg.t insert end $message
    2971     button $w.ok -command [list destroy $w] -text OK -default active
    2972     pack $w.ok -in $w.bot -side left -expand 1 -padx 3m -pady 2m
    2973     putontop $w
    2974     tkwait window $w
    2975     afterputontop
    2976 }
    2977 
    2978 >>>>>>> .r1118
    29792839proc UpdateInfoBox {} {
    29802840    global expgui
Note: See TracChangeset for help on using the changeset viewer.