Changeset 130


Ignore:
Timestamp:
Dec 4, 2009 5:00:54 PM (11 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/gsascmds.tcl

    • Property rcs:date changed from 1999/11/17 22:02:36 to 2000/05/16 21:57:44
    • Property rcs:lines changed from +44 -11 to +301 -18
    • Property rcs:rev changed from 1.15 to 1.16
    r119 r130  
    255255    global expmap expgui
    256256    set Z 1
    257     foreach phase $expmap(phaselist) {
     257    foreach phase $expmap(phaselist) type $expmap(phasetype) {
     258        if {$type > 2} continue
    258259        catch {unset total}
    259260        foreach atom $expmap(atomlist_$phase) {
     
    275276        }
    276277        append text "\n\n"
    277    
     278       
    278279        append text "  Asymmetric Unit contents (Z=$Z)\n"
    279280        foreach type [lsort [array names total]] {
     
    316317    pack [frame .export.ps] -side top -anchor w
    317318    pack [label .export.ps.lbl -text "Select phase: "] -side left
    318     foreach num $expmap(phaselist) {
     319    foreach num $expmap(phaselist) type $expmap(phasetype) {
    319320        pack [button .export.ps.$num -text $num \
    320                 -command "SetExportPhase $num"] -side left
     321                    -command "SetExportPhase $num"] -side left
     322        if {$type == 4} {
     323            .export.ps.$num config -state disabled
     324        }
    321325    }
    322326    pack [frame .export.sg] -side top
     
    334338proc SetExportPhase {phase} {
    335339    global expmap expgui
    336     foreach n $expmap(phaselist) {
    337         if {$n == $phase} {
     340    foreach n $expmap(phaselist) type $expmap(phasetype) {
     341        if {$n == $phase && $type != 4} {
    338342            .export.ps.$n config -relief sunken
     343            set expgui(export_phase) $phase
     344            # remove spaces from space group
     345            set spacegroup [phaseinfo $phase spacegroup]
     346            if {[string toupper [string range $spacegroup end end]] == "R"} {
     347                set spacegroup [string range $spacegroup 0 \
     348                        [expr [string length $spacegroup]-2]]
     349            }
     350            regsub -all " " $spacegroup "" expgui(export_sg)   
    339351        } else {
    340352            .export.ps.$n config -relief raised
    341353        }
    342354    }
    343     set expgui(export_phase) $phase
    344     # remove spaces from space group
    345     set spacegroup [phaseinfo $phase spacegroup]
    346     if {[string toupper [string range $spacegroup end end]] == "R"} {
    347         set spacegroup [string range $spacegroup 0 \
    348                 [expr [string length $spacegroup]-2]]
    349     }
    350     regsub -all " " $spacegroup "" expgui(export_sg)   
    351355}
    352356
     
    975979        return
    976980    }
    977     set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
     981    #set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
    978982    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
    979983        append expgui(FileMenuEXPNAM) ".EXP"
    980984    }
    981     if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} {
     985    if {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
    982986        tk_dialog .expFileErrorMsg "File Open Error" \
    983987            "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
     
    11471151        }
    11481152    } else {
    1149         foreach pair [lsort -index 0 $pairlist] {
     1153        foreach pair [lsort -dictionary -index 0 $pairlist] {
    11501154            set file [lindex $pair 0]
    11511155            set modified [clock format [lindex $pair 1] -format "%T %D"]
     
    12741278}
    12751279
     1280#       Message box code that centers the message box over the parent.
     1281#          or along the edge, if too close,
     1282#          but leave a border along +x & +y for reasons I don't remember
     1283#       It also allows the button names to be defined using
     1284#            -type $list  -- where $list has a list of button names
     1285#       larger messages are placed in a scrolled text widget
     1286#       capitalization is now ignored for -default
     1287#       The command returns the name button in all lower case letters
     1288#       otherwise see  tk_messageBox for a description
     1289#
     1290#       This is a modification of tkMessageBox (msgbox.tcl v1.5)
     1291#
     1292proc MyMessageBox {args} {
     1293    global tkPriv tcl_platform
     1294
     1295    set w tkPrivMsgBox
     1296    upvar #0 $w data
     1297
     1298    #
     1299    # The default value of the title is space (" ") not the empty string
     1300    # because for some window managers, a
     1301    #           wm title .foo ""
     1302    # causes the window title to be "foo" instead of the empty string.
     1303    #
     1304    set specs {
     1305        {-default "" "" ""}
     1306        {-icon "" "" "info"}
     1307        {-message "" "" ""}
     1308        {-parent "" "" .}
     1309        {-title "" "" " "}
     1310        {-type "" "" "ok"}
     1311    }
     1312
     1313    tclParseConfigSpec $w $specs "" $args
     1314
     1315    if {[lsearch {info warning error question} $data(-icon)] == -1} {
     1316        error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
     1317    }
     1318    if {![string compare $tcl_platform(platform) "macintosh"]} {
     1319      switch -- $data(-icon) {
     1320          "error"     {set data(-icon) "stop"}
     1321          "warning"   {set data(-icon) "caution"}
     1322          "info"      {set data(-icon) "note"}
     1323        }
     1324    }
     1325
     1326    if {![winfo exists $data(-parent)]} {
     1327        error "bad window path name \"$data(-parent)\""
     1328    }
     1329
     1330    switch -- $data(-type) {
     1331        abortretryignore {
     1332            set buttons {
     1333                {abort  -width 6 -text Abort -under 0}
     1334                {retry  -width 6 -text Retry -under 0}
     1335                {ignore -width 6 -text Ignore -under 0}
     1336            }
     1337        }
     1338        ok {
     1339            set buttons {
     1340                {ok -width 6 -text OK -under 0}
     1341            }
     1342          if {![string compare $data(-default) ""]} {
     1343                set data(-default) "ok"
     1344            }
     1345        }
     1346        okcancel {
     1347            set buttons {
     1348                {ok     -width 6 -text OK     -under 0}
     1349                {cancel -width 6 -text Cancel -under 0}
     1350            }
     1351        }
     1352        retrycancel {
     1353            set buttons {
     1354                {retry  -width 6 -text Retry  -under 0}
     1355                {cancel -width 6 -text Cancel -under 0}
     1356            }
     1357        }
     1358        yesno {
     1359            set buttons {
     1360                {yes    -width 6 -text Yes -under 0}
     1361                {no     -width 6 -text No  -under 0}
     1362            }
     1363        }
     1364        yesnocancel {
     1365            set buttons {
     1366                {yes    -width 6 -text Yes -under 0}
     1367                {no     -width 6 -text No  -under 0}
     1368                {cancel -width 6 -text Cancel -under 0}
     1369            }
     1370        }
     1371        default {
     1372#           error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
     1373            foreach item $data(-type) {
     1374                lappend buttons [list [string tolower $item] -text $item -under 0]
     1375            }
     1376        }
     1377    }
     1378
     1379    if {[string compare $data(-default) ""]} {
     1380        set valid 0
     1381        foreach btn $buttons {
     1382            if {![string compare [lindex $btn 0] [string tolower $data(-default)]]} {
     1383                set valid 1
     1384                break
     1385            }
     1386        }
     1387        if {!$valid} {
     1388            error "invalid default button \"$data(-default)\""
     1389        }
     1390    }
     1391
     1392    # 2. Set the dialog to be a child window of $parent
     1393    #
     1394    #
     1395    if {[string compare $data(-parent) .]} {
     1396        set w $data(-parent).__tk__messagebox
     1397    } else {
     1398        set w .__tk__messagebox
     1399    }
     1400
     1401    # 3. Create the top-level window and divide it into top
     1402    # and bottom parts.
     1403
     1404    catch {destroy $w}
     1405    toplevel $w -class Dialog
     1406    wm title $w $data(-title)
     1407    wm iconname $w Dialog
     1408    wm protocol $w WM_DELETE_WINDOW { }
     1409    wm transient $w $data(-parent)
     1410    if {![string compare $tcl_platform(platform) "macintosh"]} {
     1411        unsupported1 style $w dBoxProc
     1412    }
     1413
     1414    frame $w.bot
     1415    pack $w.bot -side bottom -fill both
     1416    frame $w.top
     1417    pack $w.top -side top -fill both -expand 1
     1418    if {[string compare $tcl_platform(platform) "macintosh"]} {
     1419        $w.bot configure -relief raised -bd 1
     1420        $w.top configure -relief raised -bd 1
     1421    }
     1422
     1423    # 4. Fill the top part with bitmap and message (use the option
     1424    # database for -wraplength and -font so that they can be
     1425    # overridden by the caller).
     1426
     1427    option add *Dialog.msg.wrapLength 3i widgetDefault
     1428
     1429    if {[string length $data(-message)] > 300} {
     1430        if {![string compare $tcl_platform(platform) "macintosh"]} {
     1431            option add *Dialog.msg.t.font system widgetDefault
     1432        } else {
     1433            option add *Dialog.msg.t.font {Times 18} widgetDefault
     1434        }
     1435        frame $w.msg
     1436        grid [text  $w.msg.t  \
     1437                -height 20 -width 55 -relief flat -wrap word \
     1438                -yscrollcommand "$w.msg.rscr set" \
     1439                ] -row 1 -column 0 -sticky news
     1440        grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
     1441                ] -row 1 -column 1 -sticky ns
     1442        # give extra space to the text box
     1443        grid columnconfigure $w.msg 0 -weight 1
     1444        grid rowconfigure $w.msg 1 -weight 1
     1445        $w.msg.t insert end $data(-message)
     1446    } else {
     1447        if {![string compare $tcl_platform(platform) "macintosh"]} {
     1448            option add *Dialog.msg.font system widgetDefault
     1449        } else {
     1450            option add *Dialog.msg.font {Times 18} widgetDefault
     1451        }
     1452        label $w.msg -justify left -text $data(-message)
     1453    }
     1454    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
     1455    if {[string compare $data(-icon) ""]} {
     1456        label $w.bitmap -bitmap $data(-icon)
     1457        pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
     1458    }
     1459
     1460    # 5. Create a row of buttons at the bottom of the dialog.
     1461
     1462    set i 0
     1463    foreach but $buttons {
     1464        set name [lindex $but 0]
     1465        set opts [lrange $but 1 end]
     1466      if {![llength $opts]} {
     1467            # Capitalize the first letter of $name
     1468          set capName [string toupper \
     1469                    [string index $name 0]][string range $name 1 end]
     1470            set opts [list -text $capName]
     1471        }
     1472
     1473      eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
     1474
     1475        if {![string compare $name $data(-default)]} {
     1476            $w.$name configure -default active
     1477        }
     1478      pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
     1479
     1480        # create the binding for the key accelerator, based on the underline
     1481        #
     1482        set underIdx [$w.$name cget -under]
     1483        if {$underIdx >= 0} {
     1484            set key [string index [$w.$name cget -text] $underIdx]
     1485          bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
     1486          bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
     1487        }
     1488        incr i
     1489    }
     1490
     1491    # 6. Create a binding for <Return> on the dialog if there is a
     1492    # default button.
     1493
     1494    if {[string compare $data(-default) ""]} {
     1495      bind $w <Return> [list tkButtonInvoke $w.$data(-default)]
     1496    }
     1497
     1498    # 7. Withdraw the window, then update all the geometry information
     1499    # so we know how big it wants to be, then center the window in the
     1500    # display and de-iconify it.
     1501
     1502    wm withdraw $w
     1503    update idletasks
     1504    set wp $data(-parent)
     1505    # center the new window in the middle of the parent
     1506    set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
     1507            [winfo reqwidth $w]/2 - [winfo vrootx $wp]]
     1508    set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
     1509            [winfo reqheight $w]/2 - [winfo vrooty $wp]]
     1510    # make sure that we can see the entire window
     1511    set xborder 10
     1512    set yborder 25
     1513    if {$x < 0} {set x 0}
     1514    if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
     1515        incr x [expr \
     1516                [winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
     1517    }
     1518    if {$y < 0} {set y 0}
     1519    if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
     1520        incr y [expr \
     1521                [winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
     1522    }
     1523    wm geom $w +$x+$y
     1524    wm deiconify $w
     1525
     1526    # 8. Set a grab and claim the focus too.
     1527
     1528    set oldFocus [focus]
     1529    set oldGrab [grab current $w]
     1530    if {[string compare $oldGrab ""]} {
     1531        set grabStatus [grab status $oldGrab]
     1532    }
     1533    grab $w
     1534    if {[string compare $data(-default) ""]} {
     1535        focus $w.$data(-default)
     1536    } else {
     1537        focus $w
     1538    }
     1539
     1540    # 9. Wait for the user to respond, then restore the focus and
     1541    # return the index of the selected button.  Restore the focus
     1542    # before deleting the window, since otherwise the window manager
     1543    # may take the focus away so we can't redirect it.  Finally,
     1544    # restore any grab that was in effect.
     1545
     1546    tkwait variable tkPriv(button)
     1547    catch {focus $oldFocus}
     1548    destroy $w
     1549    if {[string compare $oldGrab ""]} {
     1550      if {![string compare $grabStatus "global"]} {
     1551            grab -global $oldGrab
     1552        } else {
     1553            grab $oldGrab
     1554        }
     1555    }
     1556    return $tkPriv(button)
     1557}
     1558
    12761559#------------------------------------------------------------------------------
    12771560# Delete History Records
Note: See TracChangeset for help on using the changeset viewer.