Changeset 1036
- Timestamp:
- Nov 22, 2010 5:02:57 PM (10 years ago)
- Location:
- branches/sandbox
- Files:
-
- 1 added
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/addcmds.tcl
r1015 r1036 2519 2519 incr expgui(changed) 2520 2520 } 2521 set expmap(atomlist_$phase) {} 2521 2522 RecordMacroEntry "incr expgui(changed)" 0 2522 2523 # write new atoms from table as input to exptool -
branches/sandbox/expgui
r1021 r1036 326 326 file copy -force $expgui(expfile) $expnam.EXP 327 327 set expgui(expfile) $expnam.EXP 328 wm title . "EXPGUI interface to GSAS: [file tail $expgui(expfile)]" 329 set expgui(titleunchanged) 1 328 330 } else { 329 331 MyMessageBox -parent . -title "File not found" \ … … 333 335 } 334 336 } else { 335 SetEXPfile $expgui(expfile)337 set expgui(expfile) [SetEXPfile $expgui(expfile)] 336 338 } 337 339 } … … 348 350 # I am not sure it is still needed. 349 351 update 350 SetEXPfile [getExpFileName ""]352 set expgui(expfile) [SetEXPfile [getExpFileName ""]] 351 353 set expgui(resize) 1 352 354 } … … 360 362 proc loadexp {expfile} { 361 363 global expgui expmap entryvar entrycmd tcl_platform 362 set prevexp $expgui(expfile) 363 # is this a compressed archive file? 364 if {[string match {*.O[0-9A-F][0-9A-F]} $expfile]} { 365 set expnam [file rootname $expfile] 366 set ans [MyMessageBox -parent . -title "Load Archived File" \ 367 -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \ 368 -icon question -type "{Use New Name} {Continue with current}" \ 369 -default {Use New Name} \ 370 -helplink "expguierr.html LoadArchived" 371 ] 372 # archive the current .EXP file 373 if {$ans != "use new name" && [file exists $expfile]} { 374 # get the last archived version 375 set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end] 376 if {$lastf == ""} { 377 set num 01 378 } else { 379 regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num 380 scan $num %x num 381 if {$num >= 255} { 382 set num FF 383 } else { 384 set num [string toupper [format %.2x [incr num]]] 385 } 386 } 387 catch { 388 set newfile $expnam.O$num 389 file rename -force $expnam.EXP $newfile 390 set fp [open $expnam.LST a+] 391 puts $fp "\n----------------------------------------------" 392 puts $fp " Regressing to archive file [file tail $expfile]" 393 puts $fp " but first archiving [file tail $expnam.EXP] as [file tail $newfile]" 394 puts $fp "----------------------------------------------\n" 395 close $fp 396 } 397 file copy -force $expfile $expnam.EXP 398 set expfile $expnam.EXP 399 } 400 if {$ans == "use new name"} { 401 set newexpfile [getExpFileName new] 402 if {$newexpfile == ""} return 403 file copy -force $expfile $newexpfile 404 catch {cd [string trim [file dirname $expgui(expfile)]]} 405 set expfile [file tail $newexpfile] 406 set expgui(needpowpref) 2 407 set expgui(needpowpref_why) "\tA new .EXP file was created\n" 408 SetEXPfile $newexpfile 409 } else { 410 SetEXPfile $expfile 411 } 412 if {$expgui(expfile) == ""} { 413 set expgui(expfile) $prevexp 414 return 415 } 416 } 417 364 set expfile [SetEXPfile $expfile] 365 if {$expfile == ""} { 366 return 367 } 418 368 # change the icon and assign an app to this .EXP file 419 369 if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} { 420 370 MacSetResourceFork $expfile 421 371 } 422 423 SetEXPfile $expfile424 if {$expgui(expfile) == ""} {425 set expgui(expfile) $prevexp426 return427 }428 372 # read in the .EXP file 429 373 set fmt [expload $expfile] 374 set expgui(expfile) $expfile 430 375 # if the file was not in the correct format, force a rewrite before use 431 376 if {$fmt < 0} { … … 452 397 set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ] 453 398 # set the window/icon title 454 wm title . "EXPGUI interface to GSAS: $expfile"399 wm title . "EXPGUI interface to GSAS: [file tail $expgui(expfile)]" 455 400 set expgui(titleunchanged) 1 456 401 wm iconname . [file tail $expfile] … … 462 407 afterawhile 463 408 } 409 464 410 465 411 # [re]load all screens with current state of EXPGUI file … … 546 492 global expgui 547 493 global tcl_platform 548 set prevexp $expgui(expfile) 549 set newexpfile [getExpFileName new] 550 if {$newexpfile == ""} return 551 SetEXPfile $newexpfile 1 552 if {$expgui(expfile) == ""} { 553 set expgui(expfile) $prevexp 554 return 555 } 494 set $newexpfile [SetEXPfile [getExpFileName new] 1] 495 if {$newexpfile == ""} return 556 496 expwrite $newexpfile 557 497 # change the icon and assign an app to this .EXP file … … 573 513 574 514 # called to read a different .EXP file 575 proc readnewexp { } {515 proc readnewexp {"mode 0"} { 576 516 global expgui expmap 577 517 if $expgui(changed) { … … 585 525 } 586 526 } 587 set prevexp $expgui(expfile) 588 set newexpfile [getExpFileName old] 589 if {$newexpfile == ""} return 590 SetEXPfile $newexpfile 591 if {$expgui(expfile) == ""} { 592 set expgui(expfile) $prevexp 593 return 594 } 527 if {$mode == 0} { 528 set newexpfile [getExpFileName old] 529 } else { 530 set newexpfile [RevertExpFile] 531 } 532 if {$newexpfile == ""} return 595 533 596 534 # switch to the 1st page 597 535 RaisePage lsFrame 598 536 set expgui(globalmode) 0 599 loadexp $ expgui(expfile)537 loadexp $newexpfile 600 538 601 539 # reset the phase selection -
branches/sandbox/gsascmds.tcl
r1026 r1036 2011 2011 proc SetEXPfile {expfile "newOK 0"} { 2012 2012 global expgui tcl_platform 2013 set expgui(expfile) {}2014 2013 if {[string trim $expfile] == ""} return 2015 2014 … … 2067 2066 # force exp files to be upper case, set to force save if name changes 2068 2067 set origexp $expname 2069 if {$expname != [string toupper $expfile]} { 2070 set expname [string toupper [file tail $expfile]] 2071 if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1} 2072 } 2073 if {[file extension $expname] != ".EXP"} { 2068 if {$expname != [file tail $expfile] && $tcl_platform(platform) != "windows"} { 2069 set expgui(changed) 1 2070 } 2071 #puts $expgui(expfile) 2072 if {[string match {.O[0-9A-F][0-9A-F]} [file extension $expname]]} { 2073 set expname [ArchiveChoice $expname] 2074 set dirname "" 2075 if {$expname == ""} return 2076 } elseif {[file extension $expname] != ".EXP"} { 2074 2077 append expname ".EXP" 2075 2078 } 2076 if {$dirname == "." } {2079 if {$dirname == "." || $dirname == ""} { 2077 2080 set newexpfile $expname 2078 2081 } else { … … 2133 2136 if {[string tolower $ans] == "create"} { 2134 2137 # you've been warned this .EXP does not exist! 2135 # create an "empty" exp file 2136 createexp $newexpfile \ 2137 [getstring "title for experiment $expname" 60 0] 2138 if {! [file exists [file join $dirname $expname]]} { 2139 update 2140 MyMessageBox -parent . -title "File Creation Error" \ 2141 -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \ 2142 -icon warning -type Continue -default continue 2143 set expgui(resize) 1 2144 return 2145 } 2138 if [CreateMTexpfile $newexpfile] return 2146 2139 } else { 2147 2140 return 2148 2141 } 2149 2142 } 2150 set expgui(expfile) $newexpfile 2151 catch {cd [string trim [file dirname $expgui(expfile)]]} 2143 catch {cd [string trim [file dirname $newexpfile]]} 2144 return $newexpfile 2145 } 2146 2147 proc ArchiveChoice {expfile} { 2148 set expnam [file rootname $expfile] 2149 set ans [MyMessageBox -parent . -title "Load Archived File" \ 2150 -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \ 2151 -icon question -type "{Use New Name} {Continue with current}" \ 2152 -default {Use New Name} \ 2153 -helplink "expguierr.html LoadArchived" 2154 ] 2155 # archive the current .EXP file 2156 if {$ans != "use new name" && [file exists $expfile]} { 2157 # get the last archived version 2158 set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end] 2159 if {$lastf == ""} { 2160 set num 01 2161 } else { 2162 regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num 2163 scan $num %x num 2164 if {$num >= 255} { 2165 set num FF 2166 } else { 2167 set num [string toupper [format %.2x [incr num]]] 2168 } 2169 } 2170 catch { 2171 set newfile $expnam.O$num 2172 file rename -force $expnam.EXP $newfile 2173 set fp [open $expnam.LST a+] 2174 puts $fp "\n----------------------------------------------" 2175 puts $fp " Regressing to archive file [file tail $expfile]" 2176 puts $fp " but first archiving [file tail $expnam.EXP] as [file tail $newfile]" 2177 puts $fp "----------------------------------------------\n" 2178 close $fp 2179 } 2180 file copy -force $expfile $expnam.EXP 2181 set expfile $expnam.EXP 2182 } 2183 if {$ans == "use new name"} { 2184 set newexpfile [getExpFileName new] 2185 if {$newexpfile == ""} { 2186 set expgui(FileMenuEXPNAM) "" 2187 return 2188 } 2189 file copy -force $expfile $newexpfile 2190 set expgui(needpowpref) 2 2191 set expgui(needpowpref_why) "\tA new .EXP file was created\n" 2192 return $newexpfile 2193 } else { 2194 return $expfile 2195 } 2196 } 2197 2198 # create an "empty" exp file 2199 proc CreateMTexpfile {newexpfile} { 2200 set expname [file tail $newexpfile] 2201 createexp $newexpfile \ 2202 [getstring "title for experiment $expname" 60 0] 2203 if {! [file exists $newexpfile]} { 2204 update 2205 MyMessageBox -parent . -title "File Creation Error" \ 2206 -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \ 2207 -icon warning -type Continue -default continue 2208 set ::expgui(resize) 1 2209 return 1 2210 } 2211 return 0 2152 2212 } 2153 2213 … … 2181 2241 -side top -fill both -expand yes -pady 5 2182 2242 } elseif {$mode != "new"} { 2183 # for initial read, don't accessarchived files2243 # for initial read, don't offer access to archived files 2184 2244 pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \ 2185 2245 -class SmallFont] \ … … 2210 2270 afterputontop 2211 2271 if {$expgui(FileMenuEXPNAM) == ""} return 2212 # is there a space in the EXP name? 2213 # if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} { 2214 # update 2215 # MyMessageBox -parent . -title "File Name Error" \ 2216 # -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \ 2217 # -icon warning -type Continue -default continue 2218 # -helplink "expguierr.html OpenErr" 2219 # return 2220 # } 2221 # if {[string first " " $expgui(FileMenuDir)] != -1} { 2222 # set warn 1 2223 # catch {set warn $expgui(warnonexpdirspace)} 2224 # if $warn { 2225 # update 2226 # MyMessageBox -parent . -title "Good luck..." \ 2227 # -message "You are using a directory with a space in the name ($expgui(FileMenuDir)) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \ 2228 # -icon warning -type Continue -default continue 2229 # # -helplink "expguierr.html OpenErr" 2230 # set expgui(warnonexpdirspace) 0 2231 # } 2232 # } 2272 #puts "end getexp $expgui(expfile)" 2233 2273 return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)] 2234 2274 } 2235 2275 2236 2276 # validation routine 2277 # called from getExpFileName, either from Read button or from SelectExpFil (see expfilebox) 2237 2278 proc valid_exp_file {frm mode} { 2238 2279 global expgui tcl_platform … … 2260 2301 return 2261 2302 } 2262 # append a .EXP if not present 2263 if {[file extension $expgui(FileMenuEXPNAM)] == ""} { 2303 set ext [string toupper [file extension $expgui(FileMenuEXPNAM)]] 2304 if {$ext == ""} { 2305 # append a .EXP if not present 2264 2306 append expgui(FileMenuEXPNAM) ".EXP" 2265 } 2266 # is there a space in the name? 2267 # if {[string first " " $expgui(FileMenuEXPNAM)] != -1} { 2268 # MyMessageBox -parent . -title "File Name Error" \ 2269 # -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \ 2270 # -icon warning -type Continue -default continue 2271 # -helplink "expguierr.html OpenErr" 2272 # return 2273 # } 2274 # check for archive files 2275 if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \ 2307 } elseif {[string match {*.O[0-9A-F][0-9A-F]} $ext] && \ 2276 2308 $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} { 2309 # check for archive files 2277 2310 destroy .file 2278 2311 return 2279 } elseif { [string toupper [file extension $expgui(FileMenuEXPNAM)]]!= ".EXP"} {2312 } elseif {$ext != ".EXP"} { 2280 2313 # check for files that end in something other than .EXP .exp or .Exp... 2281 2314 MyMessageBox -parent . -title "File Open Error" \ … … 2310 2343 -helplink "expguierr.html OpenErr" 2311 2344 ] 2312 if {[string tolower $ans] == "create"} {destroy .file} 2345 if {[string tolower $ans] == "create"} { 2346 if [CreateMTexpfile $file] return 2347 destroy .file 2348 } 2313 2349 return 2314 2350 } … … 2360 2396 pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top 2361 2397 } 2398 proc sync2boxesX {master slave scroll args} { 2399 $slave xview moveto [lindex [$master xview] 0] 2400 eval $scroll set $args 2401 } 2402 proc move2boxesX {boxlist args} { 2403 foreach listbox $boxlist { 2404 eval $listbox xview $args 2405 } 2406 } 2362 2407 proc sync2boxesY {master slave scroll args} { 2363 2408 $slave yview moveto [lindex [$master yview] 0] … … 2460 2505 - [winfo height $box.top] - [winfo height $box.scroll]-25] 2461 2506 } 2462 2507 proc RevertExpFile {} { 2508 global expgui tcl_platform 2509 set frm .file 2510 catch {destroy $frm} 2511 toplevel $frm 2512 wm title $frm "Experiment file" 2513 bind $frm <Key-F1> "MakeWWWHelp expguierr.html open" 2514 pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left 2515 pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \ 2516 -fill y -expand yes 2517 pack [button $frmC.help -text Help -bg yellow \ 2518 -command "MakeWWWHelp expguierr.html open"] \ 2519 -side top -anchor e 2520 set expgui(filesort) 0 2521 set expgui(includearchived) 1 2522 set expgui(FileInfoBox) $frmC.info 2523 pack [label $frmC.ar -text "(Showing Archived Files Only)"] -side top -pady 10 2524 pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \ 2525 -class SmallFont] \ 2526 -side top -fill both -expand yes -pady 5 2527 2528 pack [button $frmC.b -text Read \ 2529 -command "valid_exp_file $frmA old"] -side bottom 2530 pack [button $frmC.q -text Cancel \ 2531 -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom 2532 bind $frm <Return> "$frmC.b invoke" 2533 2534 pack [label $frmA.0 -text "Select an archived experiment file to read"] \ 2535 -side top -anchor center 2536 set bx $frmA 2537 pack [frame $bx.top] -side top 2538 #pack [label $bx.top.a -text "Directory" ] -side left 2539 set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ] 2540 #pack $bx.top.d -side left 2541 #set expgui(FileMenuDir) [pwd] 2542 # the icon below is from tk8.0/tkfbox.tcl 2543 pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both 2544 listbox $bx.a.files -relief raised -bd 2 \ 2545 -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \ 2546 -height 15 -width 0 -exportselection 0 2547 listbox $bx.a.dates -relief raised -bd 2 \ 2548 -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \ 2549 -height 15 -width 0 -takefocus 0 -exportselection 0 2550 scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" " 2551 ChooseExpFil $bx 1 2552 if {[llength [$bx.a.files get 0 end]] == 0} { 2553 destroy $frm 2554 MyMessageBox -parent . -title "No Archives" \ 2555 -message "Sorry no archived versions of $::expgui(expfile) are present" \ 2556 -icon warning -type ok -default ok 2557 return 2558 } 2559 bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx" 2560 bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx" 2561 bind $bx.a.files <Double-1> "SelectExpFil $bx old" 2562 bind $bx.a.dates <Double-1> "SelectExpFil $bx old" 2563 pack $bx.a.scroll -side left -fill y 2564 pack $bx.a.files $bx.a.dates -side left -fill both -expand yes 2565 pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top 2566 # force the window to stay on top 2567 putontop $frm 2568 focus $frmC.b 2569 tkwait window $frm 2570 afterputontop 2571 if {$expgui(FileMenuEXPNAM) == ""} return 2572 return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)] 2573 } 2463 2574 2464 2575 # support routine for SetHistUseFlags … … 2677 2788 # fill the files & dates & Directory selection box with current directory, 2678 2789 # also called when box is created to fill it 2679 proc ChooseExpFil {frm } {2790 proc ChooseExpFil {frm "archiveonly 0"} { 2680 2791 global expgui 2681 2792 set files $frm.a.files … … 2684 2795 $files delete 0 end 2685 2796 $dates delete 0 end 2686 $files insert end {<Parent>} 2687 $dates insert end {(Directory)} 2688 set filelist [glob -nocomplain \ 2689 [file join [set expgui(FileMenuDir)] *] ] 2690 foreach file [lsort -dictionary $filelist] { 2691 if {[file isdirectory $file]} { 2692 $files insert end [file tail $file] 2693 $dates insert end {(Directory)} 2694 } 2797 if {$archiveonly == 0} { 2798 $files insert end {<Parent>} 2799 $dates insert end {(Directory)} 2800 set filelist [glob -nocomplain \ 2801 [file join [set expgui(FileMenuDir)] *] ] 2802 foreach file [lsort -dictionary $filelist] { 2803 if {[file isdirectory $file]} { 2804 $files insert end [file tail $file] 2805 $dates insert end {(Directory)} 2806 } 2807 } 2808 } else { 2809 set filelist [glob -nocomplain \ 2810 [file root $expgui(expfile)].O* ] 2695 2811 } 2696 2812 set pairlist {} 2697 2813 foreach file [lsort -dictionary $filelist] { 2698 2814 if {![file isdirectory $file] && \ 2699 [string toupper [file extension $file]] == ".EXP"} { 2815 [string toupper [file extension $file]] == ".EXP" \ 2816 && $archiveonly == 0} { 2700 2817 set modified [file mtime $file] 2701 2818 lappend pairlist [list $file $modified] -
branches/sandbox/gsasmenu.tcl
r1021 r1036 9 9 array set expgui_menulist { 10 10 file { 11 revert 11 12 EraseHistory 12 13 convert … … 158 159 } 159 160 161 revert {{readnewexp archive} { 162 Select an old version of the current GSAS file} 163 } 164 160 165 {archive EXP} {- { 161 166 Toggles archiving of .EXP files. When on, files are
Note: See TracChangeset
for help on using the changeset viewer.