Changeset 646


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

# on 2002/09/05 18:24:04, toby did:
add categories to loops
improve number parsing
lock edits in text window
(above grew from suggestions by B. McMahon?)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/browsecif.tcl

    • Property rcs:date changed from 2002/08/09 16:43:07 to 2002/09/05 18:24:04
    • Property rcs:rev changed from 1.1 to 1.2
    • Property rcs:lines set to +151 -41
    r638 r646  
    297297    toplevel .msg
    298298    wm transient .msg [winfo toplevel .]
    299     pack [frame .msg.f -bd 4 -relief groove]
     299    pack [frame .msg.f -bd 4 -relief groove] -padx 5 -pady 5
    300300    pack [message .msg.f.m -text "Please wait $message"]
    301301    wm withdraw .msg
     
    400400# the contents of each loop are saved as blockN(loop_M)
    401401#
     402# if the filename is blank or not specified, the current contents
     403#    of the text widget, $txt, is parsed.
     404#
    402405# The proc returns the number of blocks that have been read or a
    403406#    null string if the file cannot be opened
     
    406409#    but the parser could get confused if the CIF has invalid syntax
    407410#
    408 proc ParseCIF {txt filename} {
     411proc ParseCIF {txt "filename {}"} {
    409412    global CIF tcl_version
     413    global CIF_dataname_index
    410414
    411415    if {$tcl_version < 8.2} {
     
    416420    }
    417421
    418     if [catch {
    419         set fp [open $filename r]
    420         $txt insert end [read $fp]
    421         close $fp
    422     }] {return ""}
     422    if {$filename != ""} {
     423        if [catch {
     424            $txt configure -state normal
     425            set fp [open $filename r]
     426            $txt insert end [read $fp]
     427            close $fp
     428            $txt configure -state disabled
     429        }] {
     430            return ""
     431        }
     432    }
     433
    423434
    424435    set pos 1.0
     
    486497                # in a loop header, save the names in the loop list
    487498                lappend looplist $dataname
     499                # check the categories used in the loop
     500                set category {}
     501                catch {
     502                    set category [lindex \
     503                            [lindex $CIF_dataname_index($dataname) 1] 5]
     504                }
     505                # don't worry if we don't have a category
     506                if {$category != ""} {
     507                    if {$catlist == ""} {
     508                        set catlist $category
     509                    } elseif {[lsearch $catlist $category] == -1} {
     510                        # error two categories in a loop
     511                        lappend catlist $category
     512                        append block${blocks}(errors) \
     513                                "Multiple categories ($catlist) in a loop_ for $dataname at line [lindex [split $pos .] 0]\n"
     514                    }
     515                }
     516               
    488517                if {$blocks == 0} {
    489518                    # an error -- a loop_ before a data_ block start
     
    519548            incr loopnum
    520549            set looplist {}
     550            set catlist {}
    521551            set block${blocks}(loop_${loopnum}) {}
    522552            # move forward past current token
     
    675705#    frame gives the name of the toplevel or frame to hold the browser
    676706proc CIFBrowser {txt blocklist "selected {}" "frame .cif"} {
    677     global CIF CIFtreeindex
     707    global CIF CIFtreeindex CIF_dataname_index
    678708
    679709    if {$selected == ""} {set selected $blocklist}
     
    722752        }
    723753        foreach loop [lsort [array names block$n loop_*]] {
    724             $CIF(tree) insert end block$n block${n}$loop -text $loop \
     754            # make a list of categories used in the loop
     755            set catlist {}
     756            foreach name [lsort [set block${n}($loop)]] {
     757                set category {}
     758                catch {
     759                    foreach {type range elist esd units category} \
     760                            [lindex $CIF_dataname_index($name) 1] {}
     761                }
     762                if {$category != "" && [lsearch $catlist $category] == -1} {
     763                    lappend catlist $category
     764                }
     765            }
     766
     767            $CIF(tree) insert end block$n block${n}$loop \
     768                    -text "$loop ($catlist)" \
    725769                    -image [Bitmap::get file] -data "block$n loop"
    726770            set CIFtreeindex(block${n}$loop) block${n}$loop
     
    826870    if {[CheckForCIFEdits]} return
    827871    set pointer [$CIF(tree) itemcget $name -data]
    828     set dataname [$CIF(tree) itemcget $name -text]
     872    set dataname [lindex [$CIF(tree) itemcget $name -text] 0]
    829873    showCIFbyDataname $pointer $dataname
    830874}
     
    9921036}
    9931037
    994 # Parse a number in CIF, that may include a SU (ESD) value
    995 # note that this routine will ignore spaces, quotes & semicolons
    996 proc ParseSU {value} {
    997     # if there is no SU just return the value
    998     if {[string first "(" $value] == -1} {
    999         return $value
    1000     }
    1001     # is there a decimal point?
    1002     if [regexp {([-+]?[0-9]*\.)([0-9]*)\(([0-9]+)\)} $value junk a b err] {
    1003         set ex [string length $b]
    1004         return [list ${a}${b} [expr {pow(10.,-$ex)*$err}]]
    1005     }
    1006     if [regexp {([-+]?[0-9]*)\(([0-9]+)\)} $value junk a err] {
    1007         return [list ${a} $err]
    1008     }
    1009     tk_dialog .err {ParseSU Error} \
    1010             "ParseSU: Error processing value $value" \
    1011             warning 0 Continue
     1038# scan a number in crystallographic uncertainty representation
     1039# i.e.: 1.234(12), 1234(23), 1.234e-2(14),  -1.234-08(14), etc.
     1040proc ParseSU {num} {
     1041    # is there an error on this value?
     1042    if {![regexp {([-+eEdD.0-9]+)\(([0-9]+)\)} $num x a err]} {
     1043        set a $num
     1044        set err {}
     1045    }
     1046    # parse off an exponent, if present
     1047    if {[regexp {([-+.0-9]+)[EeDd]([-+0-9]+)} $a x a1 exp]} {
     1048        # [+-]###.###e+## or [+-]###.###D-## etc.
     1049        set a $a1
     1050        # remove leading zeros from exponent
     1051        regsub {([+-]?)0*([0-9]+)} $exp {\1\2} exp
     1052    } elseif {[regexp {([-+.0-9]+)([-+][0-9]+)} $a x a1 exp]} {
     1053        # [+-]###.###+## or [+-]###.###-## etc. [no
     1054        set a $a1
     1055        # remove leading zeros from exponent
     1056        regsub {([+-]?)0*([0-9]+)} $exp {\1\2} exp
     1057    } else {
     1058        set exp 0
     1059    }
     1060    # now parse the main number and count the digits after the decimal
     1061    set a2 {}
     1062    set a3 {}
     1063    regexp {^([-+0-9]*)\.?([0-9]*)$} $a x a2 a3
     1064    set l [string length $a3]
     1065
     1066    set val .
     1067    set error {}
     1068    if {[catch {
     1069        set val [expr ${a2}.${a3} * pow(10,$exp)]
     1070        if {$err != ""} {
     1071            set error [expr $err*pow(10,$exp-$l)]
     1072        }
     1073    }]} {
     1074        # something above was invalid
     1075        if {$err != ""} {
     1076            return "$val ."
     1077        } else {
     1078            return $val
     1079        }
     1080    }
     1081    if {$error == ""} {
     1082        return $val
     1083    } else {
     1084        return [list $val $error]
     1085    }
    10121086}
    10131087
     
    10271101    if {$file == ""} return
    10281102    if {![file exists $file]} return
    1029     pleasewait "Reading CIF file"
     1103    pleasewait "Reading CIF from file"
    10301104    set blocks [ParseCIF $file]
    10311105    if {$blocks == ""} {
     
    10771151# exceed 80 characters/line
    10781152proc ReplaceMarkedText {txt mark value} {
     1153    $txt configure -state normal
    10791154    # is this a multi-line string?
    10801155    set num [string first \n $value]
     
    11141189        $txt delete ${mark}.l ${mark}.r
    11151190        $txt insert ${mark}.l $tmp
     1191        $txt configure -state disabled
    11161192        return
    11171193    } elseif {($spaces != -1 || [string trim $value] == "") \
     
    11451221        $txt insert $mark.r \n
    11461222    }
     1223    $txt configure -state disabled
    11471224}
    11481225
     
    12221299    if {[
    12231300        catch {
    1224             foreach {type range elist esd units} [lindex $CIF_dataname_index($dataname) 1] {}
     1301            foreach {type range elist esd units category} [lindex $CIF_dataname_index($dataname) 1] {}
    12251302        }
    12261303    ]} {return "warning: dataname $dataname not defined"}
     
    12791356    global CIF
    12801357    set deflist [GetCIFDefinitions $defs]
    1281     $CIF(defBox) delete 1.0 end
    1282     foreach d $deflist {
    1283         foreach {namelist definition} $d {}
    1284         foreach n $namelist {
    1285             $CIF(defBox) insert end $n dataname
     1358    catch {
     1359        $CIF(defBox) delete 1.0 end
     1360        foreach d $deflist {
     1361            foreach {namelist definition} $d {}
     1362            foreach n $namelist {
     1363                $CIF(defBox) insert end $n dataname
     1364                $CIF(defBox) insert end \n
     1365            }
    12861366            $CIF(defBox) insert end \n
    1287         }
    1288         $CIF(defBox) insert end \n
    1289         $CIF(defBox) insert end $definition
    1290         $CIF(defBox) insert end \n
    1291         $CIF(defBox) insert end \n
    1292     }
    1293     $CIF(defBox) tag config dataname -background yellow
     1367            $CIF(defBox) insert end $definition
     1368            $CIF(defBox) insert end \n
     1369            $CIF(defBox) insert end \n
     1370        }
     1371        $CIF(defBox) tag config dataname -background yellow
     1372    }
    12941373}
    12951374
     
    13001379    if {[
    13011380        catch {
    1302             foreach {type range elist esd units} [lindex $CIF_dataname_index($dataname) 1] {}
     1381            foreach {type range elist esd units category} [lindex $CIF_dataname_index($dataname) 1] {}
    13031382        }
    13041383    ]} {
     
    15121591    if {[CheckForCIFEdits]} return
    15131592
     1593    $CIF(txt) configure -state normal
    15141594    set looplist [set ${block}($loop)]
    15151595    set length [llength [set ${block}([lindex $looplist 0])]]
     
    15481628    $CIF(LoopSpinBox) setvalue last
    15491629    ShowLoopVar $block $loop
     1630    $CIF(txt) configure -state disabled
    15501631}
    15511632
     
    15931674    if {$ans == "keep"} {return}
    15941675
     1676    $CIF(txt) configure -state normal
    15951677    foreach widget $CIF(widgetlist) {
    15961678        foreach {dataname block index} $CIFinfoArr($widget) {}
     
    16001682        set ${block}($dataname) [lreplace [set ${block}($dataname)] $index $index]
    16011683    }
     1684    $CIF(txt) configure -state disabled
    16021685
    16031686    set max [lindex [$CIF(LoopSpinBox) cget -range] 1]
     
    16051688    $CIF(LoopSpinBox) configure -range "1 $max 1"
    16061689    $CIF(LoopSpinBox) setvalue last
     1690}
     1691
     1692# display & highlight a line in the CIF text viewer
     1693proc MarkGotoLine {line} {
     1694    global CIF
     1695    $CIF(txt) tag delete currentline
     1696    $CIF(txt) tag add currentline $line.0 $line.end
     1697    $CIF(txt) tag configure currentline -foreground blue
     1698    $CIF(txt) see $line.0
     1699}
     1700
     1701# Extract a value from a CIF in the  CIF text viewer
     1702proc ValueFromCIF {block item} {
     1703    global $block CIF
     1704    set val {}
     1705    catch {
     1706        set mark [set ${block}($item)]
     1707        if {[llength $mark] == 1} {
     1708            set val [string trim [StripQuotes [$CIF(txt) get $mark.l $mark.r]]]
     1709        } else {
     1710            foreach m $mark {
     1711                lappend val [string trim [StripQuotes [$CIF(txt) get $m.l $m.r]]]
     1712            }
     1713        }
     1714    }
     1715    return $val
    16071716}
    16081717
     
    16141723set CIF(lastLoopIndex) {}
    16151724set CIF(autosave_edits) 0
     1725set CIF(editmode) 0
Note: See TracChangeset for help on using the changeset viewer.