home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / makemake.tcl < prev    next >
Text File  |  1997-02-14  |  10KB  |  403 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/hindenburg/4 (1.12)
  17. #    Author        : frmo
  18. #    Original date    : 1-8-1992
  19. #    Description    : makefile generator
  20. #
  21. #---------------------------------------------------------------------------
  22. #
  23.  
  24. source  [m4_path_name tcl cginit.tcl]
  25.  
  26. OTShRegister::tdbOp
  27.  
  28. require legacy.tcl
  29. require make_msg.tcl
  30. require wmt_util.tcl
  31. require machdep.tcl
  32. require makedefs.tcl
  33.  
  34. if {[info procs fstorage::dir] == ""} {
  35.     require fstorage.tcl
  36. }
  37.  
  38. # Type en source info
  39. #
  40. global SRC_TYPES
  41. global NO_SRC_TYPES
  42. global TGT_TYPES
  43. global SOURCES
  44.  
  45. # Make info
  46. #
  47. global make_tmpl_type
  48. global make_type
  49.  
  50. # Client context
  51. #
  52. global clientContext;    set clientContext [ClientContext::global]
  53. global oldpath;        set oldpath [pwd]
  54. global path
  55.  
  56.  
  57. # Main function
  58. #
  59. proc makemake {} {
  60.     m4_message $M_GEN_MAKEFILE
  61.     if {[set_path_to_uenv] == -1} {
  62.     return -1
  63.     }
  64.     if {[init_make_globs] == -1} {
  65.     return -1
  66.     }
  67.     read_file_types
  68.     set contents [convert_make_templ maketmpl.$make_tmpl_type]
  69.     if {[catch {set fp [fstorage::open makefile.$make_type w]} reason]} {
  70.     puts stderr $reason
  71.     m4_error $E_FILE_OPEN_WRITE makefile.$make_type
  72.     return -1
  73.     }
  74.     set sect [TextSection new]
  75.     expand_text $sect $contents
  76.     $sect write $fp
  77.     fstorage::close $fp
  78.     return 0
  79. }
  80.  
  81.  
  82. # Change path to user environment directory, remember old path
  83. #
  84. proc set_path_to_uenv {} {
  85.     global clientContext
  86.     global path
  87.     set sysV [$clientContext currentSystem]
  88.     if {[$sysV isNil]} {
  89.     m4_error E_UENV
  90.     return -1
  91.     } else {
  92.     set path [$sysV path]
  93.     if {[catch {cd $path} reason]} {
  94.         puts stderr $reason
  95.         m4_error $E_CHDIR $path
  96.         return -1
  97.     } else {
  98.         return 0
  99.     }
  100.     }
  101. }
  102.  
  103.  
  104. # Change path back to remembered old path
  105. #
  106. proc set_path_back {} {
  107.     global oldpath
  108.     if {$path != $oldpath} {
  109.     if {[catch {cd $oldpath} reason]} {
  110.         puts stderr $reason
  111.         m4_error $E_CHDIR $oldpath
  112.     }
  113.     }
  114. }
  115.  
  116.  
  117. # Determine the make globals: make_tmpl_type and make_type
  118. #
  119. proc init_make_globs {} {
  120.     global make_type; set make_type makefile
  121.     global make_tmpl_type; set make_tmpl_type maketmpl
  122.  
  123.     return 0
  124. }
  125.  
  126.  
  127. # Determine types of all files and build the global type lists, also build
  128. # source file list
  129. #
  130. proc read_file_types {} {
  131.     global SRC_TYPES;        set SRC_TYPES ""
  132.     global NO_SRC_TYPES;    set NO_SRC_TYPES ""
  133.     global TGT_TYPES;        set TGT_TYPES ""
  134.     global SOURCES;        set SOURCES ""
  135.  
  136.     foreach file [lsort [fstorage::dir]] {
  137.     set type [nt_get_type $file]
  138.     switch [fstorage::getMakeType $type] {
  139.         source  { set kind SRC ; lappend SOURCES $file }
  140.         target  { set kind TGT }
  141.         default { set kind NO_SRC }
  142.     }
  143.     if {![info exist seen${kind}($type)]} {
  144.         set seen${kind}($type) 1
  145.         lappend ${kind}_TYPES $type
  146.     }
  147.     if {$kind == "TGT" && ![info exist seenNO_SRC($type)]} {
  148.         set seenNO_SRC($type) 1
  149.         lappend NO_SRC_TYPES $type
  150.     }
  151.     }
  152. }
  153.  
  154.  
  155. # Read 'file_name', convert the 2.1 style makemake macro's to tcl functions
  156. # and return the result.
  157. #
  158. proc convert_make_templ {fullName} {
  159.     set result ""
  160.     set in_begin_end 0
  161.  
  162.     set fileName [nt_get_name $fullName]
  163.     set fileType [nt_get_type $fullName]
  164.     set isTempFile 0
  165.  
  166.     if {[$clientContext customFileExists $fileName $fileType "" 0]} {
  167.     set tmpFile [args_file {}]
  168.     $clientContext downLoadCustomFile $fileName $fileType "" $tmpFile
  169.  
  170.     set fp [open $tmpFile]
  171.     set isTempFile 1
  172.     } else {
  173.     set fp [open [m4_path_name etc maketmpl]]
  174.     }
  175.  
  176.     while {[gets $fp line] >= 0} {
  177.     # prevent sccs-ids from being processed
  178.     regsub -all {\(#\)} $line __the_sccs_id__ line
  179.     if [regsub -all {@BEGIN\(([^)]+)\)} $line \
  180.             "~\[mm_foreach_target \\1 \{" line] {
  181.         set in_begin_end 1
  182.     }
  183.     if [regsub -all {@END} $line "\}\]" line] {
  184.         set in_begin_end 0
  185.     }
  186.     regsub -all {@\(TARGET\)} $line "~\[mm_tgt_path\]" line
  187.     regsub -all {@\(TARGETNAME\)} $line "~\[mm_tgt_name\]" line
  188.     regsub -all {@\(TARGETDEP\)} $line "~\[mm_target_deps\]" line
  189.     regsub -all {@\(OBJ\)} $line "~\[mm_obj_name\]" line
  190.     regsub -all {@\(OBJECTS\)} $line "~\[mm_dependencies\]" line
  191.     regsub -all {@\(OBJECTS\.([^)]+)\)} $line \
  192.         "~\[mm_dependencies \$SRC_TYPES .\\1\]" line
  193.     regsub -all {@\(OBJECTS,([^)]+)\)} $line \
  194.         "~\[mm_dependencies \$SRC_TYPES .\\1 ,\]" line
  195.     regsub -all {@\(PDBPATH\)} $line \
  196.         "~\[mm_install_path \$target\]" line
  197.     regsub -all {@\(TARGETS\)} $line "~\[mm_files\]" line
  198.     regsub -all {@\(TARGETS\.([^)]+)\)} $line \
  199.         "~\[mm_files \$TGT_TYPES \\1_\]" line
  200.     regsub -all {@\(DEPENDENCIES\)} $line \
  201.         "~\[mm_all_deps\]" line
  202.     if {$in_begin_end} {
  203.         regsub -all {@\(([^.]+)\.([^)]+)\)} $line \
  204.             "~\[mm_dependencies \\1 .\\2\]" line
  205.         regsub -all {@\(([^)]+)\)} $line \
  206.             "~\[mm_dependencies \\1\]" line
  207.     } else {
  208.         regsub -all {@\(([^.]+)\.([^)]+)\)} $line \
  209.             "~\[mm_files \\1 \\2_\]" line
  210.         regsub -all {@\(([^)]+)\)} $line \
  211.             "~\[mm_files \\1\]" line
  212.     }
  213.     # restore sccs-ids
  214.     regsub -all __the_sccs_id__ $line "(#)" line
  215.     append result "$line\n"
  216.     }
  217.  
  218.     close $fp
  219.  
  220.     if {$isTempFile} {
  221.     unlink $tmpFile
  222.     }
  223.  
  224.     return $result
  225. }
  226.  
  227.  
  228. # make file names out of a list of pdb name.type entries
  229. #
  230. proc file_names {list} {
  231.     set result ""
  232.     foreach file $list {
  233.     lappend result [fstorage::get_uenv_path $file]
  234.     }
  235.     return $result
  236. }
  237.  
  238.  
  239. # Expand 'text' for each target of type 'type'
  240. #
  241. proc mm_foreach_target {type_list text} {
  242.     upvar current_section current_section
  243.     foreach target [fstorage::dir $type_list] {
  244.     expand_text $current_section $text
  245.     }
  246. }
  247.  
  248.  
  249. # Return the dependencies of 'target' that have a type that is in 'typelist'.
  250. # Format the dependencies by replacing their extension with 'ext' and
  251. # separating them with 'sep'. The dependencies are kept in a global list
  252. # so that a dependency list can be generated later
  253. # Only add a dependency to the global list if 'ext' is in SRC_TYPES
  254. #
  255. proc mm_dependencies {{types -} {ext .$OBJ_EXT} {sep ""}} {
  256.     set all_deps ""
  257.     set result ""
  258.  
  259.     if {$types == "-"} {
  260.     set all_deps $SOURCES
  261.     } else {
  262.     return $result
  263.     }
  264.  
  265.     foreach dep $all_deps {
  266.     set depfile "[nt_get_name [fstorage::get_uenv_path $dep]]$ext"
  267.     append result "$sep $depfile"
  268.     }
  269.  
  270.     return $result
  271. }
  272.  
  273.  
  274. # Legacy stuff
  275. #
  276. proc pdb_obj {cmd arg} {
  277.     if {$cmd != "get_pdb_path"} {
  278.     puts stderr "makemake: WARNING: `pdb_obj $cmd ...': function not\
  279.             supported (anymore)"
  280.     return
  281.     } else {
  282.     mm_install_path $arg
  283.     }
  284. }
  285.  
  286.  
  287. # Return the files of a certain type, possibly prefixed (sorted)
  288. #
  289. proc mm_files {{types -} {prefix ""}} {
  290.     if {$types == "-"} {
  291.     set types $TGT_TYPES
  292.     }
  293.     set result ""
  294.     if {$prefix == ""} {
  295.     set result [file_names [fstorage::dir $types]]
  296.     } else {
  297.     foreach file [file_names [fstorage::dir $types]] {
  298.         append result "$prefix$file "
  299.     }
  300.     }
  301.     return [lsort $result]
  302. }
  303.  
  304.  
  305. # Return a suitable name for an OBJ macro
  306. #
  307. proc mm_obj_name {} {
  308.     upvar target target
  309.     return "OBJ[nt_get_name $target][nt_get_type $target]"
  310. }
  311.  
  312.  
  313. # Return the name of the target
  314. #
  315. proc mm_tgt_name {} {
  316.     upvar target target
  317.     return [nt_get_name $target]
  318. }
  319.  
  320.  
  321. # Return the path to the target
  322. #
  323. proc mm_tgt_path {} {
  324.     upvar target target
  325.     return [fstorage::get_uenv_path $target]
  326. }
  327.  
  328.  
  329. # Return the path to the installation directory, depending on target
  330. #
  331. proc mm_install_path {target} {
  332.     #return [fstorage::get_uenv_path $arg absolute]
  333.     return $path
  334. }
  335.  
  336.  
  337. # Construct the ranlib command
  338. #
  339. # Requires 'proc processLibrary' to be defined in machdep.tcl
  340. #
  341. proc mm_process_lib {args} {
  342.     return [processLibrary $args]
  343. }
  344.  
  345.  
  346. # Return the X Window System include directory
  347. #
  348. # Requires 'proc XIncludeDir' to be defined in machdep.tcl
  349. #
  350. proc mm_x_include_dir {} {
  351.     return [XIncludeDir]
  352. }
  353.  
  354.  
  355. # Return an identification of the current platform.
  356. #
  357. # Result is a list with as first element the OS, as
  358. # second element the OS version.
  359. #
  360. # Requires 'proc osIdentification' to be defined in machdep.tcl
  361. #
  362. proc mm_os_ident {} {
  363.     return [osIdentification]
  364. }
  365.  
  366.  
  367. # Return the libraries to linked to a TDB dependent application
  368. #
  369. # Already contains any -l and -L options needed.
  370. #
  371. # Requires 'proc dbmsLinkLibrary' to be defined in machdep.tcl
  372. #
  373. proc mm_dbms_libs {} {
  374.     return [dbmsLinkLibrary]
  375. }
  376.  
  377.  
  378. # Return the complete dependency list for all objects
  379. #
  380. proc mm_all_deps {} {
  381.     set result ""
  382.     if [file exists depend.h] {
  383.     read_file_into_text depend.h result
  384.     return $result
  385.     }
  386. }
  387.  
  388.  
  389. # Look for the customization u_makemake.tcl file
  390. #
  391. if {[$clientContext customFileExists u_makemake tcl "" 0]} {
  392.     require u_makemake.tcl
  393. }
  394.  
  395.  
  396. # Just call makemake
  397. #
  398. if [catch {makemake}] {
  399.     puts stderr $errorInfo
  400. }
  401.  
  402. set_path_back
  403.