home *** CD-ROM | disk | FTP | other *** search
- ###########################################################################
- ##
- ## Copyright (c) 1996 by Cadre Technologies Inc.
- ##
- ## This software is furnished under a license and may be used only in
- ## accordance with the terms of such license and with the inclusion of
- ## the above copyright notice. This software or any other copies thereof
- ## may not be provided or otherwise made available to any other person.
- ## No title to and ownership of the software is hereby transferred.
- ##
- ## The information in this software is subject to change without notice
- ## and should not be construed as a commitment by Cadre Technologies Inc.
- ##
- # File: @(#)gencorba.tcl /main/hindenburg/1
- #
- ###########################################################################
-
- require wmt_util.tcl
-
- global comment_string; set comment_string(corba) "// "
- global cc
-
- set cc [ClientContext::global]
-
- require corba_utils.tcl
- require corba_funcs.tcl
- require corba_disp.tcl
-
- proc generate_corba {} {
- find_file_types
-
- set systemName [getCurrentSystemName]
- set tgt_objs [get_tgt_objs]
- if [lempty $tgt_objs] {
- # import new
- global skip_file
- set file_list "idl"
- set old_files [fstorage::dir $file_list]
-
- generate [$oomodel ooplModel]
- } else {
- # import selected
- global gen_file
- set do_corba 0
- foreach file $tgt_objs {
- set gen_file($file) 1
- set type [nt_get_type $file]
- if {"$type" == "idl"} {
- set do_corba 1
- }
- }
- if $do_corba {
- generate [$oomodel ooplModel]
- }
- }
- }
-
- # Search for user defined Tcl files and "source" them. Tcl files are sourced
- # in the following order:
- # - u_gencorba.tcl; EITHER in m4_home/tcl OR in <project_dir>/tcl
- # - all tcl files in the system named "Tcl"
- # - all tcl files in the current system
-
-
- # "Source" a tcl file
- #
- proc source_tcl_file {file} {
- if [catch {source $file}] {
- m4_error $E_USER_TCL $file
- puts stderr $errorInfo
- }
- }
-
- # "Source" all tcl files in the current system
- #
- proc source_all_tcl_files {} {
- foreach file [fstorage::dir tcl] {
- source_tcl_file [fstorage::get_uenv_path $file absolute]
- }
- }
-
- # "Source" all tcl files in the system named "Tcl"
- #
- proc source_files_in_tcl_sys {} {
- set clientCont [ClientContext::global]
- set origSys [$clientCont levelNameAt System]
- if [catch {fstorage::goto_system Tcl.system}] {
- return
- }
- source_all_tcl_files
- fstorage::goto_system $origSys
- }
-
- if {[$cc customFileExists u_gencorba tcl "" 0]} {
- require u_gencorba.tcl
- }
-
- source_files_in_tcl_sys
- source_all_tcl_files
-
- generate_corba
-