Changeset 650 for trunk

Timestamp:

Dec 4, 2009 5:09:43 PM (14 years ago)

Author:

toby

Message:

# on 2002/09/05 21:03:37, toby did:
Major revision.

Implement undo
get rid of "Save Changes"
change use of icons
don't show tables with more than 100 loop values (by "column")

File:

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

trunk/browsecif.tcl

@@ -1 @@
-#!/usr/bin/wish
 # $Id$
 
@@ -433 +432 @@
 
 
+    set CIF(undolist) {}
+    set CIF(redolist) {}
     set pos 1.0
     set blocks 0
@@ -712 +713 @@
     eval $CIF(tree) delete [$CIF(tree) nodes root]
     catch {unset CIFtreeindex}
-    pack forget $CIF(EditSaveButton) $CIF(AddtoLoopButton) \
+    pack forget $CIF(AddtoLoopButton) \
             $CIF(LoopSpinBox) $CIF(DeleteLoopEntry)
     # delete old contents of frame
     set frame [$CIF(displayFrame) getframe]
     eval destroy [grid slaves $frame]
+    set CIF(widgetlist) {}
     # reset the scrollbars
     $CIF(tree) see 0
@@ -735 +737 @@
         if {[lsearch $selected $n] != -1} {set open 1}
         $CIF(tree) insert end root block$n -text "_data_$blockname" \
-                -open $open -image [Bitmap::get copy]
+                -open $open -image [Bitmap::get folder]
 
         # show errors, if any
@@ -747 +749 @@
             if {[lsearch $looplist $name] == -1} {
                 $CIF(tree) insert end block$n [incr num] -text $name \
-                        -image [Bitmap::get folder] -data block$n
+                        -image [Bitmap::get file] -data block$n
                 set CIFtreeindex(block${n}$name) $num
             }
@@ -767 +769 @@
             $CIF(tree) insert end block$n block${n}$loop \
                     -text "$loop ($catlist)" \
-                    -image [Bitmap::get file] -data "block$n loop"
+                    -image [Bitmap::get copy] -data "block$n loop"
             set CIFtreeindex(block${n}$loop) block${n}$loop
             foreach name [lsort [set block${n}($loop)]] {
                 $CIF(tree) insert end block${n}$loop [incr num] -text $name \
-                        -image [Bitmap::get folder] -data "block$n $loop"
+                        -image [Bitmap::get file] -data "block$n $loop"
                 set CIFtreeindex(block${n}$name) $num
             }
@@ -826 +828 @@
 
     pack [frame $pane.f] -fill x
-    set CIF(EditSaveButton) [button $pane.f.b -text "Save Changes" -state disabled \
-            -command "SaveCIFedits"]
     set CIF(AddtoLoopButton) [button $pane.f.l -text "Add to loop"]
     set CIF(DeleteLoopEntry) [button $pane.f.d -text "Delete loop entry" \
@@ -840 +840 @@
 # Warn to save changes that are not saved in a file
 proc CheckForCIFEdits {} {
+    #puts "CheckForCIFEdits [info level [expr [info level]-1]]"
     global CIF
-    if {$CIF(entry_changed) != ""} {
-        set ans [MyMessageBox -parent . -title "Discard Changes?" \
-                -message "You have changed this entry. Do you want to keep or discard this edit?" \
-                -icon question -type {Save Discard} -default Save]
-        if {$ans == "save"} {
-            SaveCIFedits
-            # did this save anything?
-            if {$CIF(entry_changed) != ""} {
-                # if not, don't allow the mode/loop value to change
-                set CIF(editmode) 1
-                catch {
-                    $CIF(LoopSpinBox) setvalue @$CIF(lastLoopIndex)
-                }
-                return 1
-            }
-        } else {
-            set CIF(entry_changed) {}
-            $CIF(EditSaveButton) config -state disabled
+    set errorlist {}
+    set errorflag 0
+    set msg "The following edits cannot be saved due to errors:\n"
+    foreach widget $CIF(widgetlist) {
+        CheckChanges $widget 1
+        if {$CIF(errormsg) != ""} {
+            set errorflag 1
+            foreach err $CIF(errormsg) {
+                append msg "  " $err \n
+            }
+        }
+
+    }
+    if {$errorflag} {
+        append msg \n {Do you want to make corrections, or discard these edits?}
+        set ans [MyMessageBox -parent . -title "Invalid edits" \
+                -message $msg -icon error -type "Correct Discard" \
+                -default correct]
+        if {$ans == "correct"} {
+            # if not, don't allow the mode/loop value to change
+            set CIF(editmode) 1
+            catch {
+                $CIF(LoopSpinBox) setvalue @$CIF(lastLoopIndex)
+            }
+            return 1
         }
     }
@@ -867 +875 @@
 #   shows the contents data name or a loop
 proc showCIFbyTreeID {name} {
+    if {[CheckForCIFEdits]} return
+
     global CIF
-    if {[CheckForCIFEdits]} return
     set pointer [$CIF(tree) itemcget $name -data]
     set dataname [lindex [$CIF(tree) itemcget $name -text] 0]
+    set CIF(lastShownTreeID) $name
     showCIFbyDataname $pointer $dataname
 }
 
 proc showCIFbyDataname {pointer dataname "loopindex {}"} {
-    if {[CheckForCIFEdits]} return
-    global CIF
+    global CIF CIFtreeindex
     set CIF(lastShownItem) [list $pointer $dataname]
-    # include a save button
-    if {$CIF(editmode)} {
-        pack $CIF(EditSaveButton) -side left
-    } else {
-        pack forget $CIF(EditSaveButton)
-    }
     pack forget $CIF(AddtoLoopButton) $CIF(LoopSpinBox) $CIF(DeleteLoopEntry)
 
@@ -915 +918 @@
             # get number of elements for first name
             set names [llength [set ${block}([lindex $looplist 0])]]
+            # can't delete the only entry
+            if {$names == 1 && $CIF(editmode)} {
+                $CIF(DeleteLoopEntry) configure -state disabled
+            } else {
+                $CIF(DeleteLoopEntry) configure -state normal
+            }
             $CIF(LoopSpinBox) configure -range "1 $names 1" \
                     -command    "ShowLoopVar ${block} $dataname" \
                     -modifycmd  "ShowLoopVar ${block} $dataname"
+            set CIF(lastLoopIndex) {}
             if {$loopindex == ""} {
                 $CIF(LoopSpinBox) setvalue first
@@ -946 +956 @@
             set frame0 [$frame.0 getframe]
             grid columnconfig $frame0 2 -weight 1
+            if {[set l [llength [set ${block}($dataname)]]] > 100} {
+                grid [label $frame0.a$i -justify left \
+                        -text "$dataname has $l entries, too many to display by column" \
+                        ] -sticky w -column 0 -row $i
+                return
+            }
             foreach mark [set ${block}($dataname)] {
                 incr i
@@ -981 +997 @@
 proc RepeatLastshowCIFvalue {} {
     global CIF
+    if {[CheckForCIFEdits]} return
+    set lastLoopIndex $CIF(lastLoopIndex)
+
     catch {
         eval showCIFbyDataname $CIF(lastShownItem)
+        # if we are in a loop, display the element
+        if {[lindex [lindex $CIF(lastShownItem) 0] 1] == "loop"} {
+            $CIF(LoopSpinBox) setvalue @$lastLoopIndex
+            ShowLoopVar [lindex [lindex $CIF(lastShownItem) 0] 0] \
+                    [lindex $CIF(lastShownItem) 1]
+        }
+        
     }
 }
@@ -991 +1017 @@
     global $array CIF
     # check for unsaved changes here
-    if {[CheckForCIFEdits]} return
+    if {$CIF(lastLoopIndex) != ""} {
+        if {[CheckForCIFEdits]} return
+    }
 
     set looplist [set ${array}($loop)]
@@ -1029 +1057 @@
             }
             set CIFinfoArr($widget) [lreplace $CIFinfoArr($widget) 2 2 $index]
-            $CIF(EditSaveButton) config -state disabled
         } else {
             [$frame.$i getframe].l config -text $value
@@ -1325 +1352 @@
         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"
+        }
         if {$esd} {
-            regsub {\([0-9]+\)} $v {} v
-        }
-        if [catch {expr $v}] {return "error: value $item is not a valid number for $dataname"}
+            if {[lindex $vals 1] == "."} {
+                return "error: value $item for $dataname has an invalid uncertainty (esd)"
+            }
+        } elseif {[llength $vals] == 2} {
+            return "error: $item is invalid for $dataname, an uncertainty (esd) is not allowed"
+        }
+
+        # now validate the range
         if {$range != ""} {
             # is there a decimal point in the range?
@@ -1340 +1376 @@
             if {$min != ""} {
                 if {$v < $min} {
-                    return "error: value $item is too small for $dataname"
+                    return "error: value $item is too small for $dataname (allowed range $range)"
                 }
             }
             if {$max != ""} {
                 if {$v > $max} {
-                    return "error: value $item is too big for $dataname"
+                    return "error: value $item is too big for $dataname(allowed range $range)"
                 }
             }
         }
     }
+    return {}
 }
 
@@ -1387 +1424 @@
 
     lappend CIF(widgetlist) $widget
+    set CIFinfoArr($widget) {}
 
     if $CIF(editmode) {
@@ -1394 +1432 @@
             set widgetinfo [list $dataname $block 0]
         }
+        set CIFeditArr($widget) $value
+        set CIFinfoArr($widget) $widgetinfo
+
         if {$type == "n"} {
-            set CIFeditArr($widget) $value
-            set CIFinfoArr($widget) $widgetinfo
             entry $widget -justify left -textvariable CIFeditArr($widget)
             bind $widget <Leave> "CheckChanges $widget"
@@ -1406 +1445 @@
             }
         } elseif {$elist != ""} {
-            set CIFeditArr($widget) $value
-            set CIFinfoArr($widget) $widgetinfo
             set enum {}
             foreach e $elist {
@@ -1429 +1466 @@
             $widget insert end $value
             bind $widget <Leave> "CheckChanges $widget"
-            set CIFeditArr($widget) $value
-            set CIFinfoArr($widget) $widgetinfo
             if {$nlines > 1} {
                 grid $ws -sticky nsew -column 1 -row $row
@@ -1451 +1486 @@
 
 # this is called to see if the user has changed the value for a CIF
-# data item. If the value has changed, the "Save Changes" button is
-# made active.
-proc CheckChanges {widget} {
+# data item and to validate it.
+#   save the change if $save is 1
+#   return 1 if the widget contents has changed
+proc CheckChanges {widget "save 0"} {
     global CIFeditArr CIFinfoArr CIF
-    foreach {dataname block index} $CIFinfoArr($widget) {}
+
+    set CIF(errormsg) {}
+
+    if {![winfo exists $widget]} return
+
+    set dataname {}
+    catch {
+        foreach {dataname block index} $CIFinfoArr($widget) {}
+    }
+    # if this widget is a label, the info above will not be defined & checks are not needed
+    if {$dataname == ""} {return 0}
+
     global ${block}
     set mark [lindex [set ${block}($dataname)] $index]
-    set orig [StripQuotes [$CIF(txt) get $mark.l $mark.r]]          
+    if {$mark == ""} return
+    set orig [StripQuotes [$CIF(txt) get $mark.l $mark.r]]
+
+    # validate the entry
+    set error {}
     set err {}
     switch [winfo class $widget] {
         Text {
-            set current [$widget get 1.0 end]
+            set current [string trim [$widget get 1.0 end]]
             set l 0
             foreach line [set linelist [split $current \n]] {
                 incr l
-                if {[string length $line] > 80} {lappend err $l}
+                if {[string length $line] > 80} {
+                    lappend err $l
+                    lappend error "Error: line $l for $dataname is >80 characters"
+                }
             }
             if {$err != ""} {
@@ -1474 +1528 @@
                 $widget tag config error -foreground red
             } else {
-                $widget tag delete error 
+                $widget tag delete error
             }
             # see if box should expand
@@ -1500 +1554 @@
             if {$err != "" && \
                     [string tolower [lindex $err 0]] != "warning:"} {
+                lappend error $err
                 $widget config -fg red
             } else {
@@ -1508 +1563 @@
             set current $CIFeditArr($widget)
         }
+        Label {
+            return 0
+        }
     }
     if {[string trim $orig] != [string trim $current]} {
-        if {$CIF(autosave_edits) && $err == ""} {
-            lappend CIF(entry_changed) $widget
-            SaveCIFedits
-            return
-        }
-        if {[string first $widget $CIF(entry_changed)] == -1} {
-            lappend CIF(entry_changed) $widget
-        }
-        $CIF(EditSaveButton) config -state normal
-    }
+        if {$err != ""} {
+            set CIF(errormsg) $error
+        } elseif {$save} {
+            SaveCIFedits $widget
+            return 0
+        }
+        return 1
+    }
+    return 0
 }
 
 # save the CIF edits into the CIF text widget
-proc SaveCIFedits {} {
+proc SaveCIFedits {widget} {
     global CIFeditArr CIFinfoArr CIF
-    # validate the entries
-    set error {}
-    foreach widget $CIF(entry_changed) {
-        foreach {dataname block index} $CIFinfoArr($widget) {}
-        global ${block}
-        set mark [lindex [set ${block}($dataname)] $index]
-        set orig [StripQuotes [$CIF(txt) get $mark.l $mark.r]]      
-        switch [winfo class $widget] {
-            Text {
-                set current [$widget get 1.0 end]
-                set l 0
-                foreach line [split $current \n] {
-                    incr l
-                    if {[string length $line] > 80} {
-                        lappend error "Error: line $l for $dataname is >80 characters"
-                    }
-                }
-            }
-            Entry {
-                set current [string trim [$widget get]]
-                set err [ValidateCIFItem [lindex $CIFinfoArr($widget) 0] $current]
-                if {$err != "" && [lindex $err 0] != "warning:"} {
-                    lappend error $err
-                }
-            }
-        }
-    }
-    if {$error != ""} {
-        set msg "The attempted changes cannot be saved due to:\n"
-        foreach err $error {
-            append msg "  " $err \n
-        }
-        append msg \n {Please correct and then press "Save Changes"}
-        MyMessageBox -parent . -title "Invalid Changes?" \
-                -message $msg -icon error -type Continue -default continue
-        return
-    }
-    foreach widget $CIF(entry_changed) {
-        foreach {dataname block index} $CIFinfoArr($widget) {}
-        global ${block}
-        set mark [lindex [set ${block}($dataname)] $index]
-        switch [winfo class $widget] {
-            Text {
-                set value [string trim [$widget get 1.0 end]]
-            }
-            Entry {
-                set value [string trim [$widget get]]
-            }
-            Menubutton {
-                set value $CIFeditArr($widget)
-            }
-        }
-        ReplaceMarkedText $CIF(txt) $mark $value
-        incr CIF(changes)
-    }
-    set CIF(entry_changed) {}
-    $CIF(EditSaveButton) config -state disabled
-    pack $CIF(EditSaveButton) -side left
+
+    foreach {dataname block index} $CIFinfoArr($widget) {}
+    global ${block}
+    set mark [lindex [set ${block}($dataname)] $index]
+    set orig [StripQuotes [$CIF(txt) get $mark.l $mark.r]]
+    switch [winfo class $widget] {
+        Text {
+            set current [string trim [$widget get 1.0 end]]
+        }
+        Entry {
+            set current [string trim [$widget get]]
+        }
+        Menubutton {
+            set current $CIFeditArr($widget)
+        }
+    }
+    # save for undo & clear the redo list
+    set CIF(redolist) {}
+    if {[lindex [lindex $CIF(lastShownItem) 0] 1] == "loop"} {
+        lappend CIF(undolist) [list $mark $orig \
+                $CIF(lastShownItem) $CIF(lastShownTreeID) $CIF(lastLoopIndex)]
+    } else {
+        lappend CIF(undolist) [list $mark $orig \
+                $CIF(lastShownItem) $CIF(lastShownTreeID)]
+    }
+    # count it
+    incr CIF(changes)
+    # make the change
+    ReplaceMarkedText $CIF(txt) $mark $current
 }
 
@@ -1602 +1630 @@
     set epos $line.0
     $CIF(txt) insert $epos \n
+
     # insert a ? token for each entry & add to marker list for each variable
+    set addlist {}
     foreach var $looplist {
-        incr CIF(changes)
         # go to next line?
         if {[string length \
@@ -1619 +1648 @@
         $CIF(txt) mark gravity $CIF(markcount).r right
         set epos [$CIF(txt) index "$epos + 2c"]
+        set index [llength [set ${block}($var)]]
         lappend ${block}($var) $CIF(markcount)
-    }
+        lappend addlist [list $CIF(markcount) $var $index $block]
+    }
+    incr CIF(changes)
+    lappend CIF(undolist) [list "loop add" $addlist \
+            $CIF(lastShownItem) $CIF(lastShownTreeID) $CIF(lastLoopIndex)]
+    set CIF(redolist) {}
+
     # now show the value we have added
     set frame [$CIF(displayFrame) getframe]
@@ -1629 +1665 @@
     ShowLoopVar $block $loop
     $CIF(txt) configure -state disabled
+    $CIF(DeleteLoopEntry) configure -state normal
 }
 
@@ -1675 +1712 @@
 
     $CIF(txt) configure -state normal
+    set deletelist {}
     foreach widget $CIF(widgetlist) {
         foreach {dataname block index} $CIFinfoArr($widget) {}
         global $block
         set mark [lindex [set ${block}($dataname)] $index]
+        set orig [StripQuotes [$CIF(txt) get $mark.l $mark.r]]
+        lappend deletelist [list $mark $dataname $index $block $orig]
         $CIF(txt) delete $mark.l $mark.r
         set ${block}($dataname) [lreplace [set ${block}($dataname)] $index $index]
     }
+    set CIF(redolist) {}
+    lappend CIF(undolist) [list "loop delete" $deletelist \
+            $CIF(lastShownItem) $CIF(lastShownTreeID) $CIF(lastLoopIndex)]
+    # count it
+    incr CIF(changes)
+
     $CIF(txt) configure -state disabled
 
@@ -1687 +1733 @@
     incr max -1
     $CIF(LoopSpinBox) configure -range "1 $max 1"
-    $CIF(LoopSpinBox) setvalue last
+    if {$index >= $max} {set index $max; incr index -1}
+    $CIF(LoopSpinBox) setvalue @$index
+    if {$max == 1} {$CIF(DeleteLoopEntry) configure -state disabled}
+    # don't check for changes
+    set CIF(lastLoopIndex) {}
+    ShowLoopVar $block [lindex $CIF(lastShownItem) 1]
 }
 
@@ -1716 +1767 @@
 }
 
+proc UndoChanges {} {
+    global CIF
+    # save any current changes, if possible
+    if {[CheckForCIFEdits]} return
+    # are there edits to undo?
+    if {[llength $CIF(undolist)] == 0} return
+
+    foreach {mark orig lastShownItem lastShownTreeID lastLoopIndex} \
+            [lindex $CIF(undolist) end] {} 
+
+    if {[llength $mark] == 1} {
+        # get the edited value
+        set edited [StripQuotes [$CIF(txt) get $mark.l $mark.r]]
+        # make the change back
+        ReplaceMarkedText $CIF(txt) $mark $orig
+        # add this undo to the redo list
+        lappend CIF(redolist) [list $mark $edited $lastShownItem \
+                $lastShownTreeID $lastLoopIndex]
+    } elseif {[lindex $mark 1] == "add"} {
+        set deletelist {}
+        $CIF(txt) configure -state normal
+        foreach m $orig {
+            foreach {mark dataname index block} $m {}
+            # get the inserted value
+            set edited [StripQuotes [$CIF(txt) get $mark.l $mark.r]]    
+            $CIF(txt) delete $mark.l $mark.r
+            lappend deletelist [list $mark $dataname $index $block $edited]
+            global $block
+            set ${block}($dataname) [lreplace [set ${block}($dataname)] $index $index]
+        }
+        $CIF(txt) configure -state disabled
+        # add this action to the redo list
+        lappend CIF(redolist) [list "loop delete" $deletelist \
+                $lastShownItem $lastShownTreeID $lastLoopIndex]
+    } elseif {[lindex $mark 1] == "delete"} {
+        set addlist {}
+        foreach m $orig {
+            foreach {mark dataname index block orig} $m {}
+            # make the change back
+            ReplaceMarkedText $CIF(txt) $mark $orig
+            lappend addlist [list $mark $dataname $index $block]
+            global $block
+            set ${block}($dataname) [linsert [set ${block}($dataname)] $index $mark]
+        }
+        # show the entry that was added
+        set lastLoopIndex $index
+        # add this last entry to the redo list
+        lappend CIF(redolist) [list "loop add" $addlist \
+                $lastShownItem $lastShownTreeID $lastLoopIndex]
+    }
+
+    # drop the action from the undo list
+    set CIF(undolist) [lreplace $CIF(undolist) end end]
+    # count back
+    incr CIF(changes) -1
+    # scroll on the tree
+    $CIF(tree) see $lastShownTreeID
+    eval showCIFbyDataname $lastShownItem
+
+    # if we are in a loop, display the element
+    if {[lindex [lindex $lastShownItem 0] 1] == "loop"} {
+        $CIF(LoopSpinBox) setvalue @$lastLoopIndex
+        ShowLoopVar [lindex [lindex $lastShownItem 0] 0] \
+                [lindex $lastShownItem 1]
+    }
+}
+
+
+proc RedoChanges {} {
+    global CIF
+    # save any current changes, if possible
+    if {[CheckForCIFEdits]} return
+    # are there edits to redo?
+    if {[llength $CIF(redolist)] == 0} return
+
+    foreach {mark edited lastShownItem lastShownTreeID lastLoopIndex} \
+            [lindex $CIF(redolist) end] {} 
+
+    if {[llength $mark] == 1} {
+        # get the edited value
+        set orig [StripQuotes [$CIF(txt) get $mark.l $mark.r]]
+        # make the change back
+        ReplaceMarkedText $CIF(txt) $mark $edited
+        # add this action back to the undo list
+        lappend CIF(undolist) [list $mark $orig $lastShownItem \
+                $lastShownTreeID $lastLoopIndex]
+        # count up
+        incr CIF(changes)
+    } elseif {[lindex $mark 1] == "add"} {
+        set deletelist {}
+        $CIF(txt) configure -state normal
+        foreach m $edited {
+            foreach {mark dataname index block} $m {}
+            # get the inserted value
+            set edited [StripQuotes [$CIF(txt) get $mark.l $mark.r]]    
+            $CIF(txt) delete $mark.l $mark.r
+            lappend deletelist [list $mark $dataname $index $block $edited]
+            global $block
+            set ${block}($dataname) [lreplace [set ${block}($dataname)] $index $index]
+        }
+        $CIF(txt) configure -state disabled
+        # add this action back to the undo list
+        lappend CIF(undolist) [list "loop delete" $deletelist \
+                $lastShownItem $lastShownTreeID $lastLoopIndex]
+        # count up
+        incr CIF(changes)
+    } elseif {[lindex $mark 1] == "delete"} {
+        set addlist {}
+        foreach m $edited {
+            foreach {mark dataname index block orig} $m {}
+            # make the change back
+            ReplaceMarkedText $CIF(txt) $mark $orig
+            lappend addlist [list $mark $dataname $index $block]
+            global $block
+            set ${block}($dataname) [linsert [set ${block}($dataname)] $index $mark]
+        }
+        # show the entry that was added
+        set lastLoopIndex $index
+        # add this action back to the undo list
+        lappend CIF(undolist) [list "loop add" $addlist \
+                $lastShownItem $lastShownTreeID $lastLoopIndex]
+        # count up
+        incr CIF(changes)
+    }
+    
+    # drop the action from the redo list
+    set CIF(redolist) [lreplace $CIF(redolist) end end]
+    # scroll on the tree
+    $CIF(tree) see $lastShownTreeID
+    eval showCIFbyDataname $lastShownItem
+    
+    # if we are in a loop, display the element
+    if {[lindex [lindex $lastShownItem 0] 1] == "loop"} {
+        $CIF(LoopSpinBox) setvalue @$lastLoopIndex
+        ShowLoopVar [lindex [lindex $lastShownItem 0] 0] \
+                [lindex $lastShownItem 1]
+    }
+}
+
 # initialize misc variables
-set CIF(entry_changed) {}
 set CIF(changes) 0
 set CIF(widgetlist) {}
 set CIF(lastShownItem) {}
 set CIF(lastLoopIndex) {}
-set CIF(autosave_edits) 0
 set CIF(editmode) 0
+set CIF(undolist) {}
+set CIF(redolist) {}
+set CIF(treeSelectedList) {}