Changeset 846 for trunk

Timestamp:

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

Author:

toby

Message:

# on 2005/09/07 21:26:38, toby did:
fix use of delete window decoration (== quit)
fix display arrows options; warn on old GEOMETRY program
use .drawxtlrc to find DRAWXTL5.x program

File:

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

trunk/export_drawxtl.tcl

@@ -22 +22 @@
     # force the window to stay on top
     putontop .export
+    # trigger a quit on window delete
+    wm protocol .export WM_DELETE_WINDOW {set expgui(export_phase) 0; destroy .export }
     set bx .export.special
     global DXTL
@@ -41 +43 @@
     incr row
     set DXTL(arrowbox) $bx.4
-    grid [checkbutton $bx.4 -text "Generate arrows for magnetic atoms" \
+    grid [checkbutton $bx.4 -text "Display arrows for magnetic atoms" \
               -variable DXTL(genarrows) -state disabled] \
         -row $row -column 1 -columnspan 5 -sticky w
@@ -47 +49 @@
     set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
     set DXTL(arrowcolorbox) $bx.4a
-    grid [frame $bx.4a] -sticky ew -row $row -column 1 -columnspan 5
-    grid [label $bx.4a.h -text "Representation: "] -column 0 -row 1
-    grid [label $bx.4a.bll -text "gen from Block operator "] -column 1 -row 1
+    set DXTL(arrowcolorbox_row) $row
+    grid [frame $bx.4a] -sticky ew -row $DXTL(arrowcolorbox_row) \
+        -column 1 -columnspan 5 
+    grid [label $bx.4a.h -text "Arrow colors: "] -column 0 -row 1 -sticky w
+    grid [label $bx.4a.bll -text "   generated by Black operator "] -column 0 -row 2
     eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $colorlist
-    grid $bx.4a.bl -column 2 -row 1
-    grid [label $bx.4a.redl -text "gen from Red operator "] -column 1 -row 2
+    grid $bx.4a.bl -column 2 -row 2
+    grid [label $bx.4a.redl -text "  generated by Red operator "] -column 0 -row 3
     eval tk_optionMenu $bx.4a.red DXTL(redarrow) $colorlist
-    grid $bx.4a.red -column 2 -row 2
-    incr row
-    foreach appname {DRAWxtl41 DRAWxtl41_aqua DRAWxtl50 DRAWxtl51} {
+    grid $bx.4a.red -column 2 -row 3
+    incr row
+    # is DRAWxtl installed?
+    set app {}
+    if {![catch {set fp [open [file join $::env(HOME) .drawxtlrc] r]}]} {
+        # line 12 is name of executable
+        set i 0
+        while {$i < 12} {
+            incr i
+            gets $fp appname
+        }
+        close $fp
         set app [auto_execok $appname]
-        if {$app != ""} {break}
-        foreach loc [list $expgui(scriptdir) \
-                         ~/Applications/DRAWxtlxx1/DRAWxtl501/] {
-            if {[file exists [file join $loc $appname]]} {
-                set app [file join $loc $appname]
-                break
-            }
-        }
-        if {$app != ""} {break}
     }
     if {$app != ""} {
         set show normal
-        set DXTL(app) $app
+        set DXTL(app) $appname
         set DXTL(launch) 1
     } else {
@@ -97 +101 @@
     }
     # atom type box
-    grid [frame $bx.s -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
+    grid [frame $bx.s -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew
     grid [label $bx.s.0 -text "Atom representation" \
               -anchor w] -row 0 -column 0 -sticky w
@@ -261 +265 @@
         set DXTL(genarrows) 1
         $DXTL(arrowbox) configure -state normal
-        grid $DXTL(arrowcolorbox) 
+        grid $DXTL(arrowcolorbox) -sticky ew -row $DXTL(arrowcolorbox_row) \
+            -column 1 -columnspan 5
     }
     catch {unset typelist}
@@ -299 +304 @@
     [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
         -width [lindex $sizes 2]
+    wm geom [winfo toplevel $DXTL(Blst)] {}
 }
 
@@ -367 +373 @@
         set fp [open geom.out r]
         while {[gets $fp line] >= 0} {
+            if {[string match "*Geometry*,L,N,*" $line]} {
+                MyMessageBox -parent . -title "Old GSAS" \
+                    -message "Old GEOMETRY program: You are using an old version of GSAS that cannot export magnetic vectors. Upgrade GSAS to generate arrows." -icon warning
+                break
+            }
             if {[string match "*name*elem*x *y *z*x *y *z*" $line]} {break}
         }