PC World 1998 October/PCWorld_1998-10_cd.bin/software/prehled/komix/DATA.Z/custdefsar.tcl

Text File | 1997-04-24 | 5KB | 190 lines

#---------------------------------------------------------------------------
#
#      (c)     Cayenne Software Inc.    1997
#
#      File:           @(#)custdefsar.tcl    /main/titanic/1
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)custdefsar.tcl    /main/titanic/1   24 Apr 1997 Copyright 1997 Cayenne Software Inc.

# Start user added include file section
require "custobjvie.tcl"
require "config.tcl"
# End user added include file section

require "custedarea.tcl"

Class CustDefsArea : {CustEdArea BrowsView} {
    method destructor
    constructor
    method readUserObjects
    method readLevelObjects
    method read
    method readDefs
    method readModules
    method readConfig
    method parseDefs
    method deleteObjects
    method writeObject
    method getObjects
    method clearArea
    method dropEvent
}

method CustDefsArea::destructor {this} {
    # Start destructor user section
    # End destructor user section
    $this CustEdArea::destructor
}

constructor CustDefsArea {class this name} {
    set this [BrowsView::constructor $class $this $name]
    set this [CustEdArea::constructor $class $this $name]

    global classCount
    $this filter [CustObjViewFilter new CustObjViewFilter$classCount $this]
    incr classCount

    return $this
}

method CustDefsArea::readUserObjects {this} {
    # not supported at user level
}

method CustDefsArea::readLevelObjects {this} {
    set levelIndex [expr [llength [$this _path]] - 1]
    $this read [lindex [$this _path] $levelIndex] [$this _level]
}

method CustDefsArea::read {this object type} {
    set fileName [$this _curName]
    set fileType [$this _curType]
    $this parseLines [$this readConfig $object $fileName $fileType] $type
    $this readModules $object parseLines $fileName $fileType $type
}

method CustDefsArea::readDefs {this object type} {
    set fileName [$this _curName]
    set fileType [$this _curType]
    set nameLast [expr [string last locs $fileName] - 1]
    set typeLast [expr [string last locs $fileType] - 1]
    set defsName [string range $fileName 0 $nameLast]defs
    set defsType [string range $fileType 0 $typeLast]defs
    $this parseDefs [$this readConfig $object $defsName $defsType] $type
    $this readModules $object parseDefs $defsName $defsType $type
}

method CustDefsArea::readModules {this obj parse name type level} {
    if {![$obj isA Corporate]} {
        return
    }
    set moduleHdlr [.main moduleHdlr]
    foreach module [$moduleHdlr moduleSpecSet] {
        foreach file [$moduleHdlr getFiles etc $name.$type $module] {
            $this _module [$module name]
            $this $parse [readConfigurationFile $file] $level
        }
    }
    $this _module ""
}

method CustDefsArea::readConfig {this obj name type} {
    set custFile [CustFileUtilities::find $obj $name $type]
    if {"$custFile" == ""} {
        return ""
    }
    if [$obj isA Corporate] {
        if {![file exists $custFile]} {
            return ""
        }
        set lineList [readConfigurationFile $custFile]
    } else {
        set tmpFile [args_file {}]
        $custFile downLoad $tmpFile
        set lineList [readConfigurationFile $tmpFile]
        unlink $tmpFile
    }
    return $lineList
}

method CustDefsArea::parseDefs {this lines level} {
    # implemented for LocEdArea classes, for other derived classes empty
}

method CustDefsArea::deleteObjects {this objs} {
    set index 0
    $this CustEdArea::deleteObjects $objs
    foreach obj [$this objectSet] {
        $obj index $index
        incr index
    }
}

method CustDefsArea::writeObject {this obj fid} {
    $obj writeObject $fid
}

method CustDefsArea::getObjects {this} {
    return [$this objectSet]
}

method CustDefsArea::clearArea {this} {
    foreach obj [$this objectSet] {
        $obj delete
    }
    .main selectionChanged
}

method CustDefsArea::dropEvent {this droppedObject srcIsDst droppedAfterObject droppedForObject} {
    if {$srcIsDst == 0} {
        wmtkerror "Drag & drop between tools is not supported (yet)."
        return
    }
    if {![$droppedObject editable]} {
        wmtkerror "Object not moved, reason: object not editable."
        return
    }
    if {$droppedForObject != ""} {
        if {[$droppedForObject specLevel] != [$droppedObject specLevel]} {
        wmtkerror "Object can not be moved to a higher level."
        return
        }
    }
    set newIndex 0
    set oldIndex [$droppedObject index]
    if {$droppedAfterObject != ""} {
        set newIndex [$droppedAfterObject index]
        if {$newIndex < $oldIndex} {
            incr newIndex
        }
    }
    foreach obj [$this objectSet] {
        set objIndex [$obj index]
        if {$objIndex >= $newIndex && $objIndex < $oldIndex} {
            $obj index [expr $objIndex + 1]
        } elseif {$objIndex > $oldIndex && $objIndex <= $newIndex} {
            $obj index [expr $objIndex - 1]
        }
    }
    $droppedObject index $newIndex
    $this sort -command "CustDefsArea::compare"
    $this isChanged 1
}

proc CustDefsArea::compare {objA objB} {
    set idxA [$objA index]
    set idxB [$objB index]
    if {$idxA > $idxB} {
        return 1
    }
    if {$idxB > $idxA} {
        return -1
    }
    return 0
}

# Do not delete this line -- regeneration end marker