home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / m4env.tcl < prev    next >
Text File  |  1997-11-12  |  2KB  |  103 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1995
  4. #
  5. #      File:           %W%
  6. #      Author:         Marcel Bancken
  7. #      Description:    m4env script
  8. #---------------------------------------------------------------------------
  9. # SccsId = %W%   %G% Copyright 1997 Cayenne Software Inc.
  10.  
  11. source [m4_path_name tcl libocl.tcl]
  12.  
  13. require platform.tcl
  14. require procs.tcl
  15. require messagehdl.tcl
  16.  
  17. proc usage {} {
  18.     wmtkfatal "Usage: m4env \[-h|\[\[-c\] \[-e\] \[-u\]\]\]\n \
  19.     \tprints M4 variables in sh format; options:\n \
  20.     \t-e: also export M4 variables\n \
  21.     \t-c: csh format\n \
  22.     \t-h: prints this message\n \
  23.     \t-u: open ORB and use customization files"
  24. }
  25.  
  26. proc print {csh export} {
  27.     set m4vars [List new]
  28.     m4_var foreach m4var {
  29.     $m4vars append $m4var
  30.     }
  31.     $m4vars sort
  32.  
  33.     set setCmd ""
  34.     set exportCmd ""
  35.     set assign "="
  36.     if $csh {
  37.     if $export {
  38.         set setCmd "setenv "
  39.         set assign " "
  40.     } else {
  41.         set setCmd "set "
  42.     }
  43.     } elseif $export {
  44.     set exportCmd "export "
  45.     }
  46.  
  47.     $m4vars foreach m4var {
  48.     # Adapt value
  49.     set value [m4_var get $m4var]
  50.     regsub -all "'" $value {'"'"'} value
  51.     if $csh {
  52.         regsub -all "!" $value {\!} value
  53.     }
  54.  
  55.     # Print value
  56.     set line "$setCmd$m4var$assign'$value';"
  57.     if {"$exportCmd" != ""} {
  58.         append line " $exportCmd$m4var;"
  59.     }
  60.     puts $line
  61.     }
  62. }
  63.  
  64. set argc 0
  65. set csh 0
  66. set export 0
  67. set useORB 0
  68. foreach arg $argv {
  69.     case $arg in {
  70.     {-c} {
  71.         set csh 1
  72.     }
  73.     {-e} {
  74.         set export 1
  75.     }
  76.     {-u} {
  77.         set useORB 1
  78.     }
  79.         {default} {
  80.         usage
  81.         }
  82.     }
  83.     incr argc 1
  84. }
  85.  
  86. if $useORB {
  87.     # ModuleHandler must be available
  88.     if [isCommand OtkRegister::extGui] {
  89.     OtkRegister::extGui
  90.     }
  91.  
  92.     set mh [ModuleHandler new]
  93.     $mh setCurrentContext
  94. } elseif [isCommand ClientContext] {
  95.    m4_var set M4_levelpath ""
  96.    m4_var set M4_levelpath_ids ""
  97.    set cc [ClientContext::global]
  98. }
  99.  
  100. print $csh $export
  101.  
  102. exit
  103.