Changeset 130

Timestamp:

Dec 4, 2009 5:00:54 PM (13 years ago)

Author:

toby

Message:

# on 2000/05/16 21:57:44, toby did:
ignore macromolecular phases
correct bug in spacegroup for export to .xtl
handle lowercase .EXP files in UNIX
use dictionary sort for filenames (so case is not sorted on)
Add a messagebox that is centered on parent (MyMessageBox?)

File:

• trunk/gsascmds.tcl (modified) (7 diffs, 3 props)

trunk/gsascmds.tcl

@@ -255 +255 @@
     global expmap expgui
     set Z 1
-    foreach phase $expmap(phaselist) {
+    foreach phase $expmap(phaselist) type $expmap(phasetype) {
+        if {$type > 2} continue
         catch {unset total}
         foreach atom $expmap(atomlist_$phase) {
@@ -275 +276 @@
         }
         append text "\n\n"
-    
+        
         append text "  Asymmetric Unit contents (Z=$Z)\n"
         foreach type [lsort [array names total]] {
@@ -316 +317 @@
     pack [frame .export.ps] -side top -anchor w
     pack [label .export.ps.lbl -text "Select phase: "] -side left
-    foreach num $expmap(phaselist) {
+    foreach num $expmap(phaselist) type $expmap(phasetype) {
         pack [button .export.ps.$num -text $num \
-                -command "SetExportPhase $num"] -side left
+                    -command "SetExportPhase $num"] -side left
+        if {$type == 4} {
+            .export.ps.$num config -state disabled
+        }
     }
     pack [frame .export.sg] -side top
@@ -334 +338 @@
 proc SetExportPhase {phase} {
     global expmap expgui
-    foreach n $expmap(phaselist) {
-        if {$n == $phase} {
+    foreach n $expmap(phaselist) type $expmap(phasetype) {
+        if {$n == $phase && $type != 4} {
             .export.ps.$n config -relief sunken
+            set expgui(export_phase) $phase
+            # remove spaces from space group
+            set spacegroup [phaseinfo $phase spacegroup]
+            if {[string toupper [string range $spacegroup end end]] == "R"} {
+                set spacegroup [string range $spacegroup 0 \
+                        [expr [string length $spacegroup]-2]] 
+            }
+            regsub -all " " $spacegroup "" expgui(export_sg)    
         } else { 
             .export.ps.$n config -relief raised
         }
     }
-    set expgui(export_phase) $phase
-    # remove spaces from space group
-    set spacegroup [phaseinfo $phase spacegroup]
-    if {[string toupper [string range $spacegroup end end]] == "R"} {
-        set spacegroup [string range $spacegroup 0 \
-                [expr [string length $spacegroup]-2]] 
-    }
-    regsub -all " " $spacegroup "" expgui(export_sg)    
 }
 
@@ -975 +979 @@
         return
     }
-    set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
+    #set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
     if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
         append expgui(FileMenuEXPNAM) ".EXP"
     }
-    if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} {
+    if {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
         tk_dialog .expFileErrorMsg "File Open Error" \
             "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
@@ -1147 +1151 @@
         }
     } else {
-        foreach pair [lsort -index 0 $pairlist] {
+        foreach pair [lsort -dictionary -index 0 $pairlist] {
             set file [lindex $pair 0]
             set modified [clock format [lindex $pair 1] -format "%T %D"]
@@ -1274 +1278 @@
 }
 
+#       Message box code that centers the message box over the parent.
+#          or along the edge, if too close, 
+#          but leave a border along +x & +y for reasons I don't remember
+#       It also allows the button names to be defined using 
+#            -type $list  -- where $list has a list of button names
+#       larger messages are placed in a scrolled text widget
+#       capitalization is now ignored for -default
+#       The command returns the name button in all lower case letters
+#       otherwise see  tk_messageBox for a description
+#
+#       This is a modification of tkMessageBox (msgbox.tcl v1.5)
+#
+proc MyMessageBox {args} {
+    global tkPriv tcl_platform
+
+    set w tkPrivMsgBox
+    upvar #0 $w data
+
+    #
+    # The default value of the title is space (" ") not the empty string
+    # because for some window managers, a 
+    #           wm title .foo ""
+    # causes the window title to be "foo" instead of the empty string.
+    #
+    set specs {
+        {-default "" "" ""}
+        {-icon "" "" "info"}
+        {-message "" "" ""}
+        {-parent "" "" .}
+        {-title "" "" " "}
+        {-type "" "" "ok"}
+    }
+
+    tclParseConfigSpec $w $specs "" $args
+
+    if {[lsearch {info warning error question} $data(-icon)] == -1} {
+        error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
+    }
+    if {![string compare $tcl_platform(platform) "macintosh"]} {
+      switch -- $data(-icon) {
+          "error"     {set data(-icon) "stop"}
+          "warning"   {set data(-icon) "caution"}
+          "info"      {set data(-icon) "note"}
+        }
+    }
+
+    if {![winfo exists $data(-parent)]} {
+        error "bad window path name \"$data(-parent)\""
+    }
+
+    switch -- $data(-type) {
+        abortretryignore {
+            set buttons {
+                {abort  -width 6 -text Abort -under 0}
+                {retry  -width 6 -text Retry -under 0}
+                {ignore -width 6 -text Ignore -under 0}
+            }
+        }
+        ok {
+            set buttons {
+                {ok -width 6 -text OK -under 0}
+            }
+          if {![string compare $data(-default) ""]} {
+                set data(-default) "ok"
+            }
+        }
+        okcancel {
+            set buttons {
+                {ok     -width 6 -text OK     -under 0}
+                {cancel -width 6 -text Cancel -under 0}
+            }
+        }
+        retrycancel {
+            set buttons {
+                {retry  -width 6 -text Retry  -under 0}
+                {cancel -width 6 -text Cancel -under 0}
+            }
+        }
+        yesno {
+            set buttons {
+                {yes    -width 6 -text Yes -under 0}
+                {no     -width 6 -text No  -under 0}
+            }
+        }
+        yesnocancel {
+            set buttons {
+                {yes    -width 6 -text Yes -under 0}
+                {no     -width 6 -text No  -under 0}
+                {cancel -width 6 -text Cancel -under 0}
+            }
+        }
+        default {
+#           error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
+            foreach item $data(-type) {
+                lappend buttons [list [string tolower $item] -text $item -under 0]
+            }
+        }
+    }
+
+    if {[string compare $data(-default) ""]} {
+        set valid 0
+        foreach btn $buttons {
+            if {![string compare [lindex $btn 0] [string tolower $data(-default)]]} {
+                set valid 1
+                break
+            }
+        }
+        if {!$valid} {
+            error "invalid default button \"$data(-default)\""
+        }
+    }
+
+    # 2. Set the dialog to be a child window of $parent
+    #
+    #
+    if {[string compare $data(-parent) .]} {
+        set w $data(-parent).__tk__messagebox
+    } else {
+        set w .__tk__messagebox
+    }
+
+    # 3. Create the top-level window and divide it into top
+    # and bottom parts.
+
+    catch {destroy $w}
+    toplevel $w -class Dialog
+    wm title $w $data(-title)
+    wm iconname $w Dialog
+    wm protocol $w WM_DELETE_WINDOW { }
+    wm transient $w $data(-parent)
+    if {![string compare $tcl_platform(platform) "macintosh"]} {
+        unsupported1 style $w dBoxProc
+    }
+
+    frame $w.bot
+    pack $w.bot -side bottom -fill both
+    frame $w.top
+    pack $w.top -side top -fill both -expand 1
+    if {[string compare $tcl_platform(platform) "macintosh"]} {
+        $w.bot configure -relief raised -bd 1
+        $w.top configure -relief raised -bd 1
+    }
+
+    # 4. Fill the top part with bitmap and message (use the option
+    # database for -wraplength and -font so that they can be
+    # overridden by the caller).
+
+    option add *Dialog.msg.wrapLength 3i widgetDefault
+
+    if {[string length $data(-message)] > 300} {
+        if {![string compare $tcl_platform(platform) "macintosh"]} {
+            option add *Dialog.msg.t.font system widgetDefault
+        } else {
+            option add *Dialog.msg.t.font {Times 18} widgetDefault
+        }
+        frame $w.msg
+        grid [text  $w.msg.t  \
+                -height 20 -width 55 -relief flat -wrap word \
+                -yscrollcommand "$w.msg.rscr set" \
+                ] -row 1 -column 0 -sticky news
+        grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
+                ] -row 1 -column 1 -sticky ns
+        # give extra space to the text box
+        grid columnconfigure $w.msg 0 -weight 1
+        grid rowconfigure $w.msg 1 -weight 1
+        $w.msg.t insert end $data(-message)
+    } else {
+        if {![string compare $tcl_platform(platform) "macintosh"]} {
+            option add *Dialog.msg.font system widgetDefault
+        } else {
+            option add *Dialog.msg.font {Times 18} widgetDefault
+        }
+        label $w.msg -justify left -text $data(-message)
+    }
+    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
+    if {[string compare $data(-icon) ""]} {
+        label $w.bitmap -bitmap $data(-icon)
+        pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
+    }
+
+    # 5. Create a row of buttons at the bottom of the dialog.
+
+    set i 0
+    foreach but $buttons {
+        set name [lindex $but 0]
+        set opts [lrange $but 1 end]
+      if {![llength $opts]} {
+            # Capitalize the first letter of $name
+          set capName [string toupper \
+                    [string index $name 0]][string range $name 1 end]
+            set opts [list -text $capName]
+        }
+
+      eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
+
+        if {![string compare $name $data(-default)]} {
+            $w.$name configure -default active
+        }
+      pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
+
+        # create the binding for the key accelerator, based on the underline
+        #
+        set underIdx [$w.$name cget -under]
+        if {$underIdx >= 0} {
+            set key [string index [$w.$name cget -text] $underIdx]
+          bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
+          bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
+        }
+        incr i
+    }
+
+    # 6. Create a binding for <Return> on the dialog if there is a
+    # default button.
+
+    if {[string compare $data(-default) ""]} {
+      bind $w <Return> [list tkButtonInvoke $w.$data(-default)]
+    }
+
+    # 7. Withdraw the window, then update all the geometry information
+    # so we know how big it wants to be, then center the window in the
+    # display and de-iconify it.
+
+    wm withdraw $w
+    update idletasks
+    set wp $data(-parent)
+    # center the new window in the middle of the parent
+    set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
+            [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
+    set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
+            [winfo reqheight $w]/2 - [winfo vrooty $wp]]
+    # make sure that we can see the entire window
+    set xborder 10
+    set yborder 25
+    if {$x < 0} {set x 0}
+    if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
+        incr x [expr \
+                [winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
+    }
+    if {$y < 0} {set y 0}
+    if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
+        incr y [expr \
+                [winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
+    }
+    wm geom $w +$x+$y
+    wm deiconify $w
+
+    # 8. Set a grab and claim the focus too.
+
+    set oldFocus [focus]
+    set oldGrab [grab current $w]
+    if {[string compare $oldGrab ""]} {
+        set grabStatus [grab status $oldGrab]
+    }
+    grab $w
+    if {[string compare $data(-default) ""]} {
+        focus $w.$data(-default)
+    } else {
+        focus $w
+    }
+
+    # 9. Wait for the user to respond, then restore the focus and
+    # return the index of the selected button.  Restore the focus
+    # before deleting the window, since otherwise the window manager
+    # may take the focus away so we can't redirect it.  Finally,
+    # restore any grab that was in effect.
+
+    tkwait variable tkPriv(button)
+    catch {focus $oldFocus}
+    destroy $w
+    if {[string compare $oldGrab ""]} {
+      if {![string compare $grabStatus "global"]} {
+            grab -global $oldGrab
+        } else {
+            grab $oldGrab
+        }
+    }
+    return $tkPriv(button)
+}
+
 #------------------------------------------------------------------------------
 # Delete History Records