home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / config.tcl < prev    next >
Text File  |  1996-10-31  |  12KB  |  481 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1993-1996 by Cayenne Software, Inc.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Cayenne Software, Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)config.tcl    /main/hindenburg/5
  17. #    Author        : peku
  18. #    Original date    : 17-11-1993
  19. #    Description    : script for C++ configuration
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. source [m4_path_name tcl cginit.tcl]
  25.  
  26. require wmt_util.tcl
  27. require machdep.tcl
  28.  
  29. source [m4_path_name config tdb_config.tcl]
  30.  
  31. #
  32. #    Return base directory to install stuff
  33. #
  34.  
  35. proc m4basedir {} {
  36.     set clientContext [ClientContext::global]
  37.  
  38.     set configV [$clientContext currentConfig]
  39.  
  40.     if {[$configV isNil]} {
  41.         return [m4_var get M4_home]
  42.     }
  43.  
  44.     return [$configV path]
  45. }
  46.  
  47. proc select_config {} {
  48.     set configBase [location [m4_var get M4_home] config]
  49.     cd $configBase
  50.  
  51.     global projcf
  52.     set header_line "C++ configuration for "
  53.  
  54.     set clientContext [ClientContext::global]
  55.     set configV [$clientContext currentConfig]
  56.  
  57.     if {[$configV isNil]} {
  58.         set corp [$clientContext currentCorporate]
  59.         append header_line "corporate environment '[$corp name]'"
  60.         set projcf 0
  61.         if {! [file writable $configBase]} {
  62.             puts "You have no write permission in $configBase directory"
  63.             puts "Select a project to configure first"
  64.             return
  65.         }
  66.     } else {
  67.         set confName [[$configV config] name]
  68.         set confVersion [$configV versionName]
  69.         append header_line "configuration version '${confName}.${confVersion}'"
  70.         set projcf 1
  71.     }
  72.  
  73.     while {"true"} {
  74.         puts "\n\t$header_line"
  75.         puts "\t[print_n [string length $header_line] -]"
  76.         puts "\n\t\tC++ compiler\tClass Library\n"
  77.         set dirs [glob cf_*]
  78.         set count 1
  79.         foreach dir $dirs {
  80.             puts -nonewline "\t$count."
  81.             incr count
  82.             print_config $dir
  83.         }
  84.         puts "\n\tr.\tRemove C++ Configuration"
  85.         puts -nonewline "\n\tChoice (q to quit): "
  86.  
  87.         set answer 1
  88.         set answer [gets stdin]
  89.         if {$answer == "q"} {
  90.             return
  91.         }
  92.         if {$answer == "r"} {
  93.             do_rm
  94.             continue
  95.         }
  96.         set idx [check_answer $answer $count]
  97.         if {$idx == "NOT_OK"} {
  98.             continue
  99.         }
  100.         puts ""
  101.         global choice_dir
  102.         set choice_dir [lvarpop dirs $idx]
  103.         set olddir [pwd]
  104.         cd $choice_dir
  105.         source subcfg.tcl
  106.         do_config
  107.         cd $olddir
  108.     }
  109. }
  110.  
  111. # return symbol 'count' times
  112.  
  113. proc print_n {count symbol} {
  114.     if {$count <= 0} {
  115.         return
  116.     }
  117.     set result ""
  118.     while {$count} {
  119.         incr count -1
  120.         append result $symbol
  121.     }
  122.     append result $symbol
  123. }
  124.  
  125. proc check_answer {answer max} {
  126.     if [catch {incr answer -1}] {
  127.         # not a numeric
  128.         return NOT_OK
  129.     }
  130.     incr max -1
  131.     if {$answer >= 0 && $answer < $max} {
  132.         return $answer
  133.     }
  134.     return NOT_OK
  135. }
  136.  
  137. proc print_config {dir} {
  138.     set fd [open [location $dir TITLE]]
  139.     # skip first line
  140.     gets $fd
  141.     puts "\t[format "%-16s%-16s" [gets $fd] [gets $fd]]"
  142.     close $fd
  143. }
  144.  
  145. proc get_config_var {prompt var} {
  146.     upvar $var lvar
  147.     puts $prompt
  148.     puts -nonewline "\[$lvar\]: "
  149.     set tmp_def [string trim [gets stdin]]
  150.     if {$tmp_def != ""} {
  151.         set lvar $tmp_def
  152.     }
  153. }
  154.  
  155. proc findCustomizationFile {fullName {create 0}} {
  156.     set name [lindex [split $fullName .] 0]
  157.     set type [lindex [split $fullName .] 1]
  158.     set clientContext [ClientContext::global]
  159.  
  160.     if {$projcf} {
  161.         set configV [$clientContext currentConfig]
  162.  
  163.         set customFileV [$configV findCustomFileVersion $name $type]
  164.  
  165.         if {$create && [$customFileV isNil]} {
  166.         puts "Creating customization file '$fullName' at configuration level"
  167.         set customFileV [$configV createCustomFileVersion $name $type]
  168.         }
  169.  
  170.         return $customFileV
  171.     } else {
  172.         set corporate [$clientContext currentCorporate]
  173.  
  174.         set customFileV [$corporate findCustomFileVersion $name $type]
  175.  
  176.         if {$create && [$customFileV isNil]} {
  177.         puts "Creating customization file '$fullName' at corporate level"
  178.  
  179.         set customFileV [$corporate createCustomFileVersion $name $type]        }
  180.  
  181.         return $customFileV
  182.     }
  183. }
  184.  
  185. proc config_file {dir custName cfg {fsName ""}} {
  186.     upvar $cfg mycfg
  187.  
  188.     if {$fsName == ""} {
  189.         set fsName $custName
  190.     }
  191.  
  192.     set dirfile ""
  193.     set result ""
  194.         set matches 0
  195.  
  196.     set customFileV [findCustomizationFile $custName]
  197.  
  198.     if {[$customFileV isNil]} {
  199.         set dirfile [path_name concat [location [m4basedir] $dir] $fsName]
  200.  
  201.         if {![file exists $dirfile]} {
  202.         return -1
  203.         }
  204.     } else {
  205.         set dirfile [args_file {}]
  206.  
  207.         $customFileV lockForWrite "Configure C++ Environment"
  208.  
  209.         $customFileV downLoad $dirfile
  210.     }
  211.  
  212.     set fd [open $dirfile r]
  213.  
  214.     while {[gets $fd line] >= 0} {
  215.         foreach subst [array names mycfg] {
  216.             set patt [lindex $mycfg($subst) 0]
  217.             set subspec [lindex $mycfg($subst) 1]
  218.             if [regsub -all $patt $line $subspec line] {
  219.                             incr matches
  220.                         }
  221.         }
  222.         append result "$line\n"
  223.     }
  224.  
  225.     close $fd
  226.     unlink $dirfile
  227.     set fd [open $dirfile w]
  228.     puts -nonewline $fd $result
  229.     close $fd
  230.  
  231.     if {! [$customFileV isNil] } {
  232.         $customFileV upLoad $dirfile
  233.  
  234.         $customFileV unlock
  235.  
  236.         unlink $dirfile
  237.     }
  238.  
  239.         return $matches
  240. }
  241.  
  242. #
  243. #  Add a config_file entry to remove any ranlib commands if
  244. #  the current platform does not require any post-processing of
  245. #  link libraries.  Requires machdep.tcl to be loaded.
  246. #
  247. proc add_ranlib_config {cfg_ref} {
  248.     upvar $cfg_ref cfg
  249.     if {[processLibrary "libdummy.a"] == ""} {
  250.     set ranlib_line ""
  251.     set ranlib_patt ".*ranlib.*"
  252.     set cfg(ranlib) [list $ranlib_patt $ranlib_line]
  253.     }
  254. }
  255.  
  256. #
  257. # Modify default Unix commands for windows compilers
  258. #
  259.  
  260. proc add_win_config {cfg_ref} {
  261.     upvar $cfg_ref cfg
  262.  
  263.     #
  264.     # Configure filename extensions
  265.     #
  266.  
  267.     set lib_patt {^LIBEXT =.*$}
  268.     set lib_line "LIBEXT =\tlib"
  269.     set obj_patt {^OBJEXT =.*$}
  270.     set obj_line "OBJEXT =\tobj"
  271.  
  272.     set cfg(libext) [list $lib_patt $lib_line]
  273.     set cfg(objext) [list $obj_patt $obj_line]
  274.  
  275.     #
  276.     # Configure OS/compiler commands
  277.     #
  278.  
  279.     set cp_patt {^CP =.*$}
  280.     set cp_line "CP =\t\tcopy"
  281.     set cxx_patt {^CXX =.*$}
  282.     set cxx_line "CXX =\t\t$cxx_def"
  283.     set mv_patt {^MV =.*$}
  284.     set mv_line "MV =\t\trename"
  285.     set rm_patt {^RM =.*$}
  286.     set rm_line "RM =\t\trmf"
  287.     set sh_patt {^SHELL=.*$}
  288.     set sh_line ""
  289.  
  290.     set cfg(cp) [list $cp_patt $cp_line]
  291.     set cfg(cxx) [list $cxx_patt $cxx_line]
  292.     set cfg(mv) [list $mv_patt $mv_line]
  293.     set cfg(rm) [list $rm_patt $rm_line]
  294.     set cfg(sh) [list $sh_patt $sh_line]
  295.  
  296.     #
  297.     # Default Informix incl directory is $INFORMIXDIR/incl/esql on Unix
  298.     # and $INFORMIXDIR/incl on PC ...
  299.     #
  300.  
  301.     if { [info exists env(INFORMIXDIR)] &&
  302.      [file exists [location $env(INFORMIXDIR) incl]]} {
  303.  
  304.     if { [file exists [location $env(INFORMIXDIR) incl esql]] } {
  305.         set infincdir_def [location $env(INFORMIXDIR) incl esql]
  306.         set infincdir_line "INFINCDIR =\t$infincdir_def"
  307.     } else {
  308.         set infincdir_def [location $env(INFORMIXDIR) incl]
  309.         set infincdir_line "INFINCDIR =\t$infincdir_def"
  310.     }
  311.  
  312.     set infincdir_patt {^INFINCDIR =.*$}
  313.     set cfg(infincdir) [list $infincdir_patt $infincdir_line]
  314.     }
  315.  
  316.     #
  317.     # Oracle preprocessor may be called proc or proc22 ...
  318.     #
  319.  
  320.     if {[osIdentification] == "WIN"} {
  321.     set oraHome [get env(ORACLE_HOME) [location C: ORACLE]]
  322.     set procExt ".exe"
  323.     } else {
  324.     set oraHome [get env(ORACLE_HOME) [location /usr oracle]]
  325.     set procExt ""
  326.     }
  327.  
  328.     set oraBin [location $oraHome bin]
  329.  
  330.     if {[file exists [path_name concat $oraBin proc$procExt]]} {
  331.     set proc_patt {^PROC =.*$} 
  332.     set proc_line "PROC =\t\t[path_name concat $oraBin proc]"
  333.     set cfg(proc) [list $proc_patt $proc_line]
  334.     } else {
  335.     if {[file exists [path_name concat $oraBin proc22$procExt]]} {
  336.         set proc_patt {^PROC =.*$} 
  337.         set proc_line "PROC =\t\t[path_name concat $oraBin proc22]"
  338.         set cfg(proc) [list $proc_patt $proc_line]
  339.     }
  340.     }
  341.  
  342.     #
  343.     # Remove chmod commands
  344.     #
  345.  
  346.     set chmod_patt "^.*chmod.*$"
  347.     set chmod_line ""
  348.  
  349.     set cfg(chmod) [list $chmod_patt $chmod_line]
  350.  
  351.     #
  352.     # Modify conditional mkdir commands
  353.     #
  354.  
  355.     set mkdir_patt "^\tif.*mkdir.*fi$"
  356.     set mkdir_line "\t-mkdir $(INSTALLDIR)"
  357.  
  358.     set cfg(mkdir) [list $mkdir_patt $mkdir_line]
  359. }
  360.  
  361. proc m4copyfile {dir custName {fsName ""}} {
  362.     if {$fsName == ""} {
  363.         set fsName $custName
  364.     }
  365.  
  366.     if [file exists $fsName] {
  367.         set sourcefile $fsName
  368.     } else {
  369.         set sourcefile [m4_path_name $dir $fsName]
  370.     }
  371.  
  372.     set customFileV [findCustomizationFile $custName 1]
  373.  
  374.     $customFileV lockForWrite "Configure C++ Environment"
  375.  
  376.     $customFileV upLoad $sourcefile
  377.  
  378.     $customFileV unlock
  379. }
  380.  
  381. proc m4copydir {dir} {
  382.     set save_dir [pwd]
  383.     set subdir [location config $dir]
  384.  
  385.     if [catch {set cddir [m4_path_name $subdir Makefile]}] {
  386.         return
  387.     }
  388.  
  389.     cd [path_name directory $cddir]
  390.  
  391.     set base [m4basedir]
  392.  
  393.     set files [glob -nocomplain Makefile *.{c,cxx,cp,ec,pc,sc}]
  394.     set dest [location $base $dir]
  395.     if {! [file exist $dest]} {
  396.         mkdir -path [list $dest]
  397.     }
  398.  
  399.     foreach file $files {
  400.         puts "cp $file $dest"
  401.         copy_text_file $file [location $dest $file]
  402.     }
  403.     set files [glob -nocomplain *.{h,hxx} ]
  404.     set dest [location $base include]
  405.     if {! [file exist $dest]} {
  406.         mkdir -path [list $dest]
  407.     }
  408.     foreach file $files {
  409.         puts "cp $file $dest"
  410.         copy_text_file $file [location $dest $file]
  411.     }
  412.  
  413.     cd $save_dir
  414. }
  415.  
  416. proc do_config {} {
  417.     foreach action [concat $set_default_actions $ask_actions] {
  418.         $action
  419.     }
  420.     # next actions may have been reset by previous ones
  421.     #
  422.     foreach action [concat $copy_actions $config_actions $msg_actions] {
  423.         $action
  424.     }
  425. }
  426.  
  427. proc puts_unlink {file} {
  428.     if [file exists $file] {
  429.         puts "rm $file"
  430.         unlink -nocomplain $file
  431.     }
  432. }
  433.  
  434. proc do_rm {} {
  435.     set verbose 1
  436.     puts ""
  437.  
  438.     set cppconfCustomFileV [findCustomizationFile cpp_config.tcl]
  439.     set maketmplCustomFileV [findCustomizationFile maketmpl.maketmpl]
  440.     set clientContext [ClientContext::global]
  441.     set customLevel ""
  442.  
  443.     if $projcf {
  444.         set customLevel [$clientContext currentConfig]
  445.     } else {
  446.         set customLevel [$clientContext currentCorporate]
  447.     }
  448.  
  449.     if {! [$cppconfCustomFileV isNil]} {
  450.         puts "Removing customization file cpp_config.tcl"
  451.         $customLevel remove $cppconfCustomFileV
  452.     }
  453.  
  454.     if {! [$maketmplCustomFileV isNil]} {
  455.         puts stderr "Removing customization file maketmpl.maketmpl"
  456.         $customLevel remove $maketmplCustomFileV
  457.     }
  458.  
  459.     set pdir [m4basedir]
  460.  
  461.     if [file exists [location $pdir src]] {
  462.         puts stderr "Removing directory [location $pdir src]"
  463.         BasicFS::removeDirAll [location $pdir src]
  464.     }
  465.  
  466.     if [file exists [location $pdir include]] {
  467.         puts stderr "Removing directory [location $pdir include]"
  468.         BasicFS::removeDirAll [location $pdir include]
  469.     }
  470.  
  471.     ###puts_unlink [location $pdir lib libdbobj.a]
  472.     ###puts_unlink [location $pdir lib libwmt4omt.a]
  473.  
  474.     if {! [catch {rmdir [location $pdir lib] $verbose}]} {
  475.         puts "rmdir [location $pdir lib]"
  476.     }
  477. }
  478.  
  479. unpack_package
  480. select_config
  481.