PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/ucustfuiob.tcl

Text File | 1996-12-12 | 5.3 KB | 195 lines

#---------------------------------------------------------------------------
#
#      (c)     Cadre Technologies Inc.    1996
#
#      File:           @(#)ucustfuiob.tcl    /main/hindenburg/5
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)ucustfuiob.tcl    /main/hindenburg/5   12 Dec 1996 Copyright 1996 Cadre Technologies Inc.

# Start user added include file section
# End user added include file section

require "browsuiobj.tcl"

Class UCustFUiObj : {BrowsUiObj} {
    constructor
    method destructor
    method addExternalFile
    method externalFiles
    method printObjects
    method removeObjects
    attribute pattern
}

global UCustFUiObj::uiClass
set UCustFUiObj::uiClass "UserCustomFiles"


constructor UCustFUiObj {class this name} {
    set this [BrowsUiObj::constructor $class $this $name]
    # Start constructor user section

    $this uiName "<user customization files>"
    $this uiText "user customization files"
    $this pattern "*"

    # End constructor user section
    return $this
}

method UCustFUiObj::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this BrowsUiObj::destructor
}

method UCustFUiObj::addExternalFile {this} {
    foreach childType [UCustFUiObj::externalFileNames] {
    set externalFileList($childType) 1
    }
    foreach externalFile [$this getChildSet externalFiles] {
    set type [$externalFile uiName]
    if [info exists externalFileList($type)] {
        unset externalFileList($type)
    }
    }
    if [info exists externalFileList] {
    set entrySet [lsort [array names externalFileList]]
    } else {
    set entrySet ""
    }

    require "editseldia.tcl"
    set box $wmttoolObj.newExternalF
    ClassMaker::extend EditSelDialog NewExternalFileEditSelDialog uiObj
    NewExternalFileEditSelDialog new $box \
    -title "New External File" \
    -message "External File:" \
    -entrySet $entrySet \
    -uiObj $this \
    -okPressed {
        set file [%this text]
        set selection [splitFileName $file]
        set name [lindex $selection 0]
        set type [lindex $selection 1]
        case "$type" in {
        {opendefs openlocs propdefs proplocs} {
            wmtkerror "External file of type $type not supported"
            %this delete
            return
        }
        }
        set script "global UCustFUiObj:custF"
        append script " ;"
        append script " set UCustFUiObj:custF \[CustFileUtilities::make \
        \"\" [list $name] [list $type] \
        \]"
        require "custfileut.tcl"
        $wmttoolObj startCommand tcl \
        "$script" "" \
        "Creating external file '$file'" \
        {1 0} 1
        %this delete
    } \
    -editPressed {
        if [info exists UCustFUiObj:custF] {
        if [file isfile ${UCustFUiObj:custF}] {
            regsub -all " |\\." "[$this text]" "_" fileId
            [$this uiObj].ExternalFile:$fileId editFile
        }
        }
    }
    $box popUp
}

proc UCustFUiObj::associations {} {
    return {externalFiles}
}

proc UCustFUiObj::childTypes {assoc} {
    if {[lsearch -exact "[UCustFUiObj::associations]" "$assoc"] == -1} {
    return ""
    }
    return [BrowserProcs::childTypes $assoc]
}

proc UCustFUiObj::externalFileNames {} {
    return [list \
    cad.mnu cad.pnl ccd.mnu ccd.pnl checkconfig class.mnu desk.mnu \
    desk.vie dfd.mnu dfd.pnl diagram.mnu etd.mnu etd.pnl mgd.mnu mgd.pnl \
    objtype.objtype roundtrip.roundtrip std.mnu std.pnl ucd.mnu ucd.pnl \
    u_clbrowse.tcl u_desk.tcl u_docbatch.tcl u_uce.tcl u_ude.tcl \
    [path_name file [m4_var meta4UserEnv]] \
    ]
}

method UCustFUiObj::externalFiles {this} {
    set externalFiles ""
    set crntPath [pwd]
    cd ~
    if [catch {cd icase}] {
    BasicFS::makeDir icase
    cd icase
    }
    if [catch {set files [glob [$this pattern]]}] {
    set files ""
    }
    set meta4UserEnv [m4_var meta4UserEnv]
    if [file exists "$meta4UserEnv"] {
    lappend files "$meta4UserEnv"
    }
    foreach file [lsort $files] {
    if {! [file isfile $file]} continue
    regsub -all " |\\." "$file" "_" fileId
    set externalFile $this.${ExtFUiObj::uiClass}:$fileId
    if {! [isCommand $externalFile]} {
        ExtFUiObj new $externalFile \
        -parent $this \
        -uiName "$file" \
        -directory [pwd]
    }
    lappend externalFiles $externalFile
    }
    cd $crntPath
    return "$externalFiles"
}

proc UCustFUiObj::infoProperties {} {
    return [BrowserProcs::infoProperties]
}

method UCustFUiObj::printObjects {this} {
    set asciiFiles ""
    foreach obj [$wmttoolObj selectedObjSet] {
    lappend asciiFiles [path_name concat [$obj directory] [$obj uiName]]
    }
    BrowserProcs::printObjects $asciiFiles "" ""
}

method UCustFUiObj::removeObjects {this} {
    set box $wmttoolObj.removeWarning
    WarningDialog new $box \
    -title "Delete Warning" \
    -message [BrowserProcs::removeMessage] \
    -helpPressed {.main helpOnName removeWarning} \
    -cancelPressed {%this delete} \
    -okPressed {
        set script ""
        foreach obj [$wmttoolObj selectedObjSet] {
        if {"$script" != ""} {
            append script " ;"
        }
        append script [list BasicFS::removeFile \
            [path_name concat [$obj directory] [$obj uiName]]]
        }
        $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
        %this delete
    }
    $box popUp
}

# Do not delete this line -- regeneration end marker