| 1 | # should do some work here on convert to make the file dialog much more |
|---|
| 2 | # like that in getExpFileName (propogate to tkGSAS as well?) |
|---|
| 3 | |
|---|
| 4 | # platform-specific code |
|---|
| 5 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 6 | if [catch {package require winexec}] { |
|---|
| 7 | tk_dialog .err "WINEXEC Error" \ |
|---|
| 8 | "Error -- Unable to load the WINEXEC package. This is needed in Win95 machines" \ |
|---|
| 9 | error 0 Quit |
|---|
| 10 | destroy . |
|---|
| 11 | } |
|---|
| 12 | if {$tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } { |
|---|
| 13 | # this creates a DOS box to run a program in |
|---|
| 14 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
|---|
| 15 | global env expgui |
|---|
| 16 | # Windows environment variables |
|---|
| 17 | # -95 does not seem to be able to use these |
|---|
| 18 | set env(GSAS) [file nativename $expgui(gsasdir)] |
|---|
| 19 | # PGPLOT_FONT is needed by PGPLOT |
|---|
| 20 | set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]] |
|---|
| 21 | # this is the number of lines/page in the .LST (etc.) file |
|---|
| 22 | set env(LENPAGE) 60 |
|---|
| 23 | set pwd [file nativename [pwd]] |
|---|
| 24 | |
|---|
| 25 | # check the path -- can DOS use it? |
|---|
| 26 | if {[string first // [pwd]] != -1} { |
|---|
| 27 | tk_dialog .braindead "Invalid Path" \ |
|---|
| 28 | {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) \ |
|---|
| 29 | Win-95 can't directly access a network drive in DOS} error 0 OK |
|---|
| 30 | return |
|---|
| 31 | } |
|---|
| 32 | # all winexec commands are background commands |
|---|
| 33 | # if $background |
|---|
| 34 | |
|---|
| 35 | # pause is hard coded in the .BAT file |
|---|
| 36 | #if $wait { |
|---|
| 37 | # append command " pause" |
|---|
| 38 | #} |
|---|
| 39 | |
|---|
| 40 | # replace the forward slashes with backward |
|---|
| 41 | regsub -all / $command \\ command |
|---|
| 42 | # Win95 does not seem to inherit the environment from Tcl env vars |
|---|
| 43 | # so define it in the .BAT file |
|---|
| 44 | winexec -d [file nativename [pwd]] \ |
|---|
| 45 | [file join $expgui(scriptdir) gsastcl.bat] \ |
|---|
| 46 | "[file nativename $expgui(gsasdir)] $command" |
|---|
| 47 | } |
|---|
| 48 | } else { |
|---|
| 49 | # now for - brain-dead Windows-NT |
|---|
| 50 | # this creates a DOS box to run a program in |
|---|
| 51 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
|---|
| 52 | global env expgui |
|---|
| 53 | # Windows environment variables |
|---|
| 54 | # -95 does not seem to be able to use these |
|---|
| 55 | set env(GSAS) [file nativename $expgui(gsasdir)] |
|---|
| 56 | # PGPLOT_FONT is needed by PGPLOT |
|---|
| 57 | set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]] |
|---|
| 58 | # this is the number of lines/page in the .LST (etc.) file |
|---|
| 59 | set env(LENPAGE) 60 |
|---|
| 60 | # all winexec commands are background commands -- ignore background arg |
|---|
| 61 | |
|---|
| 62 | # can't get pause to work! -- ignore wait |
|---|
| 63 | |
|---|
| 64 | set prevcmd {} |
|---|
| 65 | foreach cmd $command { |
|---|
| 66 | if {$prevcmd != ""} { |
|---|
| 67 | tk_dialog .done_yet Confirm "Press OK to start command $cmd" "" 0 OK |
|---|
| 68 | } |
|---|
| 69 | # replace the forward slashes with backward |
|---|
| 70 | regsub -all / $cmd \\ cmd |
|---|
| 71 | # cmd.exe must be in the path -- lets hope that at least works! |
|---|
| 72 | winexec -d [file nativename [pwd]] cmd.exe "/c $cmd" |
|---|
| 73 | set prevcmd $cmd |
|---|
| 74 | } |
|---|
| 75 | } |
|---|
| 76 | } |
|---|
| 77 | } else { |
|---|
| 78 | if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1} |
|---|
| 79 | |
|---|
| 80 | # this creates a xterm window to run a program in |
|---|
| 81 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
|---|
| 82 | global env expgui |
|---|
| 83 | # UNIX environment variables |
|---|
| 84 | set env(GSASEXE) $expgui(gsasexe) |
|---|
| 85 | set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat] |
|---|
| 86 | set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat] |
|---|
| 87 | # PGPLOT_DIR is needed by PGPLOT |
|---|
| 88 | set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl] |
|---|
| 89 | # this is the number of lines/page in the .LST (etc.) file |
|---|
| 90 | set env(LENPAGE) 60 |
|---|
| 91 | set termopts {} |
|---|
| 92 | if $env(GSASBACKSPACE) { |
|---|
| 93 | append termopts \ |
|---|
| 94 | {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"} |
|---|
| 95 | } |
|---|
| 96 | if $scrollbar { |
|---|
| 97 | append termopts " -sb" |
|---|
| 98 | } else { |
|---|
| 99 | append termopts " +sb" |
|---|
| 100 | } |
|---|
| 101 | if $background { |
|---|
| 102 | set suffix {&} |
|---|
| 103 | } else { |
|---|
| 104 | set suffix {} |
|---|
| 105 | } |
|---|
| 106 | # |
|---|
| 107 | if $wait { |
|---|
| 108 | append command "\; echo -n Press Enter to continue \; read x" |
|---|
| 109 | } |
|---|
| 110 | if !$background {wm iconify .} |
|---|
| 111 | catch {eval exec xterm $termopts -title [list $title] \ |
|---|
| 112 | -e /bin/sh -c [list $command] $suffix} errmsg |
|---|
| 113 | if $expgui(debug) {puts "xterm result = $errmsg"} |
|---|
| 114 | if !$background {wm deiconify .} |
|---|
| 115 | } |
|---|
| 116 | } |
|---|
| 117 | |
|---|
| 118 | # get a value in a modal toplevel |
|---|
| 119 | proc getstring {what "chars 40" "quit 1" "initvalue {}"} { |
|---|
| 120 | global expgui expmap |
|---|
| 121 | set w .global |
|---|
| 122 | catch {destroy $w} |
|---|
| 123 | toplevel $w -bg beige |
|---|
| 124 | wm title $w "Input $what" |
|---|
| 125 | set expgui(temp) {} |
|---|
| 126 | pack [frame $w.0 -bd 6 -relief groove -bg beige] \ |
|---|
| 127 | -side top -expand yes -fill both |
|---|
| 128 | grid [label $w.0.a -text "Input a value for the $what" \ |
|---|
| 129 | -bg beige] \ |
|---|
| 130 | -row 0 -column 0 -columnspan 10 |
|---|
| 131 | grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \ |
|---|
| 132 | -row 1 -column 0 |
|---|
| 133 | |
|---|
| 134 | set expgui(temp) $initvalue |
|---|
| 135 | pack [frame $w.b] -side top |
|---|
| 136 | pack [button $w.b.2 -text Set -command "destroy $w"] -side left |
|---|
| 137 | if $quit { |
|---|
| 138 | pack [button $w.b.3 -text Quit \ |
|---|
| 139 | -command "set expgui(temp) {}; destroy $w"] -side left |
|---|
| 140 | } |
|---|
| 141 | # force the window to stay on top |
|---|
| 142 | wm transient $w [winfo toplevel [winfo parent $w]] |
|---|
| 143 | |
|---|
| 144 | bind $w <Return> "destroy $w" |
|---|
| 145 | wm withdraw $w |
|---|
| 146 | update idletasks |
|---|
| 147 | # center the new window in the middle of the parent |
|---|
| 148 | set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \ |
|---|
| 149 | [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]] |
|---|
| 150 | set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \ |
|---|
| 151 | [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]] |
|---|
| 152 | wm geom $w +$x+$y |
|---|
| 153 | wm deiconify $w |
|---|
| 154 | |
|---|
| 155 | set oldFocus [focus] |
|---|
| 156 | set oldGrab [grab current $w] |
|---|
| 157 | if {$oldGrab != ""} { |
|---|
| 158 | set grabStatus [grab status $oldGrab] |
|---|
| 159 | } |
|---|
| 160 | grab $w |
|---|
| 161 | focus $w.b.2 |
|---|
| 162 | tkwait window $w |
|---|
| 163 | catch {focus $oldFocus} |
|---|
| 164 | if {$oldGrab != ""} { |
|---|
| 165 | if {$grabStatus == "global"} { |
|---|
| 166 | grab -global $oldGrab |
|---|
| 167 | } else { |
|---|
| 168 | grab $oldGrab |
|---|
| 169 | } |
|---|
| 170 | } |
|---|
| 171 | return $expgui(temp) |
|---|
| 172 | } |
|---|
| 173 | |
|---|
| 174 | # run a GSAS program that does not require an experiment file |
|---|
| 175 | proc runGSASprog {proglist} { |
|---|
| 176 | global expgui tcl_platform |
|---|
| 177 | set cmd {} |
|---|
| 178 | foreach prog $proglist { |
|---|
| 179 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 180 | append cmd " \"$expgui(gsasexe)/${prog}.exe \" " |
|---|
| 181 | } else { |
|---|
| 182 | if {$cmd != ""} {append cmd "\;"} |
|---|
| 183 | append cmd "[file join $expgui(gsasexe) $prog]" |
|---|
| 184 | } |
|---|
| 185 | } |
|---|
| 186 | forknewterm $prog $cmd 0 1 1 |
|---|
| 187 | } |
|---|
| 188 | |
|---|
| 189 | # run a GSAS program that requires an experiment file for input/output |
|---|
| 190 | proc runGSASwEXP {proglist} { |
|---|
| 191 | global expgui tcl_platform |
|---|
| 192 | # Save the current exp file |
|---|
| 193 | savearchiveexp |
|---|
| 194 | set cmd {} |
|---|
| 195 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 196 | foreach prog $proglist { |
|---|
| 197 | if {$prog == "expedt" && $expgui(archive)} archiveexp |
|---|
| 198 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 199 | append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" " |
|---|
| 200 | } else { |
|---|
| 201 | if {$cmd != ""} {append cmd "\;"} |
|---|
| 202 | append cmd "[file join $expgui(gsasexe) $prog] $expnam" |
|---|
| 203 | } |
|---|
| 204 | } |
|---|
| 205 | forknewterm "$prog -- $expnam" $cmd 0 1 1 |
|---|
| 206 | wm deiconify . |
|---|
| 207 | } |
|---|
| 208 | |
|---|
| 209 | # run liveplot |
|---|
| 210 | proc liveplot {} { |
|---|
| 211 | global expgui liveplot wishshell |
|---|
| 212 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 213 | exec $wishshell [file join $expgui(scriptdir) liveplot] \ |
|---|
| 214 | $expnam $liveplot(hst) $liveplot(legend) & |
|---|
| 215 | } |
|---|
| 216 | |
|---|
| 217 | # run lstview |
|---|
| 218 | proc lstview {} { |
|---|
| 219 | global expgui wishshell |
|---|
| 220 | set expnam [file root [file tail $expgui(expfile)]] |
|---|
| 221 | exec $wishshell [file join $expgui(scriptdir) lstview] $expnam & |
|---|
| 222 | } |
|---|
| 223 | |
|---|
| 224 | # run widplt |
|---|
| 225 | proc widplt {} { |
|---|
| 226 | global expgui wishshell |
|---|
| 227 | exec $wishshell [file join $expgui(scriptdir) widplt] \ |
|---|
| 228 | $expgui(expfile) & |
|---|
| 229 | } |
|---|
| 230 | |
|---|
| 231 | # show help information |
|---|
| 232 | proc showhelp {} { |
|---|
| 233 | global expgui_helplist helpmsg |
|---|
| 234 | set helpmsg {} |
|---|
| 235 | set frm .help |
|---|
| 236 | catch {destroy $frm} |
|---|
| 237 | toplevel $frm |
|---|
| 238 | wm title $frm "Command Help" |
|---|
| 239 | pack [message $frm.0 -text \ |
|---|
| 240 | "Click on an entry below to see help on a GSAS command" ] \ |
|---|
| 241 | -side top |
|---|
| 242 | pack [frame $frm.a -width 20 -height 15] \ |
|---|
| 243 | -side top -expand yes -fill both |
|---|
| 244 | pack [message $frm.help -textvariable helpmsg -relief groove] \ |
|---|
| 245 | -side left -fill both -expand yes |
|---|
| 246 | set lst [array names expgui_helplist] |
|---|
| 247 | listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \ |
|---|
| 248 | "$frm.a.scroll set" -height 15 -width 0 |
|---|
| 249 | scrollbar $frm.a.scroll -command "$frm.a.cmds yview" |
|---|
| 250 | foreach item [lsort $lst] { |
|---|
| 251 | $frm.a.cmds insert end $item |
|---|
| 252 | } |
|---|
| 253 | if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0} |
|---|
| 254 | button $frm.a.done -text Done -command "destroy $frm" |
|---|
| 255 | bind $frm.a.cmds <ButtonRelease-1> \ |
|---|
| 256 | "+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])" |
|---|
| 257 | pack $frm.a.scroll -side left -fill y |
|---|
| 258 | pack $frm.a.cmds -side left -expand yes -anchor w |
|---|
| 259 | pack $frm.a.done -side right -expand no |
|---|
| 260 | # get the size of the window and expand the message boxes to match |
|---|
| 261 | update |
|---|
| 262 | set width [lindex [split [wm geometry $frm] x+] 0] |
|---|
| 263 | $frm.0 config -width $width |
|---|
| 264 | $frm.help config -width $width |
|---|
| 265 | # waitdone $frm |
|---|
| 266 | } |
|---|
| 267 | |
|---|
| 268 | # convert a file |
|---|
| 269 | proc convfile {} { |
|---|
| 270 | global tcl_platform |
|---|
| 271 | if {$tcl_platform(platform) == "windows"} { |
|---|
| 272 | convwin |
|---|
| 273 | } else { |
|---|
| 274 | convunix |
|---|
| 275 | } |
|---|
| 276 | } |
|---|
| 277 | |
|---|
| 278 | # file conversions for UNIX (convstod convdtos) |
|---|
| 279 | proc convunix {} { |
|---|
| 280 | global expgui infile outfile |
|---|
| 281 | set frm .file |
|---|
| 282 | catch {destroy $frm} |
|---|
| 283 | toplevel $frm |
|---|
| 284 | wm title $frm "Convert File" |
|---|
| 285 | pack [frame [set frm0 $frm.0] -bd 2 -relief groove] -padx 3 -pady 3 -side top |
|---|
| 286 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 287 | pack [frame [set frmB $frm.2] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 288 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
|---|
| 289 | pack [button $frmC.b -text Convert -command "valid_conv_file"] -side top |
|---|
| 290 | pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top |
|---|
| 291 | |
|---|
| 292 | pack [label $frmA.0 -text "Select an input file"] -side top -anchor center |
|---|
| 293 | pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center |
|---|
| 294 | |
|---|
| 295 | pack [label $frm0.1 -text "Convert to:"] -side top -anchor w |
|---|
| 296 | pack [radiobutton $frm0.2 -text "direct access" -value convstod \ |
|---|
| 297 | -command setoutfile \ |
|---|
| 298 | -variable outfile(type)] -side top -anchor w |
|---|
| 299 | pack [radiobutton $frm0.3 -text "sequential" -value convdtos \ |
|---|
| 300 | -command setoutfile \ |
|---|
| 301 | -variable outfile(type)] -side top -anchor w |
|---|
| 302 | set outfile(type) "" |
|---|
| 303 | cnvfilebox $frmA infile 1 |
|---|
| 304 | cnvfilebox $frmB outfile 0 |
|---|
| 305 | set infile(done) 0 |
|---|
| 306 | # force the window to stay on top |
|---|
| 307 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 308 | |
|---|
| 309 | bind $frm <Return> "valid_conv_file" |
|---|
| 310 | wm withdraw $frm |
|---|
| 311 | update idletasks |
|---|
| 312 | # center the new window in the middle of the parent |
|---|
| 313 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 314 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 315 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 316 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 317 | wm geom $frm +$x+$y |
|---|
| 318 | wm deiconify $frm |
|---|
| 319 | |
|---|
| 320 | set oldFocus [focus] |
|---|
| 321 | set oldGrab [grab current $frm] |
|---|
| 322 | if {$oldGrab != ""} { |
|---|
| 323 | set grabStatus [grab status $oldGrab] |
|---|
| 324 | } |
|---|
| 325 | grab $frm |
|---|
| 326 | focus $frmC.q |
|---|
| 327 | update |
|---|
| 328 | tkwait variable infile(done) |
|---|
| 329 | catch {focus $oldFocus} |
|---|
| 330 | if {$oldGrab != ""} { |
|---|
| 331 | if {$grabStatus == "global"} { |
|---|
| 332 | grab -global $oldGrab |
|---|
| 333 | } else { |
|---|
| 334 | grab $oldGrab |
|---|
| 335 | } |
|---|
| 336 | } |
|---|
| 337 | destroy $frm |
|---|
| 338 | } |
|---|
| 339 | |
|---|
| 340 | # validate the files and make the conversion |
|---|
| 341 | proc valid_conv_file {} { |
|---|
| 342 | global infile outfile expgui |
|---|
| 343 | if {$outfile(type) == "convstod" || $outfile(type) == "convdtos"} { |
|---|
| 344 | set convtype $outfile(type) |
|---|
| 345 | } else { |
|---|
| 346 | return |
|---|
| 347 | } |
|---|
| 348 | if {$infile(name) == ""} return |
|---|
| 349 | if {$outfile(name) == ""} return |
|---|
| 350 | if {$infile(name) == $outfile(name)} { |
|---|
| 351 | tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK |
|---|
| 352 | return |
|---|
| 353 | } |
|---|
| 354 | if ![file exists [file join $infile(dir) $infile(name)]] { |
|---|
| 355 | tk_dialog .warn Notify \ |
|---|
| 356 | "Sorry, file $infile(name) not found in $infile(dir)" warning 0 OK |
|---|
| 357 | return |
|---|
| 358 | } |
|---|
| 359 | if [file exists [file join $outfile(dir) $outfile(name)]] { |
|---|
| 360 | if [tk_dialog .warn Notify \ |
|---|
| 361 | "Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \ |
|---|
| 362 | warning 0 OK No] return |
|---|
| 363 | } |
|---|
| 364 | if [catch { |
|---|
| 365 | exec [file join $expgui(gsasexe) $convtype] < \ |
|---|
| 366 | [file join $infile(dir) $infile(name)] > \ |
|---|
| 367 | [file join $outfile(dir) $outfile(name)] |
|---|
| 368 | } errmsg] { |
|---|
| 369 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
|---|
| 370 | } else { |
|---|
| 371 | if [tk_dialog .converted Notify \ |
|---|
| 372 | "File converted. Convert more files?" \ |
|---|
| 373 | "" 0 Yes No] {set infile(done) 1} |
|---|
| 374 | } |
|---|
| 375 | } |
|---|
| 376 | |
|---|
| 377 | # file conversions for Windows |
|---|
| 378 | proc convwin {} { |
|---|
| 379 | global expgui infile outfile |
|---|
| 380 | set frm .file |
|---|
| 381 | catch {destroy $frm} |
|---|
| 382 | toplevel $frm |
|---|
| 383 | wm title $frm "Convert File" |
|---|
| 384 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 385 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
|---|
| 386 | pack [button $frmC.b -text Convert -command "valid_conv_win"] -side top |
|---|
| 387 | pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top |
|---|
| 388 | pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center |
|---|
| 389 | cnvfilebox $frmA outfile 1 |
|---|
| 390 | set infile(done) 0 |
|---|
| 391 | # force the window to stay on top |
|---|
| 392 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 393 | |
|---|
| 394 | bind $frm <Return> "valid_conv_file" |
|---|
| 395 | wm withdraw $frm |
|---|
| 396 | update idletasks |
|---|
| 397 | # center the new window in the middle of the parent |
|---|
| 398 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 399 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 400 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 401 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 402 | wm geom $frm +$x+$y |
|---|
| 403 | wm deiconify $frm |
|---|
| 404 | |
|---|
| 405 | set oldFocus [focus] |
|---|
| 406 | set oldGrab [grab current $frm] |
|---|
| 407 | if {$oldGrab != ""} { |
|---|
| 408 | set grabStatus [grab status $oldGrab] |
|---|
| 409 | } |
|---|
| 410 | grab $frm |
|---|
| 411 | focus $frmC.q |
|---|
| 412 | update |
|---|
| 413 | tkwait variable infile(done) |
|---|
| 414 | if {$oldGrab != ""} { |
|---|
| 415 | if {$grabStatus == "global"} { |
|---|
| 416 | grab -global $oldGrab |
|---|
| 417 | } else { |
|---|
| 418 | grab $oldGrab |
|---|
| 419 | } |
|---|
| 420 | } |
|---|
| 421 | destroy $frm |
|---|
| 422 | } |
|---|
| 423 | |
|---|
| 424 | # validate the files and make the conversion |
|---|
| 425 | proc valid_conv_win {} { |
|---|
| 426 | global infile outfile expgui |
|---|
| 427 | if {$outfile(name) == ""} return |
|---|
| 428 | if ![file exists $outfile(dir)/$outfile(name)] { |
|---|
| 429 | tk_dialog .warn Notify \ |
|---|
| 430 | "Sorry, file $outfile(name) not found in $outfile(dir)" warning 0 OK |
|---|
| 431 | return |
|---|
| 432 | } |
|---|
| 433 | if [catch { |
|---|
| 434 | set newname "[file rootname $outfile(name)].tmp" |
|---|
| 435 | set oldname "[file rootname $outfile(name)].seq" |
|---|
| 436 | set in [open $outfile(dir)/$outfile(name) r] |
|---|
| 437 | set out [open $outfile(dir)/$newname w] |
|---|
| 438 | set len [gets $in line] |
|---|
| 439 | if {$len > 160} { |
|---|
| 440 | # this is a UNIX file. Hope there are no control characters |
|---|
| 441 | set i 0 |
|---|
| 442 | set j 79 |
|---|
| 443 | while {$j < $len} { |
|---|
| 444 | puts $out [string range $line $i $j] |
|---|
| 445 | incr i 80 |
|---|
| 446 | incr j 80 |
|---|
| 447 | } |
|---|
| 448 | } else { |
|---|
| 449 | while {$len >= 0} { |
|---|
| 450 | append line " " |
|---|
| 451 | append line " " |
|---|
| 452 | set line [string range $line 0 79] |
|---|
| 453 | puts $out $line |
|---|
| 454 | set len [gets $in line] |
|---|
| 455 | } |
|---|
| 456 | } |
|---|
| 457 | close $in |
|---|
| 458 | close $out |
|---|
| 459 | file rename $outfile(dir)/$outfile(name) $oldname |
|---|
| 460 | file rename $newname $outfile(dir)/$outfile(name) |
|---|
| 461 | } errmsg] { |
|---|
| 462 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
|---|
| 463 | } else { |
|---|
| 464 | if [tk_dialog .converted Notify \ |
|---|
| 465 | "File converted. Convert more files?" \ |
|---|
| 466 | "" 0 Yes No] {set infile(done) 1} |
|---|
| 467 | } |
|---|
| 468 | } |
|---|
| 469 | |
|---|
| 470 | # create a file box for conversions |
|---|
| 471 | proc cnvfilebox {bx filvar diropt} { |
|---|
| 472 | global ${filvar} |
|---|
| 473 | pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top |
|---|
| 474 | set ${filvar}(dir) [pwd] |
|---|
| 475 | pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both |
|---|
| 476 | listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \ |
|---|
| 477 | -height 15 -width 0 |
|---|
| 478 | scrollbar $bx.a.scroll -command "$bx.a.files yview" |
|---|
| 479 | filchoose $bx $bx.a.files $filvar $diropt |
|---|
| 480 | if {$filvar == "infile"} { |
|---|
| 481 | bind $bx.a.files <ButtonRelease-1> \ |
|---|
| 482 | "filchoose $bx $bx.a.files $filvar $diropt; setoutfile" |
|---|
| 483 | } else { |
|---|
| 484 | bind $bx.a.files <ButtonRelease-1> \ |
|---|
| 485 | "filchoose $bx $bx.a.files $filvar $diropt" |
|---|
| 486 | } |
|---|
| 487 | pack $bx.a.scroll -side left -fill y |
|---|
| 488 | pack $bx.a.files -side left -fill both -expand yes |
|---|
| 489 | pack [entry $bx.c -textvariable ${filvar}(name)] -side top |
|---|
| 490 | } |
|---|
| 491 | |
|---|
| 492 | # select a file or directory, also called when box is created to fill it |
|---|
| 493 | proc filchoose {frm box filvar {dironly 1}} { |
|---|
| 494 | global $filvar |
|---|
| 495 | set select [$box curselection] |
|---|
| 496 | if {$select == ""} { |
|---|
| 497 | set file . |
|---|
| 498 | } else { |
|---|
| 499 | set file [string trim [$box get $select]] |
|---|
| 500 | } |
|---|
| 501 | if [file isdirectory [file join [set ${filvar}(dir)] $file]] { |
|---|
| 502 | if {$file == ".."} { |
|---|
| 503 | set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ] |
|---|
| 504 | } elseif {$file != "."} { |
|---|
| 505 | set ${filvar}(dir) [file join [set ${filvar}(dir)] $file] |
|---|
| 506 | } |
|---|
| 507 | set ${filvar}(name) {} |
|---|
| 508 | $box delete 0 end |
|---|
| 509 | $box insert end {.. } |
|---|
| 510 | foreach file [lsort [glob -nocomplain \ |
|---|
| 511 | [file join [set ${filvar}(dir)] *] ] ] { |
|---|
| 512 | if {[file isdirectory $file]} { |
|---|
| 513 | # is this / needed here? Does it cause a problem in MacGSAS? |
|---|
| 514 | $box insert end [file tail $file]/ |
|---|
| 515 | } elseif {$dironly == 1} { |
|---|
| 516 | $box insert end [file tail $file] |
|---|
| 517 | } elseif {$dironly == 2 && [file extension $file] == ".EXP"} { |
|---|
| 518 | $box insert end [file tail $file] |
|---|
| 519 | } |
|---|
| 520 | } |
|---|
| 521 | return |
|---|
| 522 | } |
|---|
| 523 | set ${filvar}(name) [file tail $file] |
|---|
| 524 | } |
|---|
| 525 | |
|---|
| 526 | # set new file name from old -- used for convert |
|---|
| 527 | proc setoutfile {} { |
|---|
| 528 | global infile outfile |
|---|
| 529 | if {$outfile(type) == "convstod"} { |
|---|
| 530 | set lfile [string toupper $infile(name)] |
|---|
| 531 | } elseif {$outfile(type) == "convdtos"} { |
|---|
| 532 | set lfile [string tolower $infile(name)] |
|---|
| 533 | } else { |
|---|
| 534 | set lfile "" |
|---|
| 535 | } |
|---|
| 536 | if {$infile(name) == $lfile} { |
|---|
| 537 | set outfile(name) {} |
|---|
| 538 | } else { |
|---|
| 539 | set outfile(name) $lfile |
|---|
| 540 | } |
|---|
| 541 | } |
|---|
| 542 | |
|---|
| 543 | # set options for liveplot |
|---|
| 544 | proc liveplotopt {} { |
|---|
| 545 | global liveplot |
|---|
| 546 | set frm .file |
|---|
| 547 | catch {destroy $frm} |
|---|
| 548 | toplevel $frm |
|---|
| 549 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 550 | pack [scale $frmA.1 -label "Histogram number" -from 1 -to 9 \ |
|---|
| 551 | -length 150 -orient horizontal -variable liveplot(hst)] -side top |
|---|
| 552 | pack [checkbutton $frmA.2 -text {include plot legend}\ |
|---|
| 553 | -variable liveplot(legend)] -side top |
|---|
| 554 | pack [button $frm.2 -text OK \ |
|---|
| 555 | -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \ |
|---|
| 556 | ] -side top |
|---|
| 557 | bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"} |
|---|
| 558 | # force the window to stay on top |
|---|
| 559 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 560 | wm withdraw $frm |
|---|
| 561 | update idletasks |
|---|
| 562 | # center the new window in the middle of the parent |
|---|
| 563 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 564 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 565 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 566 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 567 | wm geom $frm +$x+$y |
|---|
| 568 | wm deiconify $frm |
|---|
| 569 | |
|---|
| 570 | set oldFocus [focus] |
|---|
| 571 | set oldGrab [grab current $frm] |
|---|
| 572 | if {$oldGrab != ""} { |
|---|
| 573 | set grabStatus [grab status $oldGrab] |
|---|
| 574 | } |
|---|
| 575 | grab $frm |
|---|
| 576 | focus $frm.2 |
|---|
| 577 | tkwait window $frm |
|---|
| 578 | catch {focus $oldFocus} |
|---|
| 579 | if {$oldGrab != ""} { |
|---|
| 580 | if {$grabStatus == "global"} { |
|---|
| 581 | grab -global $oldGrab |
|---|
| 582 | } else { |
|---|
| 583 | grab $oldGrab |
|---|
| 584 | } |
|---|
| 585 | } |
|---|
| 586 | } |
|---|
| 587 | |
|---|
| 588 | #------------------------------------------------------------------------------ |
|---|
| 589 | # get an experiment file name |
|---|
| 590 | #------------------------------------------------------------------------------ |
|---|
| 591 | proc getExpFileName {mode} { |
|---|
| 592 | global expgui |
|---|
| 593 | set frm .file |
|---|
| 594 | catch {destroy $frm} |
|---|
| 595 | toplevel $frm |
|---|
| 596 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
|---|
| 597 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
|---|
| 598 | pack [label $frmC.2 -text "Sort .EXP files by" ] -side top |
|---|
| 599 | pack [radiobutton $frmC.1 -text "File Name" -value 1 \ |
|---|
| 600 | -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top |
|---|
| 601 | pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \ |
|---|
| 602 | -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top |
|---|
| 603 | pack [button $frmC.b -text Read \ |
|---|
| 604 | -command "valid_exp_file $frmA $mode"] -side top |
|---|
| 605 | if {$mode == "new"} { |
|---|
| 606 | $frmC.b config -text Save |
|---|
| 607 | } |
|---|
| 608 | pack [button $frmC.q -text Quit \ |
|---|
| 609 | -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top |
|---|
| 610 | bind $frm <Return> "$frmC.b invoke" |
|---|
| 611 | |
|---|
| 612 | if {$mode == "new"} { |
|---|
| 613 | pack [label $frmA.0 -text "Enter an experiment file to create"] \ |
|---|
| 614 | -side top -anchor center |
|---|
| 615 | } else { |
|---|
| 616 | pack [label $frmA.0 -text "Select an experiment file to read"] \ |
|---|
| 617 | -side top -anchor center |
|---|
| 618 | } |
|---|
| 619 | expfilebox $frmA $mode |
|---|
| 620 | # force the window to stay on top |
|---|
| 621 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
|---|
| 622 | |
|---|
| 623 | wm withdraw $frm |
|---|
| 624 | update idletasks |
|---|
| 625 | # center the new window in the middle of the parent |
|---|
| 626 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
|---|
| 627 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
|---|
| 628 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
|---|
| 629 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
|---|
| 630 | wm geom $frm +$x+$y |
|---|
| 631 | wm deiconify $frm |
|---|
| 632 | |
|---|
| 633 | set oldFocus [focus] |
|---|
| 634 | set oldGrab [grab current $frm] |
|---|
| 635 | if {$oldGrab != ""} { |
|---|
| 636 | set grabStatus [grab status $oldGrab] |
|---|
| 637 | } |
|---|
| 638 | grab $frm |
|---|
| 639 | focus $frmC.b |
|---|
| 640 | tkwait window $frm |
|---|
| 641 | catch {focus $oldFocus} |
|---|
| 642 | if {$oldGrab != ""} { |
|---|
| 643 | if {$grabStatus == "global"} { |
|---|
| 644 | grab -global $oldGrab |
|---|
| 645 | } else { |
|---|
| 646 | grab $oldGrab |
|---|
| 647 | } |
|---|
| 648 | } |
|---|
| 649 | if {$expgui(FileMenuEXPNAM) == ""} return |
|---|
| 650 | return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)] |
|---|
| 651 | } |
|---|
| 652 | |
|---|
| 653 | # validation routine |
|---|
| 654 | proc valid_exp_file {frm mode} { |
|---|
| 655 | global expgui |
|---|
| 656 | if {$expgui(FileMenuEXPNAM) == "<Parent>"} { |
|---|
| 657 | set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ] |
|---|
| 658 | ChooseExpFil $frm |
|---|
| 659 | return |
|---|
| 660 | } elseif [file isdirectory \ |
|---|
| 661 | [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] { |
|---|
| 662 | if {$expgui(FileMenuEXPNAM) != "."} { |
|---|
| 663 | set expgui(FileMenuDir) \ |
|---|
| 664 | [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)] |
|---|
| 665 | } |
|---|
| 666 | ChooseExpFil $frm |
|---|
| 667 | return |
|---|
| 668 | } |
|---|
| 669 | set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)] |
|---|
| 670 | if {[file extension $expgui(FileMenuEXPNAM)] == ""} { |
|---|
| 671 | append expgui(FileMenuEXPNAM) ".EXP" |
|---|
| 672 | } |
|---|
| 673 | if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} { |
|---|
| 674 | tk_dialog .expFileErrorMsg "File Open Error" \ |
|---|
| 675 | "File $expgui(FileMenuEXPNAM) is not a valid name. Experiment files must end in \".EXP\"" \ |
|---|
| 676 | error 0 OK |
|---|
| 677 | return |
|---|
| 678 | } |
|---|
| 679 | set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)] |
|---|
| 680 | if {$mode == "new" && [file exists $file]} { |
|---|
| 681 | set ans [tk_dialog .expFileErrorMsg "File Open Error" \ |
|---|
| 682 | "File $file already exists. OK to overwrite?" question 0 \ |
|---|
| 683 | "Select other name" "Overwrite"] |
|---|
| 684 | if $ans {destroy .file} |
|---|
| 685 | return |
|---|
| 686 | } |
|---|
| 687 | if {$mode == "old" && ![file exists $file]} { |
|---|
| 688 | set ans [tk_dialog .expFileErrorMsg "File Open Error" \ |
|---|
| 689 | "File $file does not exist. OK to create?" question 0 \ |
|---|
| 690 | "Select other name" "Create"] |
|---|
| 691 | if $ans {destroy .file} |
|---|
| 692 | return |
|---|
| 693 | } |
|---|
| 694 | destroy .file |
|---|
| 695 | } |
|---|
| 696 | |
|---|
| 697 | proc updir {} { |
|---|
| 698 | global expgui |
|---|
| 699 | set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]] |
|---|
| 700 | } |
|---|
| 701 | |
|---|
| 702 | # create a file box |
|---|
| 703 | proc expfilebox {bx mode} { |
|---|
| 704 | global expgui |
|---|
| 705 | pack [frame $bx.top] -side top |
|---|
| 706 | pack [label $bx.top.a -text "Directory" ] -side left |
|---|
| 707 | set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ] |
|---|
| 708 | pack $bx.top.d -side left |
|---|
| 709 | set expgui(FileMenuDir) [pwd] |
|---|
| 710 | # the icon below is from tk8.0/tkfbox.tcl |
|---|
| 711 | set upfolder [image create bitmap -data { |
|---|
| 712 | #define updir_width 28 |
|---|
| 713 | #define updir_height 16 |
|---|
| 714 | static char updir_bits[] = { |
|---|
| 715 | 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00, |
|---|
| 716 | 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01, |
|---|
| 717 | 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01, |
|---|
| 718 | 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, |
|---|
| 719 | 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01, |
|---|
| 720 | 0xf0, 0xff, 0xff, 0x01};}] |
|---|
| 721 | |
|---|
| 722 | pack [button $bx.top.b -image $upfolder \ |
|---|
| 723 | -command "updir; ChooseExpFil $bx" ] |
|---|
| 724 | pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both |
|---|
| 725 | listbox $bx.a.files -relief raised -bd 2 \ |
|---|
| 726 | -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \ |
|---|
| 727 | -height 15 -width 0 |
|---|
| 728 | listbox $bx.a.dates -relief raised -bd 2 \ |
|---|
| 729 | -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \ |
|---|
| 730 | -height 15 -width 0 -takefocus 0 |
|---|
| 731 | scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" " |
|---|
| 732 | ChooseExpFil $bx |
|---|
| 733 | bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx" |
|---|
| 734 | bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx" |
|---|
| 735 | bind $bx.a.files <Double-1> "SelectExpFil $bx $mode" |
|---|
| 736 | bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode" |
|---|
| 737 | pack $bx.a.scroll -side left -fill y |
|---|
| 738 | pack $bx.a.files $bx.a.dates -side left -fill both -expand yes |
|---|
| 739 | pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top |
|---|
| 740 | } |
|---|
| 741 | proc sync2boxes {master slave scroll args} { |
|---|
| 742 | $slave yview moveto [lindex [$master yview] 0] |
|---|
| 743 | eval $scroll set $args |
|---|
| 744 | } |
|---|
| 745 | proc move2boxesY {boxlist args} { |
|---|
| 746 | foreach listbox $boxlist { |
|---|
| 747 | eval $listbox yview $args |
|---|
| 748 | } |
|---|
| 749 | } |
|---|
| 750 | |
|---|
| 751 | # set the box or file in the selection window |
|---|
| 752 | proc ReleaseExpFil {frm} { |
|---|
| 753 | global expgui |
|---|
| 754 | set files $frm.a.files |
|---|
| 755 | set dates $frm.a.dates |
|---|
| 756 | set select [$files curselection] |
|---|
| 757 | if {$select == ""} { |
|---|
| 758 | set select [$dates curselection] |
|---|
| 759 | } |
|---|
| 760 | if {$select == ""} { |
|---|
| 761 | set expgui(FileMenuEXPNAM) "" |
|---|
| 762 | } else { |
|---|
| 763 | set expgui(FileMenuEXPNAM) [string trim [$files get $select]] |
|---|
| 764 | } |
|---|
| 765 | return |
|---|
| 766 | } |
|---|
| 767 | |
|---|
| 768 | # select a file or directory -- called on double click |
|---|
| 769 | proc SelectExpFil {frm mode} { |
|---|
| 770 | global expgui |
|---|
| 771 | set files $frm.a.files |
|---|
| 772 | set dates $frm.a.dates |
|---|
| 773 | set select [$files curselection] |
|---|
| 774 | if {$select == ""} { |
|---|
| 775 | set select [$dates curselection] |
|---|
| 776 | } |
|---|
| 777 | if {$select == ""} { |
|---|
| 778 | set file . |
|---|
| 779 | } else { |
|---|
| 780 | set file [string trim [$files get $select]] |
|---|
| 781 | } |
|---|
| 782 | if {$file == "<Parent>"} { |
|---|
| 783 | set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ] |
|---|
| 784 | ChooseExpFil $frm |
|---|
| 785 | } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] { |
|---|
| 786 | if {$file != "."} { |
|---|
| 787 | set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file] |
|---|
| 788 | ChooseExpFil $frm |
|---|
| 789 | } |
|---|
| 790 | } else { |
|---|
| 791 | set expgui(FileMenuEXPNAM) [file tail $file] |
|---|
| 792 | valid_exp_file $frm $mode |
|---|
| 793 | } |
|---|
| 794 | } |
|---|
| 795 | |
|---|
| 796 | # fill the files & dates & Directory selection box with current directory, |
|---|
| 797 | # also called when box is created to fill it |
|---|
| 798 | proc ChooseExpFil {frm} { |
|---|
| 799 | global expgui |
|---|
| 800 | set files $frm.a.files |
|---|
| 801 | set dates $frm.a.dates |
|---|
| 802 | set expgui(FileMenuEXPNAM) {} |
|---|
| 803 | $files delete 0 end |
|---|
| 804 | $dates delete 0 end |
|---|
| 805 | $files insert end {<Parent>} |
|---|
| 806 | $dates insert end {(Directory)} |
|---|
| 807 | set filelist [glob -nocomplain \ |
|---|
| 808 | [file join [set expgui(FileMenuDir)] *] ] |
|---|
| 809 | foreach file [lsort $filelist] { |
|---|
| 810 | if {[file isdirectory $file]} { |
|---|
| 811 | $files insert end [file tail $file] |
|---|
| 812 | $dates insert end {(Directory)} |
|---|
| 813 | } |
|---|
| 814 | } |
|---|
| 815 | set pairlist {} |
|---|
| 816 | foreach file [lsort $filelist] { |
|---|
| 817 | if {![file isdirectory $file] && \ |
|---|
| 818 | [string toupper [file extension $file]] == ".EXP"} { |
|---|
| 819 | set modified [file mtime $file] |
|---|
| 820 | lappend pairlist "$file $modified" |
|---|
| 821 | } |
|---|
| 822 | } |
|---|
| 823 | if {$expgui(filesort) == 0} { |
|---|
| 824 | foreach pair [lsort -index 1 -integer $pairlist] { |
|---|
| 825 | set file [lindex $pair 0] |
|---|
| 826 | set modified [clock format [lindex $pair 1] -format "%T %D"] |
|---|
| 827 | $files insert end [file tail $file] |
|---|
| 828 | $dates insert end $modified |
|---|
| 829 | } |
|---|
| 830 | } else { |
|---|
| 831 | foreach pair [lsort -index 0 $pairlist] { |
|---|
| 832 | set file [lindex $pair 0] |
|---|
| 833 | set modified [clock format [lindex $pair 1] -format "%T %D"] |
|---|
| 834 | $files insert end [file tail $file] |
|---|
| 835 | $dates insert end $modified |
|---|
| 836 | } |
|---|
| 837 | } |
|---|
| 838 | $expgui(FileDirButtonMenu) delete 0 end |
|---|
| 839 | set list "" |
|---|
| 840 | set dir "" |
|---|
| 841 | foreach subdir [file split [set expgui(FileMenuDir)]] { |
|---|
| 842 | set dir [file join $dir $subdir] |
|---|
| 843 | lappend list $dir |
|---|
| 844 | } |
|---|
| 845 | foreach path $list { |
|---|
| 846 | $expgui(FileDirButtonMenu) add command -label $path \ |
|---|
| 847 | -command "[list set expgui(FileMenuDir) $path]; \ |
|---|
| 848 | ChooseExpFil $frm" |
|---|
| 849 | } |
|---|
| 850 | # highlight the current experiment -- if present |
|---|
| 851 | for {set i 0} {$i < [$files size]} {incr i} { |
|---|
| 852 | set file [$files get $i] |
|---|
| 853 | if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} { |
|---|
| 854 | $files selection set $i |
|---|
| 855 | } |
|---|
| 856 | } |
|---|
| 857 | return |
|---|
| 858 | } |
|---|
| 859 | |
|---|
