home *** CD-ROM | disk | FTP | other *** search
- #---------------------------------------------------------------------------
- #
- # (c) Westmount Technology 1995
- #
- # File: @(#)cbutils.tcl 1.1
- # Author:
- # Description; Some helpfull functions used by class browser.
- #---------------------------------------------------------------------------
- # SccsId = @(#)cbutils.tcl 1.1 19 Oct 1995 Copyright 1995 Westmount Technology
-
- # Returns a new list consisting of all elements of lst. Elements that occur
- # more than once in lst, occur only once in the returned list.
- #
- proc lrmdoubles {lst} {
- set newlist ""
- while {[llength $lst]} {
- set elem [lindex $lst 0]
- lappend newlist $elem
- set lst [lreplace $lst 0 0]
- set idx [lsearch -exact $lst $elem]
- while {$idx != -1} {
- set lst [lreplace $lst $idx $idx]
- set idx [lsearch -exact $lst $elem]
- }
- }
- return $newlist
- }
-
- # Returns Item <itemNr> in CompLabel <labelType> in Component <component>
- #
- proc Component::getItem {component labelType} {
- foreach label [$component labels] {
- if {[$label type] == $labelType} {
- if {[llength [$label itemRefs]] == 0} {
- return [ORB::nil]
- }
- set itemRef [lindex [$label itemRefs] 0]
- return [$itemRef item]
- }
- }
- return [ORB::nil]
- }
-
-