home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cadre Technologies Inc. 1996
- #
- # File: @(#)docsection.tcl /main/3
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)docsection.tcl /main/3 5 Jun 1996 Copyright 1996 Cadre Technologies Inc.
-
- # Start user added include file section
- # End user added include file section
-
-
- Class DocSection : {Object} {
- method destructor
- constructor
- method promoter
- method edit
- method show
- method print
- method preview
- method docType
- method escape
- method execute
- method isDocDirUpToDate
- method updateDocDir
- method isDocDirTreeUpToDate
- method docLocation
- method docTitle
- method getTree
- method parentSection
- method childSectionSet
- method addChildSection
- method removeChildSection
- attribute uiType
- attribute initContents
- attribute operationClass
- attribute extension
- attribute indentation
- attribute _parentSection
- attribute document
- attribute _childSectionSet
- }
-
- method DocSection::destructor {this} {
- set ref [$this _parentSection]
- if {$ref != ""} {
- [$ref _childSectionSet] removeValue $this
- }
- foreach ref [[$this _childSectionSet] contents] {
- $ref _parentSection ""
- }
- # Start destructor user section
- # End destructor user section
- }
-
- constructor DocSection {class this name document} {
- set this [Object::constructor $class $this $name]
-
- # Don't call promoter twice
- if {! [$this isA BrowsUiObj]} {
- $this promoter
- }
-
- return $this
- }
-
- method DocSection::promoter {this document} {
- $this document $document
- $this _childSectionSet [List new]
-
- # the default operationClass of a section is import
- $this operationClass import
- # the default document filetype is an ascii one
- $this indentation 0
-
- set name ""
- regsub -all " |\t" [$this uiName] "" name
-
- if {[$this getPropertyValue fileSystemPath] == ""} {
- set type [$this type]
- if {[regsub -all {:} $name {_} new]} {set name $new}
- if {[$this extension] != ""} {
- set name ${name}_$type.[$this extension]
- } else {
- set name ${name}_$type
- }
- $this setProperty fileSystemPath $name
- }
- }
-
- method DocSection::edit {this} {
-
- # default no edit possible
- wmtkerror "No edit possible for this section."
- }
-
- method DocSection::show {this} {
-
- # default no show possible
- wmtkerror "No show possible for this section."
- }
-
- method DocSection::print {this} {
-
- # default no print possible
- wmtkerror "No print possible for this section."
- }
-
- method DocSection::preview {this} {
-
- # default no preview possible
- wmtkerror "No preview possible for this section."
- }
-
- method DocSection::docType {this} {
-
- # default the doctype and the type are the same
- return [$this type]
- }
-
- method DocSection::escape {this command} {
-
- set sn $command
- #if {[regsub -all {'} $sn {\\'} snn]} {set sn $snn}
- #if {[regsub -all {`} $sn {\\`} snn]} {set sn $snn}
- #if {[regsub -all {"} $sn {\\"} snn]} {set sn $snn}
- #if {[regsub -all {>} $sn {\\>} snn]} {set sn $snn}
- #if {[regsub -all {<} $sn {\\<} snn]} {set sn $snn}
- #if {[regsub -all {!} $sn {\\!} snn]} {set sn $snn}
- #if {[regsub -all {&} $sn {\\&} snn]} {set sn $snn}
- if {[regsub -all {\(} $sn {\\(} snn]} {set sn $snn}
- if {[regsub -all {\)} $sn {\\)} snn]} {set sn $snn}
- return $sn
- }
-
- method DocSection::execute {this args} {
-
- # return 0 on error, 1 on succes
-
- if {$args == ""} {
- return 0
- }
-
- set cmd [lindex $args 0]
- set kind [lindex $args 1]
- case "$kind" in {
- {mtool xtool} {
- set msg "Starting `[lindex $cmd 0]`"
- $wmttoolObj startCommand $kind "$cmd" "" "$msg" {0 0} 0
- return 1
- }
- {m4} {
- set m4Cmd [lindex $cmd 0]
- set m4CmdArgs [lindex $cmd 1]
- set obj [lindex $cmd 2]
- $wmttoolObj startM4Command \
- "[$this escape $m4Cmd]" \
- "[$this escape $m4CmdArgs]" \
- "" "$obj"
- return 1
- }
- {default} {
- set sysCmd [lindex $cmd 0]
- set obj [lindex $cmd 1]
- if [system [$this escape "$sysCmd"]] {
- wmtkmessage \
- "Executing '[lindex $sysCmd 0]' for '$obj' failed"
- return 0
- } else {
- return 1
- }
- }
- }
- }
-
- method DocSection::isDocDirUpToDate {this} {
-
- # default alway uptodate
- return 1
- }
-
- method DocSection::updateDocDir {this} {
-
- # default nothing happens
- return 1
- }
-
- method DocSection::isDocDirTreeUpToDate {this} {
-
- set tree [$this getTree]
- set notUpToDate ""
-
- foreach node $tree {
- if {![$node isDocDirUpToDate]} {
- set notUpToDate "$notUpToDate $node"
- }
- }
-
- return $notUpToDate
- }
-
- method DocSection::docLocation {this} {
-
- return [$this pathName]
- }
-
- method DocSection::docTitle {this} {
-
- return [$this uiName]
- }
-
- method DocSection::getTree {this} {
-
- set tree {}
-
- [$this childSectionSet] foreach sect {
- set tree "$tree $sect [$sect getTree]"
- }
-
- return $tree
- }
-
- proc DocSection::isAscii {} {
- return 1
- }
-
- # Do not delete this line -- regeneration end marker
-
- method DocSection::parentSection {this args} {
- if {$args == ""} {
- return [$this _parentSection]
- }
- set ref [$this _parentSection]
- if {$ref != ""} {
- [$ref _childSectionSet] removeValue $this
- }
- set obj [lindex $args 0]
- if {$obj != ""} {
- [$obj _childSectionSet] append $this
- }
- $this _parentSection $obj
- }
-
- method DocSection::childSectionSet {this} {
- return [$this _childSectionSet]
- }
-
- method DocSection::addChildSection {this newChildSection} {
- [$this _childSectionSet] append $newChildSection
- $newChildSection _parentSection $this
- }
-
- method DocSection::removeChildSection {this oldChildSection} {
- $oldChildSection _parentSection ""
- [$this _childSectionSet] removeValue $oldChildSection
- }
-
-