Changeset 728

Timestamp:

Dec 4, 2009 5:11:01 PM (14 years ago)

Author:

toby

Message:

# on 2003/08/11 19:23:56, toby did:
significant revision for CIFTOOLS

cleanup for Mac OS X
improve error reporting
make variable for max line length (defaults to 80)

File:

• trunk/browsecif.tcl (modified) (21 diffs, 3 props)

trunk/browsecif.tcl

@@ -263 +263 @@
     }
     wm geom $w +$x+$y
+    update
     wm deiconify $w
 
@@ -315 +316 @@
     if {$y < 0} {set y 0}
     wm geom .msg +$x+$y
+    update
     wm deiconify .msg
     global makenew
@@ -748 +750 @@
     eval $CIF(tree) delete [$CIF(tree) nodes root]
     catch {unset CIFtreeindex}
-    pack forget $CIF(AddtoLoopButton) \
-            $CIF(LoopSpinBox) $CIF(DeleteLoopEntry)
+    # remove the loop counter frame from window & edit buttons from that frame
+    grid forget $CIF(LoopBar)
+    pack forget $CIF(AddtoLoopButton) $CIF(DeleteLoopEntry)
     # delete old contents of frame
     set frame [$CIF(displayFrame) getframe]
@@ -759 +762 @@
     $CIF(displayFrame) yview moveto 0
 
-    set num 0
+    # Bwidget seems to have problems with the name "1", so avoid it
+    set num 100
     foreach n $blocklist {
         global block$n
@@ -776 +780 @@
         # show errors, if any
         foreach name [array names block$n errors] {
-            $CIF(tree) insert end block$n [incr num] -text $name \
+            $CIF(tree) insert end block$n [incr num] -text "Parse-errors" \
                     -image [Bitmap::get undo] -data block$n
         }
@@ -815 +819 @@
     $CIF(tree) bindImage <1> showCIFbyTreeID
     $CIF(tree) bindText <1>  showCIFbyTreeID
+    set CIF(tree_lastindex) $num
 }
 
@@ -831 +836 @@
     set pw    [PanedWindow $frame.pw -side top]
     grid $pw -sticky news -column 0 -row 0 
+    set CIF(LoopBar) [frame $frame.f]
+    #grid $CIF(LoopBar) -sticky es -column 0 -row 1
     set width 900
     if {$width > [winfo screenwidth .]} {set width [winfo screenwidth .]}
     grid columnconfigure $frame 0 -weight 1 -minsize $width
-    grid rowconfigure $frame 0 -minsize 250 -weight 1
+    # shrink browser on small screens
+    set h 250 
+    if {[winfo screenheight .] < 500} {set h 180}
+    grid rowconfigure $frame 0 -minsize $h -weight 1
 
     # create a left hand side pane for the hierarchical tree
@@ -843 +853 @@
             -relief flat -borderwidth 0 -width 15 -highlightthickness 0 \
             -redraw 1]
+    # get the size of the font and adjust the line spacing accordingly
+    catch {
+        set font [option get $CIF(tree) font Canvas]
+        $CIF(tree) configure -deltay [font metrics $font -linespace]
+    }
     bind $frame <KeyPress-Prior> "$CIF(tree) yview scroll -1 page"
     bind $frame <KeyPress-Next> "$CIF(tree) yview scroll 1 page"
@@ -862 +877 @@
     pack $sw -fill both -expand yes -side top
 
-    pack [frame $pane.f] -fill x
-    set CIF(AddtoLoopButton) [button $pane.f.l -text "Add to loop"]
-    set CIF(DeleteLoopEntry) [button $pane.f.d -text "Delete loop entry" \
-            -command DeleteCIFRow]
-    set CIF(LoopSpinBox) [SpinBox $pane.f.sb -range "1 1 1" \
-            -label "Loop\nelement #" -labelwidth 10 -width 10]
+    set CIF(AddtoLoopButton) [button $CIF(LoopBar).l -text "Add to loop"]
+    set CIF(DeleteLoopEntry) [button $CIF(LoopBar).d \
+            -text "Delete loop entry" -command DeleteCIFRow]
+    label $CIF(LoopBar).1 -text "Loop\nelement #"
+    set CIF(LoopSpinBox) [SpinBox $CIF(LoopBar).2 -range "1 1 1"  -width 5]
+    pack $CIF(LoopBar).2 $CIF(LoopBar).1 -side right
     set CIF(displayFrame) $sw.lb
     set lb [ScrollableFrame::create $CIF(displayFrame) -width 400]
@@ -931 +946 @@
         }
         set CIF(treeSelectedList) $name
+        # for some reason, BWidget sometimes has problems doing this: 
+        # (but ignore the error)
         catch {$CIF(tree) itemconfigure $name -fill red}
         set CIF(lastShownTreeID) $name
@@ -942 +959 @@
     global CIF CIFtreeindex
     set CIF(lastShownItem) [list $pointer $dataname]
-    pack forget $CIF(AddtoLoopButton) $CIF(LoopSpinBox) $CIF(DeleteLoopEntry)
+    # remove the loop counter frame from window & edit buttons from that frame
+    grid forget $CIF(LoopBar)
+    pack forget $CIF(AddtoLoopButton) $CIF(DeleteLoopEntry)
 
     # delete old contents of frame
@@ -988 +1007 @@
                 $CIF(LoopSpinBox) setvalue @$loopindex
             }
-            pack $CIF(LoopSpinBox) -side right
+            # show the loop counter frame
+            grid $CIF(LoopBar) -sticky es -column 0 -row 1
             set row 0
             set i 0
@@ -1011 +1031 @@
             set frame0 [$frame.0 getframe]
             grid columnconfig $frame0 2 -weight 1
-            if {[set l [llength [set ${block}($dataname)]]] > 100} {
+            # maximum number of entries
+            set maxcols 100
+            catch {
+                set maxcols $CIF(maxRows)
+            }
+            if {[set l [llength [set ${block}($dataname)]]] > $maxcols} {
                 grid [label $frame0.a$i -justify left \
                         -text "$dataname has $l entries, too many to display by column" \
@@ -1034 +1059 @@
                 -column 0 -row 0 -sticky ew
         set row 0
-        if {$dataname == "errors"} {
-            set value [set ${block}($dataname)]
+        if {$dataname == "Parse-errors"} {
+            set value [set ${block}(errors)]
+        } elseif {$dataname == "Validation-errors"} {
+            set value [set ${block}(validate)]
         } else {
             set mark [set ${block}($dataname)]
@@ -1231 +1258 @@
 # replace a CIF value in with a new value.
 # add newlines as needed to make sure the new value does not 
-# exceed 80 characters/line
+# exceed CIF(maxlinelength) [defaults to 80] characters/line
 proc ReplaceMarkedText {txt mark value} {
     $txt configure -state normal
@@ -1372 +1399 @@
             if {$fp != ""} break
         }
+        if {$fp == ""} return
+        fconfigure $fp -translation binary
         catch {
             seek $fp $loc
             set line [read $fp $len]
             close $fp
-            # remove superfluous spaces
-            regsub -all {  +} [StripQuotes $line] { } line
+            # remove line ends & superfluous spaces
+            regsub -all {\n} [StripQuotes $line] { } line
+            regsub -all {\r} $line { } line
+            regsub -all {  +} $line { } line
+#           regsub -all {  +} [StripQuotes $line] { } line
         }
     }
@@ -1383 +1415 @@
 }
 
-# validates that a CIF value is valid for a specific dataname
-proc ValidateCIFItem {dataname item} {
+proc ValidateCIFName {dataname} {
     global CIF_dataname_index
     if {[
         catch {
-            foreach {type range elist esd units category} [lindex $CIF_dataname_index($dataname) 1] {}
+            set CIF_dataname_index($dataname)
         }
     ]} {return "warning: dataname $dataname not defined"}
+}
+
+# validates that a CIF value is valid for a specific dataname
+proc ValidateCIFItem {dataname item} {
+    global CIF_dataname_index CIF
+    # maximum line length
+    set maxlinelength 80
+    catch {set maxlinelength $CIF(maxlinelength)}
+    if {[catch {
+        foreach {type range elist esd units category} [lindex $CIF_dataname_index($dataname) 1] {}
+    }]} {return}
     if {$type == "c"} {
+        # string type constant
+        set item [StripQuotes $item]
+        # is it enumerated?
         if {$elist != ""} {
-            foreach i $elist {
+            # check it against the list of values
+            foreach i [concat $elist . ?] {
                 if {[string tolower $item] == [string tolower [lindex $i 0]]} {return}
             }
-            return "error: value $item is not an allowed option for $dataname"
+            return "error: value \"$item\" is not an allowed option for $dataname"
         } else {
+            # check it for line lengths
             set l 0
             set err {}
             foreach line [split $item \n] {
                 incr l
-                if {[string length $line] > 80} {lappend err $l}
+                if {[string length $line] > $maxlinelength} {lappend err $l}
             }
             if {$err != ""} {return "error: line(s) $err are too long"}
-            return
-        }
-    }
-    if {$type == ""} {return "error: dataname $dataname is not used for CIF data items"}
-    # validate numbers 
-    if {$type == "n"} {
-        if {$item == "?" || $item == "."} return
+        }
+        return
+    } elseif {$type == ""} {
+        return "error: dataname $dataname is not used for CIF data items"
+    } elseif {$type == "n"} {
+        # validate numbers
+        set unquoted [StripQuotes $item]
+        if {$unquoted == "?" || $unquoted == "."} return
+        if {$unquoted != $item} {
+            set err "\nwarning: number $item is quoted for $dataname"
+            set item $unquoted
+        } else {
+            set err {}
+        }
         set v $item
         # remove s.u., if allowed & present
         set vals [ParseSU $item]
         if {[set v [lindex $vals 0]] == "."} {
-            return "error: value $item is not a valid number for $dataname"
+            return "error: value \"$item\" is not a valid number for $dataname$err"
         }
         if {$esd} {
             if {[lindex $vals 1] == "."} {
-                return "error: value $item for $dataname has an invalid uncertainty (esd)"
+                return "error: value \"$item\" for $dataname has an invalid uncertainty (esd)$err"
             }
         } elseif {[llength $vals] == 2} {
-            return "error: $item is invalid for $dataname, an uncertainty (esd) is not allowed"
+            return "error: \"$item\" is invalid for $dataname, an uncertainty (esd) is not allowed$err"
         }
 
@@ -1434 +1488 @@
             foreach {min max} [split $range :] {}
             if {$integer && int($v) != $v} {
-                return "error: value $item must be an integer for $dataname"
+                return "warning: value \"$item\" is expected to be an integer for $dataname$err"
             }
             if {$min != ""} {
                 if {$v < $min} {
-                    return "error: value $item is too small for $dataname (allowed range $range)"
+                    return "error: value \"$item\" is too small for $dataname (allowed range $range)$err"
                 }
             }
             if {$max != ""} {
                 if {$v > $max} {
-                    return "error: value $item is too big for $dataname(allowed range $range)"
+                    return "error: value \"$item\" is too big for $dataname(allowed range $range)$err"
                 }
             }
         }
+        return $err
     }
     return {}
@@ -1553 +1608 @@
 proc CheckChanges {widget "save 0"} {
     global CIFeditArr CIFinfoArr CIF
+    # maximum line length
+    set maxlinelength 80
+    catch {set maxlinelength $CIF(maxlinelength)}
 
     set CIF(errormsg) {}
@@ -1564 +1622 @@
     # if this widget is a label, the info above will not be defined & checks are not needed
     if {$dataname == ""} {return 0}
-    if {$dataname == "errors"} {return 0}
+    if {$dataname == "Parse-errors"} {return 0}
+    if {$dataname == "Validation-errors"} {return 0}
 
     global ${block}
@@ -1580 +1639 @@
             foreach line [set linelist [split $current \n]] {
                 incr l
-                if {[string length $line] > 80} {
+                if {[string length $line] > $maxlinelength} {
                     lappend err $l
-                    lappend error "Error: line $l for $dataname is >80 characters"
+                    lappend error "Error: line $l for $dataname is >$maxlinelength characters"
                 }
             }