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

Text File | 1996-10-22 | 5KB | 224 lines

#---------------------------------------------------------------------------
#
#      (c)     Cadre Technologies Inc.    1996
#
#      File:           @(#)menupartno.tcl    1.12
#      Author:         <generated>
#      Description:
#---------------------------------------------------------------------------
# SccsId = @(#)menupartno.tcl    1.12   04 Apr 1996 Copyright 1996 Cadre Technologies Inc.

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

require "custbrowso.tcl"

Class MenuPartNode : {CustBrowsObject BrowsNode} {
    method destructor
    constructor
    method displayName
    method infoList
    method updateView
    method open
    method check
    method changeDotName
    attribute parentType
    attribute id
    attribute redefined
}

method MenuPartNode::destructor {this} {
    # Start destructor user section
    if [isCommand .main] {
        set area [.main editorArea]

        if [isCommand $area] {
            set names [$area getMenuPartNode [$this name]]
            set newNames ""
            foreach j $names {
                if {$j != $this} {
                    set newNames "$newNames $j"
                }
            }
            if {![lempty $newNames]} {
                $area setMenuPartNode [$this name] $newNames
            } else {
                $area removeMenuPartNode [$this name]
            }
        }
    }
    # End destructor user section
    $this CustBrowsObject::destructor
}

constructor MenuPartNode {class this name specification} {
    set this [BrowsNode::constructor $class $this $name]
    set this [CustBrowsObject::constructor $class $this $name]

    $this config -activated {%this open} -id $this \
        -conversionSet "WMT_MENUNODE id"

    while {![lempty $specification]} {
        set key [lvarpop specification]
        $this $key [lvarpop specification]
    }

    set specification [$this objSpec]

    set index [lsearch -exact $specification "label"]
    if {$index != -1} {
        incr index
        $this displayName [lindex $specification $index]
    }

    return $this
}

method MenuPartNode::displayName {this args} {

    if {$args == ""} {
        return [$this _displayName]
    } else {
        $this _displayName [join $args]
        if { [$this type] != "CustMenuBarButton"} {
            if { [$this parent] != "" } {
                $this changeDotName [[$this parent] name].menu
            }
        } else {
            $this changeDotName ""
        }
    }
}

method MenuPartNode::infoList {this} {

    set list [$this CustBrowsObject::infoList]
    set list [concat $list Visible]
    if [$this alwaysVisible] {
        set list [concat $list always]
    } else {
        set visible ""
        if [lindex [$this visible] 0] {
            lappend visible corporate
        }
        if [lindex [$this visible] 1] {
            lappend visible project
        }
        if [lindex [$this visible] 2] {
            lappend visible config.
        }
        if [lindex [$this visible] 3] {
            lappend visible phase
        }
        if [lindex [$this visible] 4] {
            lappend visible system
        }
        set list [concat $list \{$visible\}]
    }
    set list [concat $list "MenuPath"]
    set list [concat $list [$this name]]
    set list [concat $list "index"]
    set list [concat $list [$this index]]

    return $list
}

method MenuPartNode::updateView {this} {

    set editStatus  ""
    if [$this editable] {
        set editStatus "*"
    }

    $this label "[$this _displayName] $editStatus"
}

method MenuPartNode::open {this} {
}

method MenuPartNode::check {this newScope newVisible newSpecLevel newParent} {

    #check if parent is always available for this object
    set parent $newParent

    if {[$parent specLevel] == "user" && $newSpecLevel != "user"} {
        return "An user-defined parent, can not have not-user-defined \
            children"
    }

    set parentVisible [$parent visible]
    set objectVisible $newVisible

    set index 0
    foreach i $objectVisible {
        if {$i == 1} {
            if {[lindex $parentVisible $index] == 0} {
                return  "Parent not always available"
            }
        }
        incr index
    }

    set parentScope [$parent scope]
    set objectScope $newScope

    if {[llength $objectScope] < [llength $parentScope]} {
        return "Parent is not available when child should be present"
    }

    # check from current scope not from begin because begin
    # is (should be) *
    set area [.main editorArea]
    set curScope [$area _scope]
    set index [llength $curScope]
    foreach i [lrange $objectScope $index end] {
        set x [lindex $parentScope $index]
        if {$x == ""} {
            break
        }
        if {$x != "*" } {
            # if not always on this level, check if parent
            # is on this level when child is.
            if {$i == "*"} {
                return "Parent not always available"
            }
            foreach y $i {
                if {[lsearch $x $y] == -1 } {
                    return "Parent not always available"
                }
            }
        }
        incr index
    }

    return ""
}

method MenuPartNode::changeDotName {this newDotName} {

    set tclName [MenuEdArea::makeTclName [$this displayName]]
    set newObjs ""

    foreach i [[$this tree] getMenuPartNode [$this name]] {
        if {$i != $this} {
            set newObjs "$newObjs $i"
        }
    }
    if {![lempty $newObjs]} {
        [$this tree] setMenuPartNode [$this name] $newObjs
    } else {
        [$this tree] removeMenuPartNode [$this name]
    }
    $this name $newDotName.$tclName
    set objs [[$this tree] getMenuPartNode [$this name]]
    set objs "$objs $this"
    [$this tree] setMenuPartNode [$this name] $objs

    foreach i [$this childSet] {
        $i changeDotName [$this name].menu
    }
}

# Do not delete this line -- regeneration end marker