home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / makemake.tcl < prev    next >
Text File  |  1997-11-17  |  7KB  |  286 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1992-1995 by Cadre Technologies 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 Cadre Technologies Inc.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)makemake.tcl    /main/titanic/11 (1.12)
  17. #    Author        : frmo
  18. #    Original date    : 1-8-1992
  19. #    Description    : makefile generator
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. if {[info procs require] == ""} {
  25.     source  [m4_path_name tcl cginit.tcl]
  26. }
  27.  
  28. OTShRegister::tdbOp
  29.  
  30. require legacy.tcl
  31. require make_msg.tcl
  32. require wmt_util.tcl
  33. require machdep.tcl
  34. require makedefs.tcl
  35.  
  36. if {[info procs fstorage::dir] == ""} {
  37.     require fstorage.tcl
  38. }
  39.  
  40. # Type en source info
  41. #
  42. global SRC_TYPES
  43. global TGT_TYPES
  44. global SOURCES
  45.  
  46. # Make info
  47. #
  48. global make_tmpl_type
  49. global make_type
  50.  
  51. # Client context
  52. #
  53. global clientContext; set clientContext [ClientContext::global]
  54.  
  55. # Main function
  56. #
  57. proc makemake {} {
  58.     m4_message $M_GEN_MAKEFILE
  59.  
  60.     if {![$clientContext customFileExists maketmpl maketmpl etc 1]} {
  61.     if [$clientContext customFileExists configure tcl tcl 1] {
  62.         require "configure.tcl"
  63.     }
  64.     }
  65.     if {![$clientContext customFileExists maketmpl maketmpl etc 1]} {
  66.     m4_error $E_NO_MAKETMPL
  67.     return -1
  68.     }
  69.     if {[init_make_globs] == -1} {
  70.     return -1
  71.     }
  72.     read_file_types
  73.     if {[catch {set fp [fstorage::open makefile.$make_type w]} reason]} {
  74.     puts stderr $reason
  75.     m4_error $E_FILE_OPEN_WRITE makefile.$make_type
  76.     return -1
  77.     }
  78.     set sect [TextSection new]
  79.     expandHeaderIntoSection makefile $make_type $sect
  80.     set contents [$clientContext getCustomFileContents maketmpl maketmpl etc]
  81.     expand_text $sect $contents
  82.     $sect write $fp
  83.     fstorage::close $fp
  84.     return 0
  85. }
  86.  
  87. # Determine the make globals: make_tmpl_type and make_type
  88. #
  89. proc init_make_globs {} {
  90.     global make_type; set make_type makefile
  91.     global make_tmpl_type; set make_tmpl_type maketmpl
  92.  
  93.     return 0
  94. }
  95.  
  96.  
  97. # Determine types of all files and build the global type lists, also build
  98. # source file list
  99. #
  100. proc read_file_types {} {
  101.     global SRC_TYPES;        set SRC_TYPES ""
  102.     global TGT_TYPES;        set TGT_TYPES ""
  103.     global SOURCES;        set SOURCES ""
  104.  
  105.     set modHandler [ModuleHandler new]
  106.     $modHandler setCurrentContext
  107.     set custObjHandler [CustObjHandler new $modHandler]
  108.  
  109.     foreach objSpec [$custObjHandler currentObjectSpecSet] {
  110.     switch [$objSpec makeType] {
  111.         source {lappend SRC_TYPES [$objSpec browserType]}
  112.         target {lappend TGT_TYPES [$objSpec browserType]}
  113.     }
  114.     }
  115.  
  116.     set SOURCES [lsort [fstorage::dir $SRC_TYPES]]
  117. }
  118.  
  119.  
  120. # make file names out of a list of pdb name.type entries
  121. #
  122. proc file_names {list} {
  123.     set result ""
  124.     foreach file $list {
  125.     lappend result [fstorage::get_uenv_path $file]
  126.     }
  127.     return $result
  128. }
  129.  
  130.  
  131. # Expand 'text' for each target of type 'type'
  132. #
  133. proc mm_foreach_target {type_list text} {
  134.     upvar current_section current_section
  135.     foreach target [fstorage::dir $type_list] {
  136.     expand_text $current_section $text
  137.     }
  138. }
  139.  
  140.  
  141. # Return the dependencies of 'target' that have a type that is in 'typelist'.
  142. # Format the dependencies by replacing their extension with 'ext' and
  143. # separating them with 'sep'. The dependencies are kept in a global list
  144. # so that a dependency list can be generated later
  145. # Only add a dependency to the global list if 'ext' is in SRC_TYPES
  146. #
  147. proc mm_dependencies {{types -} {ext .$OBJ_EXT} {sep ""}} {
  148.     set all_deps ""
  149.     set result ""
  150.  
  151.     if {$types == "-"} {
  152.     set all_deps $SOURCES
  153.     } else {
  154.     return $result
  155.     }
  156.  
  157.     foreach dep $all_deps {
  158.     set depfile "[nt_get_name [fstorage::get_uenv_path $dep]]$ext"
  159.     append result "$sep $depfile"
  160.     }
  161.  
  162.     return $result
  163. }
  164.  
  165.  
  166. # Return the files of a certain type, possibly prefixed (sorted)
  167. #
  168. proc mm_files {{types -} {prefix ""}} {
  169.     if {$types == "-"} {
  170.     set types $TGT_TYPES
  171.     }
  172.     set result ""
  173.     if {$prefix == ""} {
  174.     set result [file_names [fstorage::dir $types]]
  175.     } else {
  176.     foreach file [file_names [fstorage::dir $types]] {
  177.         append result "$prefix$file "
  178.     }
  179.     }
  180.     return [lsort $result]
  181. }
  182.  
  183.  
  184. # Return a suitable name for an OBJ macro
  185. #
  186. proc mm_obj_name {} {
  187.     upvar target target
  188.     return "OBJ[nt_get_name $target][nt_get_type $target]"
  189. }
  190.  
  191.  
  192. # Return the name of the target
  193. #
  194. proc mm_tgt_name {} {
  195.     upvar target target
  196.     return [nt_get_name $target]
  197. }
  198.  
  199.  
  200. # Return the path to the target
  201. #
  202. proc mm_tgt_path {} {
  203.     upvar target target
  204.     return [fstorage::get_uenv_path $target]
  205. }
  206.  
  207.  
  208. # Return the path to the installation directory, depending on target
  209. #
  210. proc mm_install_path {target} {
  211.     global clientContext
  212.     set sysV [$clientContext currentSystem]
  213.     if [$sysV isNil] {
  214.     return ""
  215.     }
  216.     return [$sysV path]
  217. }
  218.  
  219.  
  220. # Construct the ranlib command
  221. #
  222. # Requires 'proc processLibrary' to be defined in machdep.tcl
  223. #
  224. proc mm_process_lib {args} {
  225.     return [processLibrary $args]
  226. }
  227.  
  228.  
  229. # Return the X Window System include directory
  230. #
  231. # Requires 'proc XIncludeDir' to be defined in machdep.tcl
  232. #
  233. proc mm_x_include_dir {} {
  234.     return [XIncludeDir]
  235. }
  236.  
  237.  
  238. # Return an identification of the current platform.
  239. #
  240. # Result is a list with as first element the OS, as
  241. # second element the OS version.
  242. #
  243. # Requires 'proc osIdentification' to be defined in machdep.tcl
  244. #
  245. proc mm_os_ident {} {
  246.     return [osIdentification]
  247. }
  248.  
  249.  
  250. # Return the libraries to linked to a TDB dependent application
  251. #
  252. # Already contains any -l and -L options needed.
  253. #
  254. # Requires 'proc dbmsLinkLibrary' to be defined in machdep.tcl
  255. #
  256. proc mm_dbms_libs {} {
  257.     return [dbmsLinkLibrary]
  258. }
  259.  
  260.  
  261. # Return the complete dependency list for all objects
  262. #
  263. proc mm_all_deps {} {
  264.     set result ""
  265.     if [file exists depend.h] {
  266.     read_file_into_text depend.h result
  267.     return $result
  268.     }
  269. }
  270.  
  271.  
  272. # Look for the customization u_makemake.tcl file
  273. #
  274. if {[$clientContext customFileExists u_makemake tcl "" 0]} {
  275.     require u_makemake.tcl
  276. }
  277.  
  278.  
  279. # Just call makemake
  280. #
  281. if {![info exists dontCallMakeMake]} {
  282.     if [catch {makemake}] {
  283.         puts stderr $errorInfo
  284.     }
  285. }
  286.