Changeset 384 for trunk/gsascmds.tcl

Timestamp:

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

Author:

toby

Message:

# on 2001/04/17 22:49:47, toby did:
revise tk_dialog to MyMessage? box
Use CR/LF format files on all platforms
remove unix file conversion

File:

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

trunk/gsascmds.tcl

@@ -861 +861 @@
                 }
             } else {
-                tk_dialog .warn "No Browser" \
-                        "Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
-                        warn 0 OK
+                MyMessageBox -parent . -title "No Browser" \
+                        -message "Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
+                        -icon warn
             }
         }
@@ -1133 +1133 @@
     }
     if {$errmsg != ""} {
-        tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
+        MyMessageBox -parent . -title "Export error" \
+                -message "Export error: $errmsg" -icon warning
         return
     }
@@ -1180 +1181 @@
     } errmsg] {
         catch {close $fp}
-        tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
+        MyMessageBox -parent . -title "Export error" \
+                -message "Export error: $errmsg" -icon warning
     } else {
         catch {close $fp}
@@ -1387 +1389 @@
 
 #------------------------------------------------------------------------------
-# file conversion for UNIX
+# file conversions
 #------------------------------------------------------------------------------
-# convert a file
 proc convfile {} {
-    global tcl_platform
-    if {$tcl_platform(platform) == "windows"} {
-        convwin
-    } else {
-        convunix
-    }
-}
-
-# file conversions for UNIX (convstod convdtos)
-proc convunix {} {
-    global expgui infile outfile 
-    set frm .file
-    catch {destroy $frm}
-    toplevel $frm
-    wm title $frm "Convert File"
-    bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertUnix"
-
-    pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
-            -padx 3 -pady 3 -side top -fill x
-    pack [frame $frm.mid] -side top
-    pack [frame [set frmA $frm.mid.1] -bd 2 -relief groove] \
-            -padx 3 -pady 3 -side left
-    pack [label $frmA.0 -text "Select an input file"] -side top -anchor center
-    pack [frame [set frmB $frm.mid.2] -bd 2 -relief groove] \
-            -padx 3 -pady 3 -side left
-    pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
-    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top -fill x -expand y
-
-    pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
-    pack [frame $frm0.2] -side top -anchor center
-    pack [radiobutton $frm0.2.d -text "direct access" -value convstod \
-            -command setoutfile \
-            -variable outfile(type)] -side left -anchor center
-    pack [radiobutton $frm0.2.s -text "sequential" -value convdtos \
-            -command setoutfile \
-            -variable outfile(type)] -side right -anchor center
-    set outfile(type) ""
-
-    pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
-    pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
-    pack [button $frmC.help -text Help -bg yellow \
-            -command "MakeWWWHelp expgui.html ConvertUnix"] \
-            -side right
-    
-    unixcnvbox $frmA infile 1 
-    unixcnvbox $frmB outfile 0 
-    set infile(done) 0
-    bind $frm <Return> "valid_conv_unix"
-    # force the window to stay on top
-    putontop $frm
-    focus $frmC.q 
-    update
-    tkwait variable infile(done)
-    destroy $frm
-    afterputontop
-}
-
-# validate the files and make the conversion -- unix
-proc valid_conv_unix {} {
-    global infile outfile expgui
-    set error {}
-    if {$outfile(type) == "convstod" || $outfile(type) == "convdtos"} {
-        set convtype $outfile(type)
-    } else {
-        append error "You must specify a conversion method: to direct access or to sequential.\n"
-    }
-    if {$infile(name) == ""} {
-        append error "You must specify an input file to convert.\n"
-    }
-    if {$outfile(name) == ""} {
-        append error "You must specify an output file name for the converted file.\n"
-    }
-    if {$error != ""} {
-        tk_dialog .warn Notify $error warning 0 OK
-        return
-    }
-
-    if {$infile(name) == $outfile(name)} {
-        MyMessageBox -parent . -title Notify \
-                -message "Sorry, filenames must differ" \
-                -icon warning -helplink "expguierr.html ConvSameName"
-        tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK
-        return
-    }
-    if ![file exists [file join $infile(dir) $infile(name)]] {
-        MyMessageBox -parent . -title Notify \
-                -message "Sorry, file $infile(name) not found in $infile(dir)" \
-                -icon warning -helplink "expguierr.html ConvNotFound"
-        return
-    }
-    if [file exists [file join $outfile(dir) $outfile(name)]] {
-        set ans [MyMessageBox -parent . -title "Overwrite?" \
-                -message "Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \
-                -icon warning -type {Overwrite Cancel} -default Overwrite \
-                -helplink "expguierr.html OverwriteCnv"]
-        if {[string tolower $ans] == "cancel"} return
-    }
-    if [catch {
-        exec [file join $expgui(gsasexe) $convtype] < \
-                [file join $infile(dir) $infile(name)] > \
-                [file join $outfile(dir) $outfile(name)]
-    } errmsg] {
-        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
-    } else {
-        if [tk_dialog .converted Notify \
-                "File converted. Convert more files?" \
-                ""  0 Yes No] {set infile(done) 1}
-    }
-}
-
-# create a file box for UNIX conversions
-proc unixcnvbox {bx filvar diropt} {
-    global ${filvar} expgui
-    pack [frame $bx.top] -side top 
-    pack [label $bx.top.a -text "Directory" ] -side left 
-    set ${filvar}(FileDirButtonMenu) [tk_optionMenu $bx.top.d ${filvar}(dir) [pwd] ]
-    pack $bx.top.d -side left
-    set ${filvar}(dir) [pwd]
-
-#    pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top 
-#    set ${filvar}(dir) [pwd]
-
-    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
-    listbox $bx.a.files -relief raised -bd 2 \
-            -yscrollcommand "$bx.a.scroll set" \
-            -height 15 -width 0 -exportselection 0 
-    scrollbar $bx.a.scroll -command "$bx.a.files yview"
-    unixFilChoose $bx $bx.a.files $filvar $diropt
-    if {$filvar == "infile"} {
-        bind $bx.a.files <ButtonRelease-1> \
-                "unixFilChoose $bx $bx.a.files $filvar $diropt; setoutfile"
-    } else {
-        bind $bx.a.files <ButtonRelease-1> \
-                "unixFilChoose $bx $bx.a.files $filvar $diropt"
-    }
-    pack $bx.a.scroll -side left -fill y 
-    pack $bx.a.files -side left -fill both -expand yes
-    pack [entry $bx.c -textvariable ${filvar}(name)] -side top
-}
-
-# select a file or directory, also called when box is created to fill it
-proc unixFilChoose {frm box filvar {dironly 1}} {
-    global $filvar
-    set select [$box curselection]
-    if {$select == ""} {
-        set file .
-    } else {
-        set file [string trim [$box get $select]]
-    }
-    if [file isdirectory [file join [set ${filvar}(dir)] $file]] {
-        if {$file == ".."} {
-            set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ]
-        } elseif {$file != "."} {
-            set ${filvar}(dir) [file join [set ${filvar}(dir)] $file]
-        }
-        [set ${filvar}(FileDirButtonMenu)] delete 0 end
-        set list ""
-        set dir ""
-        foreach subdir [file split [set ${filvar}(dir)]] {
-            set dir [file join $dir $subdir]
-            lappend list $dir
-        }
-        foreach path $list {
-            [set ${filvar}(FileDirButtonMenu)] add command -label $path \
-                -command "[list set ${filvar}(dir) $path]; \
-                unixFilChoose $frm $box $filvar $dironly"
-        }
-        set ${filvar}(name) {}
-        $box delete 0 end
-        $box insert end {..   }
-        foreach file [lsort -dictionary [glob -nocomplain \
-                [file join [set ${filvar}(dir)] *] ] ] {
-            if {[file isdirectory $file]} {
-                # is this / needed here? Does it cause a problem in MacGSAS?
-                $box insert end [file tail $file]/
-            } elseif {$dironly == 1} {
-                $box insert end [file tail $file]
-            } elseif {$dironly == 2 && [file extension $file] == ".EXP"} {
-                $box insert end [file tail $file]
-            }
-        }
-        return
-    }
-    set ${filvar}(name) [file tail $file]
-}
-
-# set new file name from old -- used for convunix
-proc setoutfile {} {
-    global infile outfile
-    if {$outfile(type) == "convstod"} {
-        set lfile [string toupper $infile(name)]
-    } elseif {$outfile(type) == "convdtos"} {
-        set lfile [string tolower $infile(name)]
-    } else {
-        set lfile ""
-    }
-    if {$infile(name) == $lfile} {
-        set outfile(name) {}
-    } else {
-        set outfile(name) $lfile
-    }
-}
-
-#------------------------------------------------------------------------------
-# file conversions for Windows
-#------------------------------------------------------------------------------
-proc convwin {} {
     global expgui
     set frm .file
@@ -1649 +1443 @@
     set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
     if ![file exists $file] {
-        tk_dialog .warn "Convert Error" \
-                "File $file does not exist" question 0 "OK"
+        MyMessageBox -parent $frm -title "Convert Error" \
+                -message "File $file does not exist" -icon error
         return
     }
@@ -1668 +1462 @@
         set in [open $file r]
         set out [open $tmpname w]
+        fconfigure $out -translation crlf
         set len [gets $in line]
         if {$len > 160} {
@@ -1692 +1487 @@
         file rename -force $tmpname $file
     } errmsg] {
-        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
+        MyMessageBox -parent $frm -title "Conversion error" \
+                -message "Error in conversion:\n$errmsg" -icon warning
     } else {
-        if [tk_dialog .converted Notify \
-                "File [file tail $file] converted. (Original saved as [file tail $oldname]).\n\n Convert more files?" \
-                ""  0 Yes No] {destroy $frm}
+        set ans [MyMessageBox -parent $frm -title "More?" \
+                -message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
+                -type yesno -default no]
+        if {$ans == "no"} {destroy $frm}
     }
 }
@@ -1946 +1743 @@
     # flag files that end in something other than .EXP .exp or .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\"" \
-            error 0 OK
+        MyMessageBox -parent . -title "File Open Error" \
+                -message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
+                -icon error
         return
     }