Changeset 1025 for trunk/gsascmds.tcl


Ignore:
Timestamp:
Oct 13, 2010 2:27:15 PM (10 years ago)
Author:
toby
Message:

see https://subversion.xor.aps.anl.gov/trac/EXPGUI/wiki/News20101013

Location:
trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk

  • trunk/gsascmds.tcl

    r996 r1025  
    15171517proc rundisagl {} {
    15181518    global expgui txtvw tcl_version tcl_platform
     1519    # call up new DISAGL parm edit box
     1520    if {[DA_Control_Panel 1]} {return}
     1521    # Save the current exp file if needed
     1522    savearchiveexp
    15191523    if {$expgui(disaglSeparateBox)} {
    15201524        set root [file root $expgui(expfile)]
     
    19531957# validate and store the EXP file name. Create a new .EXP file if it does not
    19541958# exist and set the wd to the location of the .EXP file.
    1955 proc SetEXPfile {expfile} {
     1959proc SetEXPfile {expfile "newOK 0"} {
    19561960    global expgui tcl_platform
    19571961    set expgui(expfile) {}
     
    20662070    }
    20672071
    2068     if {! [file exists $newexpfile]} {
     2072    if {(! $newOK) && (! [file exists $newexpfile])} {
    20692073        update
    20702074        set ans [
     
    23462350    $box.can create window 0 0 -anchor nw  -window [frame $box.can.f -bd 2]
    23472351    $box.side create window 0 0 -anchor nw  -window [frame $box.side.f -bd 2]
    2348 
    23492352    grid columnconfig $box 1 -weight 1
    23502353    grid rowconfig $box 1 -weight 1
     
    23792382        grid $box.yscroll -sticky ns -column 2 -row 1
    23802383    } else {
    2381         grid forget $box.yscroll 
     2384        grid forget $box.yscroll
    23822385    }
    23832386    if {[lindex $sizes 2] > [winfo width $box.can]} {
    23842387        grid $box.scroll -sticky ew -column 1 -row 2
    23852388    } else {
    2386         grid forget $box.scroll
    2387     }
    2388 }
     2389        grid forget $box.scroll
     2390    }
     2391}
     2392
     2393proc MouseWheelScrollTable {box} {
     2394     # causes mouse wheel to operate scroll for main canvas in ScrollTable
     2395     # mousewheel can be operated anywhere in parent window
     2396    bind [winfo toplevel $box] <MouseWheel> "$box.can yview scroll \[expr {-abs(%D)/%D}\] unit"
     2397}
     2398
    23892399
    23902400# this is used in cifselect -- not sure why anymore
     
    33983408# Subversion support routines
    33993409#------------------------------------------------------------------------------
    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}
     3410
     3411proc GetSVNVersion {scriptdir} {
     3412    if {[CheckSVNinstalled]} {
     3413        set SVN [auto_execok svn]
     3414        if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} {
     3415            set infolist [split $res]
     3416            set pos [lsearch $infolist "Revision:"]
     3417            return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]"
     3418        }
     3419    }
     3420    return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])"
     3421}
     3422
     3423# can we find the svn program?
     3424proc CheckSVNinstalled {} {
    34043425    # can we find svn in the path?
    34053426    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     }
     3427    # add a locally supplied svn version and add to path
     3428    if {$::tcl_platform(platform) == "windows"} {
     3429        set s [file attributes $::expgui(gsasdir) -shortname]
     3430    } else {
     3431        set s $::expgui(gsasdir)
     3432    }
     3433    # look for svn
     3434    set localsvn [file join $s svn bin]
     3435    if {[file exists $localsvn]} {
     3436        if {$::tcl_platform(platform) == "windows"} {
     3437            set localsvn [file nativename $localsvn]
     3438            set sep {;}
     3439        } else {
     3440            set sep {:}
     3441        }
     3442        if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
     3443            append ::env(PATH) $sep $localsvn
     3444            # note that auto_reset breaks the tkcon package in Windows -- not sure why
     3445            auto_reset
     3446        }
     3447    }
     3448    if {[auto_execok svn] != ""} {return 1}
    34263449    return 0
    34273450}
    34283451
    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" \
     3452proc CheckAndDoUpdate { } {
     3453    if {! [CheckSVNinstalled]} {
     3454        MyMessageBox -parent . -title "SVN not found" \
     3455            -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" \
    34973456            -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" \
     3457        return
     3458    }
     3459    #is there a svn directory in the source?
     3460    if {! [file exists [file join $::expgui(gsasdir)  .svn]]} {
     3461        MyMessageBox -parent . -title "No .svn directory" \
     3462            -message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
    35053463            -icon error
    3506         return 0
    3507     }
    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     exit
    3514 }
    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 OK   
    35263464        return
    35273465    }
    3528     #set wish "[info nameofexecutable]"
    35293466    # check for updates
    3530     if [catch {
    3531         set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u]
    3532     } err] {
     3467    set SVN [auto_execok svn]
     3468    if [catch {set res [eval exec $SVN status [list $::expgui(gsasdir)] -u]} err] {
    35333469        set ans [MyMessageBox -parent . -title "Error checking status" \
    35343470                     -message "Error checking for updates: $err\n\nTry to update manually?" \
     
    35393475        }
    35403476        return
    3541     } else {
     3477     } else {
    35423478        if {[string first "*" $res] == -1} {
    35433479            MyMessageBox -parent . -title "No updates" \
    3544                 -message "GSAS/EXPGUI appears up-to-date" \
     3480                -message "GSAS & EXPGUI appear up-to-date" \
    35453481                -icon info
    35463482            return
    35473483        }
    35483484    }
     3485
    35493486    if {[MyMessageBox -parent . -title "Ready to Update" \
    35503487             -message {
    3551 Updates to GSAS/EXPGUI found.
     3488Updates to GSAS/EXPGUI found on server.
    35523489                 
    35533490Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \
     
    35593496    # special upgrade for windows, where the wish exec blocks upgrade of the exe directory
    35603497    if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
     3498        if {![file exists [file join $::expgui(gsasdir) update.bat]]} {
     3499            MyMessageBox -parent . -title "No update.bat" \
     3500                -message "File update.bat was not found. This should not happen. Will try to create it now."
     3501            set fp [open [file join $::expgui(gsasdir) update.bat] w]
     3502            puts $fp {@REM this script must be run from the GSAS installation directory
     3503@REM This is run to update the installation, the name of the EXP file is
     3504@REM expected as an argument
     3505@echo ****************************
     3506@echo Press return to start update
     3507@echo ****************************
     3508@pause
     3509.\svn\bin\svn cleanup .
     3510.\svn\bin\svn update .
     3511@if (%1)==() goto Install2
     3512@echo ****************************************************
     3513@echo Update has completed. Press return to restart EXPGUI
     3514@echo ****************************************************
     3515@pause
     3516%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1"
     3517exit
     3518:Install2
     3519@echo ****************************************************
     3520@echo Update has completed. EXPGUI starting w/o .EXP file
     3521@echo ****************************************************
     3522@pause
     3523%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui"
     3524exit
     3525            }
     3526            close $fp
     3527        }
    35613528        # split the directory and EXP file and get rid os spaces in the directory name
    35623529        set exp [file normalize $::expgui(expfile)]
     
    35693536
    35703537    # do a quiet cleanup. Sometimes needed after install, and never hurts
    3571     if [catch {set res [exec $SVN cleanup $::expgui(gsasdir)]} err] {
     3538    if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] {
    35723539        MyMessageBox -parent . -title "Error in cleanup" \
    35733540            -message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
Note: See TracChangeset for help on using the changeset viewer.