home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Cadre Technologies Inc. 1996
- #
- # File: @(#)draginfoob.tcl /main/hindenburg/2
- # Author: <generated>
- # Description:
- #---------------------------------------------------------------------------
- # SccsId = @(#)draginfoob.tcl /main/hindenburg/2 30 Jul 1996 Copyright 1996 Cadre Technologies Inc.
-
- # Start user added include file section
- # End user added include file section
-
- require "infoobject.tcl"
-
- Class DragInfoObj : {InfoObject} {
- constructor
- method destructor
- method promoter
- method contextList
- }
-
- constructor DragInfoObj {class this name browsUiObj} {
- set this [InfoObject::constructor $class $this $name $browsUiObj]
- # Start constructor user section
-
- $this promoter
-
- # End constructor user section
- return $this
- }
-
- method DragInfoObj::destructor {this} {
- # Start destructor user section
- # End destructor user section
- $this InfoObject::destructor
- }
-
- method DragInfoObj::promoter {this} {
- $this conversionSet "BROWSUIOBJ contextList"
- }
-
- method DragInfoObj::contextList {this} {
- set context ""
- set uiObj [$this browsUiObj]
- set proj [$uiObj getParent Project]
- if {"$proj" != ""} {
- lappend context [$proj getInfo Identity]
- set confV [$uiObj getParent ConfigVersion]
- if {"$confV" != ""} {
- lappend context [$confV getInfo Identity]
- set phaseV [$uiObj getParent PhaseVersion]
- if {"$phaseV" != ""} {
- lappend context [$phaseV getInfo Identity]
- set sysV [$uiObj getParent SystemVersion]
- if {"$sysV" != ""} {
- lappend context [$sysV getInfo Identity]
- }
- }
- }
- }
- lappend context [$uiObj getInfo Identity]
- lappend context [$uiObj browserType]
- lappend context [$uiObj uiClass]
- return [list $context]
- }
-
- # Do not delete this line -- regeneration end marker
-
-