uninst.tcl

vxWorks 下DosFs2的补丁包！

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
}