uninst.tcl

基于VxWorks的图形界面开发工具Zinc6.0的升级补丁。

    global uninst
    global argv
    global env

    applicationTitleSet "Tornado Uninstall"

    if {$uninst(mode) == "none"} {
       messageBox -stop "Cannot find the uninstall information."
       windowClose uninstDlg

    } elseif {$uninst(mode) == "all"} {
       controlValuesSet uninstDlg.uninstAll 1
       controlEnable uninstDlg.uninstPart 0
       onUninstallAll
    } {
       controlValuesSet uninstDlg.uninstPart 1
       onUninstallPart
    }
}

proc dosTempDirGet {} {
    global env

    # Determine the "temp" directory

    set uninstTemp "_TMP[pid]"

    foreach elem [array names env] {
       if {[string compare [string tolower $elem] "tmp"] == 0} {
           set env(TMP) $env($elem)
       }
       if {[string compare [string tolower $elem] "temp"] == 0} {
           set env(TEMP) $env($elem)
       }
       if {[string compare [string tolower $elem] "tmpdir"] == 0} {
           set env(TMPDIR) $env($elem)
       }
    }

    if {[info exists env(TEMP)] && [file isdir $env(TEMP)]} {
        set TMP $env(TEMP)\\$uninstTemp

    } elseif {[info exists env(TMP)] && [file isdir $env(TMP)]} {
        set TMP $env(TMP)\\$uninstTemp

    } elseif {[info exists env(TMPDIR)] && [file isdir $env(TMPDIR)]} {
        set TMP $env(TMPDIR)\\$uninstTemp
    } {
        set TMP "C:\\$uninstTemp"
    }

    return $TMP
}

proc seedUninstall {} {
    global env argv0 uninst

    set env(TMP) [unixToDos [dosTempDirGet]]

    set binDir [unixToDos "$uninst(WIND_BASE)\\host\\x86-win32\\bin"]
    set uninstDir [unixToDos "$uninst(WIND_BASE)\\.wind\\uninst"]

    set requiredFiles(mfc42.dll) $binDir
    set requiredFiles(msvcrt.dll) $binDir
    set requiredFiles(pctree32.dll) $binDir
    set requiredFiles(tcl.dll) $binDir
    set requiredFiles(uitcl.dll) $binDir
    set requiredFiles(setuptcl.dll) $binDir
    set requiredFiles(uitclsh.exe) $binDir
    set requiredFiles(uninst.tcl) $uninstDir
    set requiredFiles(uninst.bmp) $uninstDir

    # create the batch file that will copy required files and invoke uitclsh.exe

    catch {file mkdir $env(TMP)}
    set tmpBatchFileName "$env(TMP)\\tmp[pid].bat"

    if [catch {open $tmpBatchFileName w} tmpBatchFile] {
        set error $tmpBatchFile
    } {
        if [catch {
            # write the necessary commands to execute from within the batch file

            foreach file [array names requiredFiles] {
                puts $tmpBatchFile \
                   "copy $requiredFiles($file)\\$file $env(TMP)"
            }

            # set the environment variables that's needed for the uninst.tcl

            puts $tmpBatchFile "set UI=UITcl"
            puts $tmpBatchFile "set TMP="
            puts $tmpBatchFile "set TMP=[dosToUnix $env(TMP)]"

            if {"[setupWinVerGet]" == "WIN95"} {
                puts $tmpBatchFile "set PATH=[setupWinDirGet]\\command;%PATH%"
            }

            set flag ""

            if [info exists env(SETUP_DEBUG)] {
                set flag "-C"
            }

            puts $tmpBatchFile "start /wait \
                 $env(TMP)\\uitclsh.exe $flag \
                 [dosToUnix $env(TMP)\\uninst.tcl] \
                 $uninst(WIND_BASE)"

            puts $tmpBatchFile "cd \\"

            if {"[setupWinVerGet]" == "WIN95"} {
                puts $tmpBatchFile "deltree /Y $env(TMP)"
            } {
                puts $tmpBatchFile "rmdir /S /Q $env(TMP)"
            }

            close $tmpBatchFile
        } errorX] {set error $errorX}
    }

    # now spawn the batch file

    if ![info exists error] {
        if [catch {processCreate -hidden $tmpBatchFileName $env(TMP)} errorX] {
            set error $errorX
        }
    }

    if [info exists error] {
        messageBox "Error launching Setup program: $error"
        return ""
    }
}
########################################################################
#
# Common functions
#

proc date {} {
    return [clock format [clock second] -format "%d-%b-%y.%H:%M"]
}

proc dosToUnix {path} {
    regsub -all {\\} $path {/} newpath
    return $newpath
}

proc unixToDos {path} {
    regsub -all {/} $path {\\} newpath
    return $newpath
}

proc print {msg} {
    global env

    if [info exists env(SETUP_DEBUG)] {
        puts "$msg"
    }
}

proc meterUpdate {percent tag1 tag2} {
    global ctrlVals
    global uninst
    global env

    set shortFileName [fileNameAppreviate $tag2]

    if {"$env(UI)" == "TK"} {
       setWidth $ctrlVals(meterWg) $percent
       $ctrlVals(meterTagWg) config -text "$tag1 $shortFileName"
       update
    } elseif {"$env(UI)" == "UITcl"} {
       controlValuesSet uninstDlg.progress $percent
       controlValuesSet uninstDlg.progressTag "$tag1 $shortFileName"
       uiEventProcess
    } {
       puts "$percent $tag1 $tag2"
    }
}

proc message {msg} {
    global uninst
    global env

    if {"$env(UI)" == "TK"} {
       tk_dialog .uninst "Uninstall" $msg info 0 OK
    } elseif {"$env(UI)" == "UITcl"} {
       messageBox -ok -information $msg
    } {
       puts "$msg" 
    }
}

proc dialog {type title msg bitmap default} {
    global env

    switch $type {
        re_ig_cancel {
            if {"$env(UI)" == "TK"} {
                return [tk_dialog .uninst $title $msg $bitmap $default \
                                   Retry Ignore Cancel]
            } elseif {"$env(UI)" == "UITcl"} {
                switch [messageBox -abortretryignore -questionicon $msg] {
                    abort  { return 2 }
                    retry  { return 0 }
                    ignore { return 1 }
                }
            }
        }
    }
}

proc lastInstSessionInfoGet {} {
    global uninst env

    set zipFile \
        [lindex [lsort -decreasing \
                       [glob -nocomplain $uninst(home)/data.???]] 0]

    set saveDir [pwd]
    cd $env(TMP)

    catch {setupUnzip -o -qq $zipFile "installInfo"}

    if [file exists "installInfo"] {
        set f [open "installInfo" "r"]
        set uninst(info) [read $f]
        close $f
    }
}

proc uninstInfoGet {} {
    global uninst
    global env

    set uninst(currItem) 1
    set uninst(totalItem) 1
    set uninst(resList) ""
    set uninst(fileList) ""
    set uninst(bakList) ""

    set uninstZipFileList \
        [lsort -decreasing [glob -nocomplain $uninst(home)/data.???]]

    if {"$uninst(mode)" == "part"} {
        set uninst(zipFile) [lindex $uninstZipFileList 0]
        uninstInfoGetHelpper $uninst(zipFile)

    } elseif {"$uninst(mode)" == "all"} {
        foreach zipFile $uninstZipFileList {
            uninstInfoGetHelpper $zipFile
        }
    }

    print "uninst(resList) = $uninst(resList)"
    print "uninst(totalItem) = $uninst(totalItem)"
}
    
proc uninstInfoGetHelpper {zipFile} {
    global uninst
    global env

    set saveDir [pwd]
    cd $env(TMP)

    catch {setupUnzip -o -qq $zipFile "install*"}

    # Load the installed file list

    if [file exists "installFile"] {
        set f [open "installFile" "r"]

        while {[gets $f line] != "-1"} {
            if {"$line" != ""} {
                lappend uninst(fileList) [split $line "\t"]
            }
        }
        close $f
    }

    # Load the backup file list

    if [file exists "installBackup"] {
        set f [open "installBackup" "r"]

        while {[gets $f line] != "-1"} {
            if {"$line" != ""} {
                lappend uninst(bakList) [split $line "\t"]
            }
        }
        close $f
    }

    # Load the resource file list

    if [file exists "installResource"] {
        set f [open "installResource" "r"]

        while {[gets $f line] != "-1"} {
            if {"$line" != ""} {
                lappend uninst(resList) [split $line "\t"]
            }
        }
        close $f
    }

    incr uninst(totalItem) [llength $uninst(fileList)]
    incr uninst(totalItem) [llength $uninst(resList)]
 
    if {"$uninst(mode)" == "part"} {
        incr uninst(totalItem) [llength $uninst(bakList)]
    }
  
    cd $saveDir
}

proc fileNameAppreviate {fileName} {
    set shortName $fileName

    if {[string length $fileName] > 35} {
       if [regexp {(^[^/]+)/.*/([^/]+/[^/]+$)} $fileName junk \
            firstPart lastPart] {
           set shortName "$firstPart/.../$lastPart"
       }
    } 
    return $shortName
}


proc uninstBackup {} {
    global uninst
    global env

    foreach line $uninst(bakList) {
       set file [lindex $line 1]

       switch [lindex $line 0] {
           wind_base { 
               incr uninst(currItem)
               set percent [expr ($uninst(currItem) * 99) / $uninst(totalItem)]
               meterUpdate $percent "Restoring " $file

               if [catch {setupUnzip -o -qq $uninst(zipFile) \
                      -d $uninst(WIND_BASE) $file} error] {
                   incr uninst(errorCount) 
                   message "Cannot restore $file: $error"
               } 
           }
           default { puts "unknown rootdir token" }
       }
    }
}

proc dirInsert {pathName} {
    global dirArray

    set dirArray($pathName) ""

    while { 1 } {
        set pathName [file dirname $pathName]
        if {$pathName == "."} {
            break
        } {
            set dirArray($pathName) ""
        }
    }
}

proc dirRemove {} {
    global dirArray uninst

    # delete the innermost empty directory first

    foreach dir [lsort -decreasing [array names dirArray]] {
        catch {file delete $uninst(WIND_BASE)/$dir}
    }
}

proc uninstFile {} {
    global uninst
    global env

    foreach line $uninst(fileList) {
       set file [lindex $line 1]

       switch [lindex $line 0] {
           wind_base { 
               set filePath $uninst(WIND_BASE)/$file 
               dirInsert [file dirname $file]
           }
           window {
               if {[file extension $file] == ".CPL"} {
                   catch {setupWindowClose "Control Panel"}
               }
               set filePath [setupWinDirGet]/$file
           }
           default { puts "unknown rootdir [lindex $line 0]" }
       }

       incr uninst(currItem)
       set percent [expr ($uninst(currItem) * 99) / $uninst(totalItem)]
       meterUpdate $percent "Removing " $file

       if [file exists $filePath] {
           while {[catch {file delete $filePath} error]} {
               switch [dialog re_ig_cancel "Uninstall" "$error" question 0] {
                   0 { unset error }
                   1 { incr uninst(errorCount); break } 
                   2 { incr uninst(errorCount); return }
               }
           }
       }
    }

    # remove all empty directory
    set percent [expr ($uninst(currItem) * 99) / $uninst(totalItem)]
    meterUpdate $percent "Removing" "directories..."
    dirRemove
}

proc onUninstallPart {{default direct}} {
    global uninst
    global env

    set uninst(mode) part
    lastInstSessionInfoGet

    set message "Uninstall will remove the above component(s) \
                from $uninst(WIND_BASE) and restore the previous state."

    set i 0
    foreach line [split $uninst(info) "\n"] {
       if {$i > 5} { 
           append info "..."
           break
       }
       incr i
       if {"$line" != ""} {
           append info "$line\n"
       }
    }

    if {"$env(UI)" == "TK"} {
        .mainFrm.installInfo config -text $info
        .mainFrm.message config -text $message

    } elseif {"$env(UI)" == "UITcl"} {
        controlValuesSet uninstDlg.message $message
        controlValuesSet uninstDlg.installInfo $uninst(info)    
    }
}


proc onUninstallAll {{default direct}} {
    global uninst
    global env

    set uninst(mode) all
    set message "Warning: Uninstall removes ALL of the standard Tornado files\
            under $uninst(WIND_BASE), including files you may have modified. \
            Be sure to backup any modified files before continuing.  Note that\
	    user private files are not removed."
  
    if {"$env(UI)" == "TK"} {
        .mainFrm.message config -text $message
        .mainFrm.installInfo config -text ""

    } elseif {"$env(UI)" == "UITcl"} {
        controlValuesSet uninstDlg.message $message
        controlValuesSet uninstDlg.installInfo "" 
    }
}

proc uninstText {} {
    puts "Not implemented yet."
}


###################################################################
#
# Entry point of the Uninstall program.
#

proc start {} {
    global uninst
    global env
    global argv

    foreach elem [array names env] {
       if {[string compare [string tolower $elem] "tmp"] == 0} {
           regsub -all {\\} $env($elem) {/} env(TMP)
       }
       if {[string compare [string tolower $elem] "ui"] == 0} {
           regsub -all {\\} $env($elem) {/} env(UI)
       }
    }

    load $env(TMP)/setuptcl[info sharedlibextension]

    set uninst(errorCount) 0
    set uninst(home) $uninst(WIND_BASE)/.wind/uninst
    
    switch [llength [glob -nocomplain $uninst(home)/data.???]] {
       "0" {
           set uninst(mode) "none"
       }
       "1" {
           set uninst(mode) "all"
       }
       default {
           set uninst(mode) "part"
       }
    }

    if {"$env(UI)" == "TK"} {
        uninstTK

    } elseif {"$env(UI)" == "UITcl"} {
        uninstWin32

    } {
        uninstText
    }
}

set string(header) "This program uninstalls Tornado software\
                    from this machine.  Please select one of\
                    following choices."

set string(button1) "Uninstall the entire Tornado"
set string(button2) "Uninstall the last installed session."

if {"[lindex $argv 1]" == "-seed"} {
    load $uninst(WIND_BASE)/host/x86-win32/bin/setuptcl.dll
    seedUninstall
} {
    start
}