- Timestamp:
- Sep 21, 2010 11:28:51 PM (13 years ago)
- Location:
- branches/sandbox
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/addcmds.tcl
r992 r1015 392 392 393 393 proc MakeAddHistBox {} { 394 global expmap newhist 394 global expmap newhist expgui 395 395 396 396 # --> should check here if room for another histogram, but only texture … … 518 518 # fix grab... 519 519 afterputontop 520 # if no histogram is selected, select the last 521 if {$expgui(curhist) == "" && $expmap(powderlist) != ""} { 522 $expgui(histFrame).hs.lbox select set end 523 set expgui(curhist) [$expgui(histFrame).hs.lbox curselection] 524 DisplayHistogram 525 } 520 526 } 521 527 -
branches/sandbox/expgui
r1014 r1015 1699 1699 } 1700 1700 } 1701 # disable the unallowed pages in all mode 1702 if {$expgui(globalmode) == 6} { 1703 foreach pair $expgui(GlobalModeAllDisable) { 1704 if {$expgui(pagenow) == [lindex $pair 0]} { 1705 RaisePage lsFrame 1706 } 1707 eval [lindex $pair 1] -state disabled 1708 } 1709 } else { 1710 foreach pair $expgui(GlobalModeAllDisable) { 1711 eval [lindex $pair 1] -state normal 1712 } 1713 } 1701 StageTabUse 1702 # # disable the unallowed pages in all mode 1703 # if {$expgui(globalmode) == 6} { 1704 # foreach pair $expgui(GlobalModeAllDisable) { 1705 # if {$expgui(pagenow) == [lindex $pair 0]} { 1706 # RaisePage lsFrame 1707 # } 1708 # eval [lindex $pair 1] -state disabled 1709 # } 1710 # } else { 1711 # foreach pair $expgui(GlobalModeAllDisable) { 1712 # eval [lindex $pair 1] -state normal 1713 # } 1714 # } 1714 1715 set histlist {} 1715 1716 if {$expgui(hsorttype) == "type"} { … … 3387 3388 } 3388 3389 } 3390 # procedure to disable tabs when phases or histograms are not defined 3391 proc StageTabUse {args} { 3392 global expgui 3393 # reset everything 3394 foreach item [lrange $::expgui(notebookpagelist) 0 end] { 3395 set frm [lindex $item 0] 3396 .n itemconfigure $frm -state normal 3397 } 3398 # disable the unallowed pages in all mode 3399 if {$expgui(globalmode) == 6} { 3400 foreach pair $expgui(GlobalModeAllDisable) { 3401 if {$expgui(pagenow) == [lindex $pair 0]} { 3402 RaisePage lsFrame 3403 } 3404 eval [lindex $pair 1] -state disabled 3405 } 3406 } else { 3407 foreach pair $expgui(GlobalModeAllDisable) { 3408 eval [lindex $pair 1] -state normal 3409 } 3410 } 3411 # no phases are present, one must add a phase 1st 3412 if {[llength $::expmap(phaselist)] == 0} { 3413 foreach item [lrange $::expgui(notebookpagelist) 2 end] { 3414 set frm [lindex $item 0] 3415 .n itemconfigure $frm -state disabled 3416 } 3417 return 3418 } 3419 # do any of the phases have atoms? 3420 set flag 1 3421 foreach phase $::expmap(phaselist) { 3422 if {[array names ::expmap atomlist_$phase] != ""} { 3423 if {[llength $::expmap(atomlist_$phase)] > 0} { 3424 set flag 0 3425 break 3426 } 3427 } 3428 } 3429 # no atoms are present, one must add at least one before continuing 3430 if $flag { 3431 foreach item [lrange $::expgui(notebookpagelist) 2 end] { 3432 set frm [lindex $item 0] 3433 .n itemconfigure $frm -state disabled 3434 } 3435 return 3436 } 3437 3438 # no data is present, one must add a histogram next 3439 if {[llength $::expmap(nhst)] == 0} { 3440 foreach item [lrange $::expgui(notebookpagelist) 4 end] { 3441 set frm [lindex $item 0] 3442 .n itemconfigure $frm -state disabled 3443 } 3444 return 3445 } 3446 } 3447 # expgui(mapstat) is set by mapexp when it is called 3448 # mapexp will be called when the .EXP file is changed (addition of phases, atoms or histograms) 3449 trace variable expgui(mapstat) w StageTabUse 3389 3450 3390 3451 # this is used to bring up the selected frame … … 4208 4269 -command {set expgui(debug) 1} 4209 4270 } 4210 # add update commands to buffer4211 if [CheckUpdateImplemented $expgui(gsasdir)]{4271 # add update commands to menu 4272 if {[file exists [file join $expgui(gsasdir) .svn]]} { 4212 4273 $expgui(fm).file.menu add command -command CheckAndDoUpdate -label "Update GSAS/EXPGUI" 4213 # $expgui(fm).file.menu add cascade -menu $expgui(fm).file.menu.track \4214 # -label "Select EXPGUI version"4215 # menu $expgui(fm).file.menu.track4216 # $expgui(fm).file.menu.track add radiobutton -command {SetSVNbranch trunk} -label Development -value trunk \4217 # -variable expgui(SVNversion)4218 # $expgui(fm).file.menu.track add radiobutton -command {SetSVNbranch stable} -label Standard -value stable \4219 # -variable expgui(SVNversion)4220 # get info about the current version on the server. Someday we might want to compare this4221 # say every month and notify when there is a new version to update4222 set repos [GetSVNrepository [file normalize $expgui(gsasdir)]]4223 # send a "p" to accept the server fingerprint in case needed on 1st access4224 set svninp [file normalize "~/svntmp.txt"]4225 set fp [open $svninp "w"]4226 puts $fp "p"4227 close $fp4228 if [catch {set out [exec svn info $repos < $svninp]} err] {4229 puts "svn info error = $err"4230 }4231 catch {file delete $svninp}4232 set expgui(SVNversion) [lindex [split $repos '/'] end]4233 # cleanup batch file from a previous update4234 if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {4235 catch {4236 file delete [file normalize ~/expgui_update.bat]4237 }4238 }4239 4274 } else { 4240 $expgui(fm).file.menu add command -label "Show update problem" -command { 4241 if {! [file exists [file join $expgui(gsasdir) .svn]]} { 4242 MyMessageBox -parent . -title "No .svn" \ 4243 -message "Unable to update because the gsas/.svn directory is not present." \ 4244 -icon warning 4245 } else { 4246 MyMessageBox -parent . -title "No .svn" \ 4247 -message "Unable to update because the subversion (svn) program is not in the path." \ 4248 -icon warning 4249 } 4250 } 4275 $expgui(fm).file.menu add command -state disabled -label "Self-updating not installed" 4251 4276 } 4252 4277 foreach c {h H} {bind . <Alt-$c> [list showhelp]} -
branches/sandbox/gsascmds.tcl
r996 r1015 3398 3398 # Subversion support routines 3399 3399 #------------------------------------------------------------------------------ 3400 # is there a subversion stub and can we find the svn program 3401 proc CheckUpdateImplemented {scriptdir} { 3402 #is there a svn directory in the source? 3403 if {! [file exists [file join $scriptdir .svn]]} {return 0} 3400 3401 proc GetSVNVersion {scriptdir} { 3402 if {[CheckSVNinstalled]} { 3403 set SVN [auto_execok svn] 3404 if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} { 3405 set infolist [split $res] 3406 set pos [lsearch $infolist "Revision:"] 3407 return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]" 3408 } 3409 } 3410 return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])" 3411 } 3412 3413 # can we find the svn program? 3414 proc CheckSVNinstalled {} { 3404 3415 # can we find svn in the path? 3405 3416 if {[auto_execok svn] != ""} {return 1} 3406 # add a locally supplied svn version, if not in the path already 3407 set pathlist [list [file join $scriptdir svn bin]] 3408 lappend pathlist "/sw/bin/" 3409 lappend pathlist "/opt/local/bin/" 3410 catch {lappend pathlist $::expgui(pathlist)} 3411 foreach localsvn $pathlist { 3412 if {[file exists $localsvn]} { 3413 if {$::tcl_platform(platform) == "windows"} { 3414 set localsvn [file nativename $localsvn] 3415 set sep {;} 3416 } else { 3417 set sep {:} 3418 } 3419 if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} { 3420 append ::env(PATH) $sep $localsvn 3421 auto_reset 3422 if {[auto_execok svn] != ""} {return 1} 3423 } 3424 } 3425 } 3417 # add a locally supplied svn version and add to path 3418 if {$::tcl_platform(platform) == "windows"} { 3419 set s [file attributes $::expgui(gsasdir) -shortname] 3420 } else { 3421 set s $::expgui(gsasdir) 3422 } 3423 # look for svn 3424 set localsvn [file join $s svn bin] 3425 if {[file exists $localsvn]} { 3426 if {$::tcl_platform(platform) == "windows"} { 3427 set localsvn [file nativename $localsvn] 3428 set sep {;} 3429 } else { 3430 set sep {:} 3431 } 3432 if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} { 3433 append ::env(PATH) $sep $localsvn 3434 # note that auto_reset breaks the tkcon package in Windows -- not sure why 3435 auto_reset 3436 } 3437 } 3438 if {[auto_execok svn] != ""} {return 1} 3426 3439 return 0 3427 3440 } 3428 3441 3429 proc GetSVNVersion {scriptdir} { 3430 if {$::tcl_platform(platform) == "windows"} { 3431 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname] 3432 } else { 3433 set SVN [auto_execok svn] 3434 } 3435 if {$SVN != ""} { 3436 if {! [catch {set res [exec $SVN info $scriptdir]} err]} { 3437 set infolist [split $res] 3438 set pos [lsearch $infolist "Revision:"] 3439 return "EXPGUI SVN version [lindex $infolist [incr pos]]" 3440 } 3441 } 3442 return "EXPGUI version: $::expgui(Revision)" 3443 } 3444 3445 proc GetSVNrepository {scriptdir} { 3446 if {$::tcl_platform(platform) == "windows"} { 3447 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname] 3448 } else { 3449 set SVN [auto_execok svn] 3450 } 3451 if {$SVN != ""} { 3452 if {! [catch {set res [exec $SVN info $scriptdir]} err]} { 3453 set infolist [split $res] 3454 set pos [lsearch $infolist "URL:"] 3455 return [lindex $infolist [incr pos]] 3456 } 3457 } 3458 return {} 3459 } 3460 3461 proc SetSVNbranch {branch} { 3462 # reset the track label 3463 set ::command(SVNversion) [lindex [split [GetSVNrepository $::expgui(scriptdir)] '/'] end] 3464 if {$::tcl_platform(platform) == "windows"} { 3465 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname] 3466 } else { 3467 set SVN [auto_execok svn] 3468 } 3469 if {$SVN == ""} { 3470 return 0 3471 } 3472 set curURL [GetSVNrepository $expgui(scriptdir)] 3473 set curbranch [lindex [split $curURL '/'] end] 3474 if {$curbranch == $branch} {return 0} 3475 if {$branch == "trunk"} { 3476 set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/trunk" 3477 set lbl development 3478 } elseif {$branch == "stable"} { 3479 set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/tags/stable" 3480 set lbl standard 3481 } else { 3482 MyMessageBox -parent . -title "Internal error" \ 3483 -message "No $branch track." -icon error 3484 return 0 3485 } 3486 set msg {Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} 3487 if {[MyMessageBox -parent . -title "Ready to switch" \ 3488 -message "Ready to update to the $lbl track.\n\n$msg" \ 3489 -type {Cancel "Update & Restart"} -default cancel -icon warning 3490 ] == "cancel"} {return} 3491 if {[confirmBeforeSave] == "Cancel"} return 3492 3493 # do a quiet cleanup. Sometimes needed after install, and never hurts 3494 if [catch {set res [exec $SVN cleanup $::expgui(scriptdir)]} err] { 3495 MyMessageBox -parent . -title "Error in cleanup" \ 3496 -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \ 3442 proc CheckAndDoUpdate { } { 3443 if {! [CheckSVNinstalled]} { 3444 MyMessageBox -parent . -title "SVN not found" \ 3445 -message "Unable to upgrade: Could not locate a copy of the subversion program. It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \ 3497 3446 -icon error 3498 } 3499 3500 # switch the source 3501 set cmd1 "$SVN switch $newURL $scriptdir" 3502 if [catch {set res1 [exec $SVN switch $newURL $::expgui(scriptdir)]} err] { 3503 MyMessageBox -parent . -title "Error updating" \ 3504 -message "Error performing update:\n$err" \ 3447 return 3448 } 3449 #is there a svn directory in the source? 3450 if {! [file exists [file join $::expgui(gsasdir) .svn]]} { 3451 MyMessageBox -parent . -title "No .svn directory" \ 3452 -message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \ 3505 3453 -icon error 3506 return 03507 }3508 set msg "Results from update:\n$cmd1\n$res1"3509 # update done, now need to "reboot"3510 MyMessageBox -parent . -title "Updating done" -icon info \3511 -message "Update Complete\nPress OK to restart EXPGUI\n\n$msg"3512 exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &3513 exit3514 }3515 3516 proc CheckAndDoUpdate { } {3517 if {$::tcl_platform(platform) == "windows"} {3518 set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]3519 } else {3520 set SVN [auto_execok svn]3521 }3522 if {$SVN == ""} {3523 tk_dialog .msg "Error: no svn" \3524 "Error: SVN not found. Should not happen." \3525 error 0 OK3526 3454 return 3527 3455 } 3528 #set wish "[info nameofexecutable]"3529 3456 # check for updates 3530 if [catch { 3531 set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u] 3532 } err] { 3457 set SVN [auto_execok svn] 3458 if [catch {set res [eval exec $SVN status [list $::expgui(gsasdir)] -u]} err] { 3533 3459 set ans [MyMessageBox -parent . -title "Error checking status" \ 3534 3460 -message "Error checking for updates: $err\n\nTry to update manually?" \ … … 3539 3465 } 3540 3466 return 3541 } else {3467 } else { 3542 3468 if {[string first "*" $res] == -1} { 3543 3469 MyMessageBox -parent . -title "No updates" \ 3544 -message "GSAS /EXPGUI appearsup-to-date" \3470 -message "GSAS & EXPGUI appear up-to-date" \ 3545 3471 -icon info 3546 3472 return 3547 3473 } 3548 3474 } 3475 3549 3476 if {[MyMessageBox -parent . -title "Ready to Update" \ 3550 3477 -message { 3551 Updates to GSAS/EXPGUI found .3478 Updates to GSAS/EXPGUI found on server. 3552 3479 3553 3480 Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \ … … 3559 3486 # special upgrade for windows, where the wish exec blocks upgrade of the exe directory 3560 3487 if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} { 3488 if {![file exists [file join $::expgui(gsasdir) update.bat]]} { 3489 MyMessageBox -parent . -title "No update.bat" \ 3490 -message "File update.bat was not found. This should not happen. Will try to create it now." 3491 set fp [open [file join $::expgui(gsasdir) update.bat] w] 3492 puts $fp {@REM this script must be run from the GSAS installation directory 3493 @REM This is run to update the installation, the name of the EXP file is 3494 @REM expected as an argument 3495 @echo **************************** 3496 @echo Press return to start update 3497 @echo **************************** 3498 @pause 3499 .\svn\bin\svn cleanup . 3500 .\svn\bin\svn update . 3501 @if (%1)==() goto Install2 3502 @echo **************************************************** 3503 @echo Update has completed. Press return to restart EXPGUI 3504 @echo **************************************************** 3505 @pause 3506 %COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1" 3507 exit 3508 :Install2 3509 @echo **************************************************** 3510 @echo Update has completed. EXPGUI starting w/o .EXP file 3511 @echo **************************************************** 3512 @pause 3513 %COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui" 3514 exit 3515 } 3516 close $fp 3517 } 3561 3518 # split the directory and EXP file and get rid os spaces in the directory name 3562 3519 set exp [file normalize $::expgui(expfile)] … … 3569 3526 3570 3527 # do a quiet cleanup. Sometimes needed after install, and never hurts 3571 if [catch {set res [e xec $SVN cleanup $::expgui(gsasdir)]} err] {3528 if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] { 3572 3529 MyMessageBox -parent . -title "Error in cleanup" \ 3573 3530 -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \ -
branches/sandbox/readexp.tcl
r1007 r1015 80 80 # 81 81 proc mapexp {} { 82 global exp map exparray82 global expgui expmap exparray 83 83 # clear out the old array 84 84 set expmap_Revision $expmap(Revision) … … 187 187 } 188 188 } 189 set expgui(mapstat) 1 189 190 } 190 191
Note: See TracChangeset
for help on using the changeset viewer.