Changeset 29

Timestamp:

Dec 4, 2009 4:59:11 PM (14 years ago)

Author:

toby

Message:

# on 1999/01/20 19:27:48, toby did:
use custom file open box; fix GSAS env definition on -95 and -NT

File:

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

trunk/gsascmds.tcl

@@ -10 +10 @@
     }
     if {$tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } {
+        # this creates a DOS box to run a program in
         proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
             global env expgui
             # Windows environment variables
             # -95 does not seem to be able to use these
-            set env(GSAS) [file nativename $expgui(gsasexe)]
+            set env(GSAS) [file nativename $expgui(gsasdir)]
             # PGPLOT_FONT is needed by PGPLOT
             set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
@@ -46 +47 @@
     } else {
         # now for - brain-dead Windows-NT
+        # this creates a DOS box to run a program in
         proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
             global env expgui
             # Windows environment variables
             # -95 does not seem to be able to use these
-            set env(GSAS) [file nativename $expgui(gsasexe)]
+            set env(GSAS) [file nativename $expgui(gsasdir)]
             # PGPLOT_FONT is needed by PGPLOT
             set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
@@ -75 +77 @@
     if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1}
 
+    # this creates a xterm window to run a program in
     proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
         global env expgui
@@ -112 +115 @@
 }
 
-
-proc newexp {} {
-    global infile outfile 
-    set frm .file
-    catch {destroy $frm}
-    toplevel $frm
-    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
-    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
-    pack [button $frmC.b -text Create -command "valid_new_exp_file"] -side top
-    bind $frm <Return> "valid_new_exp_file"
-    pack [button $frmC.q -text Quit -command "set infile(done) 2"] -side top
-
-    pack [label $frmA.0 -text "Enter an experiment file"] -side top -anchor center
-    expfilebox $frmA infile 2
-    set infile(done) 0
-    # force the window to stay on top
-    wm transient $frm [winfo toplevel [winfo parent $frm]]
-
-    wm withdraw $frm
-    update idletasks
-    # center the new window in the middle of the parent
-    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
-            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
-    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
-            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
-    wm geom $frm +$x+$y
-    wm deiconify $frm
-
-    set oldFocus [focus]
-    set oldGrab [grab current $frm]
-    if {$oldGrab != ""} {
-        set grabStatus [grab status $oldGrab]
-    }
-    grab $frm
-    focus $frmC.b
-    tkwait variable infile(done)
-    destroy $frm
-    catch {focus $oldFocus}
-    if {$oldGrab != ""} {
-        if {$grabStatus == "global"} {
-            grab -global $oldGrab
-        } else {
-            grab $oldGrab
-        }
-    }
-    if {$infile(done) == 2} return
-    return [file join $infile(dir) $infile(name)]
-}
-
+# get a value in a modal toplevel 
 proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
     global expgui expmap
@@ -216 +171 @@
 }
 
-
-proc next {direction} {
-    global
-    set filelist [lsort [glob *.EXP]]
-    set ind [lsearch $filelist $expnam.EXP]
-    if {$ind == -1 && $expnam != ""} return
-    if $direction { # true positive
-        incr ind
-    } {
-        incr ind -1
-    }
-    if {$ind < 0} {set ind [expr [llength $filelist]-1]}
-    if {$ind >= [llength $filelist] } {set ind 0}
-    set expnam [string toupper [file root [lindex $filelist $ind]]]
-    showexp
-}
-
+# run a GSAS program that does not require an experiment file
 proc runGSASprog {proglist} {
     global expgui tcl_platform
@@ -247 +186 @@
 }
 
+# run a GSAS program that requires an experiment file for input/output
 proc runGSASwEXP {proglist} {
     global expgui tcl_platform
@@ -266 +206 @@
 }
 
+# run liveplot
 proc liveplot {} {
     global expgui liveplot wishshell
     set expnam [file root [file tail $expgui(expfile)]]
     exec $wishshell [file join $expgui(scriptdir) liveplot] \
-            $expnam $expgui(gsasexe) $liveplot(hst) $liveplot(legend) &
-}
-
+            $expnam $liveplot(hst) $liveplot(legend) &
+}
+
+# run lstview
 proc lstview {} {
     global expgui wishshell
@@ -279 +221 @@
 }
 
+# run widplt
 proc widplt {} {
     global expgui wishshell
-    set expnam [file root [file tail $expgui(expfile)]]
-    exec $wishshell [file join $expgui(scriptdir) widplt] $expgui(gsasexe) $expnam  &
-}
-
-
+    exec $wishshell [file join $expgui(scriptdir) widplt] \
+            $expgui(expfile) &
+}
+
+# show help information
 proc showhelp {} {
     global expgui_helplist helpmsg
@@ -322 +265 @@
 }
 
+# convert a file
 proc convfile {} {
     global tcl_platform
@@ -523 +467 @@
 }
 
-# validate the files and make the conversion
-proc valid_new_exp_file {} {
-    global infile 
-    if {$infile(name) == ""} return
-    set infile(name) [file root [string toupper $infile(name)]].EXP
-    if [file exists [file join $infile(dir) $infile(name)]] {
-        tk_dialog .warn Notify \
-                "Sorry, file $infile(name) found in $infile(dir)" warning 0 OK
-        return
-    }
-    set infile(done) 1
-}
-
-# create a file box
-proc expfilebox {bx filvar diropt} {
-    global ${filvar}
-    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
-    scrollbar $bx.a.scroll -command "$bx.a.files yview"
-    filchoose $bx $bx.a.files $filvar $diropt
-    bind $bx.a.files <ButtonRelease-1> \
-            "filchoose $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
-}
-
 # create a file box for conversions
 proc cnvfilebox {bx filvar diropt} {
@@ -577 +491 @@
 # select a file or directory, also called when box is created to fill it
 proc filchoose {frm box filvar {dironly 1}} {
-    global expnam $filvar
+    global $filvar
     set select [$box curselection]
     if {$select == ""} {
@@ -609 +523 @@
 }
 
-# set new file name from old
+# set new file name from old -- used for convert
 proc setoutfile {} {
     global infile outfile
@@ -626 +540 @@
 }
 
+# set options for liveplot
 proc liveplotopt {} {
     global liveplot
@@ -669 +584 @@
     }
 }
+
+#------------------------------------------------------------------------------
+# get an experiment file name
+#------------------------------------------------------------------------------
+proc getExpFileName {mode} {
+    global expgui
+    set frm .file
+    catch {destroy $frm}
+    toplevel $frm
+    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
+    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
+    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
+    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
+            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
+    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
+            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
+    pack [button $frmC.b -text Open \
+            -command "valid_exp_file $frmA $mode"] -side top
+    pack [button $frmC.q -text Quit \
+            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top
+    bind $frm <Return> "$frmC.b invoke"
+
+    pack [label $frmA.0 -text "Enter an experiment file"] -side top -anchor center
+    expfilebox $frmA $mode
+    # force the window to stay on top
+    wm transient $frm [winfo toplevel [winfo parent $frm]]
+
+    wm withdraw $frm
+    update idletasks
+    # center the new window in the middle of the parent
+    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
+            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
+    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
+            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
+    wm geom $frm +$x+$y
+    wm deiconify $frm
+
+    set oldFocus [focus]
+    set oldGrab [grab current $frm]
+    if {$oldGrab != ""} {
+        set grabStatus [grab status $oldGrab]
+    }
+    grab $frm
+    focus $frmC.b
+    tkwait window $frm
+    catch {focus $oldFocus}
+    if {$oldGrab != ""} {
+        if {$grabStatus == "global"} {
+            grab -global $oldGrab
+        } else {
+            grab $oldGrab
+        }
+    }
+    if {$expgui(FileMenuEXPNAM) == ""} return
+    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
+}
+
+# validation routine
+proc valid_exp_file {frm mode} {
+    global expgui
+    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
+        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
+        ChooseExpFil $frm
+        return
+    } elseif [file isdirectory \
+            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
+        if {$expgui(FileMenuEXPNAM) != "."} {
+            set expgui(FileMenuDir) \
+                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
+        }
+        ChooseExpFil $frm
+        return
+    }
+    set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
+    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
+        append expgui(FileMenuEXPNAM) ".EXP"
+    }
+    if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} {
+        tk_dialog .expFileErrorMsg "File Open Error" \
+            "File $expgui(FileMenuEXPNAM) is not a valid name. Experiment files must end in \".EXP\"" \
+            error 0 OK
+        return
+    }
+    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
+    if {$mode == "new" && [file exists $file]} {
+        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
+            "File $file already exists. OK to overwrite?" question 0 \
+             "Select other name" "Overwrite"]
+        if $ans {destroy .file}
+        return
+    }
+    if {$mode == "old" && ![file exists $file]} {
+        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
+            "File $file does not exist. OK to create?" question 0 \
+             "Select other name" "Create"]
+        if $ans {destroy .file}
+        return
+    }
+    destroy .file
+}
+
+proc updir {} {
+    global expgui
+    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
+}
+
+# create a file box
+proc expfilebox {bx mode} {
+    global expgui
+    pack [frame $bx.top] -side top 
+    pack [label $bx.top.a -text "Directory" ] -side left 
+    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
+    pack $bx.top.d -side left
+    set expgui(FileMenuDir) [pwd]
+    # the icon below is from tk8.0/tkfbox.tcl
+    set upfolder [image create bitmap -data {
+#define updir_width 28
+#define updir_height 16
+static char updir_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
+   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
+   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
+   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
+   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
+   0xf0, 0xff, 0xff, 0x01};}]
+
+    pack [button $bx.top.b -image $upfolder \
+            -command "updir; ChooseExpFil $bx" ]
+    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
+    listbox $bx.a.files -relief raised -bd 2 \
+            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
+            -height 15 -width 0
+    listbox $bx.a.dates -relief raised -bd 2 \
+            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
+            -height 15 -width 0 -takefocus 0
+    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
+    ChooseExpFil $bx
+    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
+    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
+    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
+    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
+    pack $bx.a.scroll -side left -fill y 
+    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
+    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
+}
+proc sync2boxes {master slave scroll args} {
+    $slave yview moveto [lindex [$master yview] 0]
+    eval $scroll set $args
+}
+proc move2boxesY {boxlist args} {
+    foreach listbox $boxlist { 
+        eval $listbox yview $args
+    }
+}
+
+# set the box or file in the selection window
+proc ReleaseExpFil {frm} {
+    global expgui
+    set files $frm.a.files
+    set dates $frm.a.dates
+    set select [$files curselection]
+    if {$select == ""} {
+        set select [$dates curselection]
+    }
+    if {$select == ""} {
+        set expgui(FileMenuEXPNAM) ""
+    } else {
+        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
+    }
+    return
+}
+
+# select a file or directory -- called on double click
+proc SelectExpFil {frm mode} {
+    global expgui
+    set files $frm.a.files
+    set dates $frm.a.dates
+    set select [$files curselection]
+    if {$select == ""} {
+        set select [$dates curselection]
+    }
+    if {$select == ""} {
+        set file .
+    } else {
+        set file [string trim [$files get $select]]
+    }
+    if {$file == "<Parent>"} {
+        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
+        ChooseExpFil $frm
+    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
+        if {$file != "."} {
+            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
+            ChooseExpFil $frm
+        }
+    } else {
+        set expgui(FileMenuEXPNAM) [file tail $file]
+        valid_exp_file $frm $mode
+    }
+}
+
+# fill the files & dates & Directory selection box with current directory,
+# also called when box is created to fill it
+proc ChooseExpFil {frm} {
+    global expgui
+    set files $frm.a.files
+    set dates $frm.a.dates
+    set expgui(FileMenuEXPNAM) {}
+    $files delete 0 end
+    $dates delete 0 end
+    $files insert end {<Parent>}
+    $dates insert end {(Directory)}
+    set filelist [glob -nocomplain \
+            [file join [set expgui(FileMenuDir)] *] ]
+    foreach file [lsort $filelist] {
+        if {[file isdirectory $file]} {
+            $files insert end [file tail $file]
+            $dates insert end {(Directory)}
+        }
+    }
+    set pairlist {}
+    foreach file [lsort $filelist] {
+        if {![file isdirectory $file]  && \
+                [file extension $file] == ".EXP"} {
+            set modified [file mtime $file]
+            lappend pairlist "$file $modified"
+        }
+    }
+    if {$expgui(filesort) == 0} {
+        foreach pair [lsort -index 1 -integer $pairlist] {
+            set file [lindex $pair 0]
+            set modified [clock format [lindex $pair 1] -format "%T %D"]
+            $files insert end [file tail $file]
+            $dates insert end $modified
+        }
+    } else {
+        foreach pair [lsort -index 0 $pairlist] {
+            set file [lindex $pair 0]
+            set modified [clock format [lindex $pair 1] -format "%T %D"]
+            $files insert end [file tail $file]
+            $dates insert end $modified
+        }
+    }
+    $expgui(FileDirButtonMenu)  delete 0 end
+    set list ""
+    set dir ""
+    foreach subdir [file split [set expgui(FileMenuDir)]] {
+        set dir [file join $dir $subdir]
+        lappend list $dir
+    }
+    foreach path $list {
+        $expgui(FileDirButtonMenu) add command -label $path \
+                -command "[list set expgui(FileMenuDir) $path]; \
+                ChooseExpFil $frm"
+    }
+    # highlight the current experiment -- if present
+    for {set i 0} {$i < [$files size]} {incr i} {
+        set file [$files get $i]
+        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
+            $files selection set $i
+        }
+    }
+    return
+}
+