home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / exp2file.tcl < prev    next >
Text File  |  1996-08-12  |  6KB  |  161 lines
  1. #              ~/icase/export_to_file.tcl
  2. #
  3. # Created: 15 februari 1996
  4. # Updated: 15 april 1996
  5. # Version: 1.2
  6. # Purpose: To export a diagram to a file (supplied by the user via 'FileSelect'
  7. # Notes on V1.1: Made compatible with new 'et.tcl' (OMT V4.0/01)
  8. # Notes on V1.2: generalized the file selection procedure (platform independent)
  9. #
  10.  
  11. #puts "Using ~/icase/export_to_file.tcl"
  12.  
  13.  
  14. # -----------------------------------------------------------
  15. # retrieve my own small library of commonly usable procedures
  16. # -----------------------------------------------------------
  17. set home [lindex [glob ~] 0]
  18. source "[path_name concat [path_name concat $home icase] small_library.tcl]"
  19.  
  20.  
  21. proc usage {} {
  22.     puts "Usage: otsh ~/icase/export_to_file.tcl -- [<diagram name> ...]"
  23.     exit 1
  24. }
  25.  
  26.  
  27. # ------------------------------------
  28. # A procedure to process all arguments
  29. # ------------------------------------
  30.  
  31. proc exportDiagrams { diagrams level } {
  32.     set argv ""
  33.     set processed 1
  34.     set hasBeenSourced 0
  35.     set to_process [llength $diagrams]
  36.     set line "--------------------------------------"
  37.     set line "$line$line"
  38.  
  39.     foreach diagram $diagrams {
  40.         set path $level/$diagram
  41.         set ok [[ClientContext::global] setLevelPath $path]
  42.  
  43.         # --------------
  44.         # Error handling
  45.         # --------------
  46.         if { $ok } {
  47.             puts " Can't determine client context: '$env(M4_levelpath)'"
  48.             puts " Program stops, whithout export generation. "
  49.             exit 1
  50.         }
  51.  
  52.  
  53.         # -----------------------------
  54.         # Feedback progress to the user
  55.         # -----------------------------
  56.         puts "Select a file to which the following tcl diagram must be written."
  57.         puts -nonewline "Diagram '$diagram' ($processed of $to_process) ... "
  58.         flush stdout
  59.         set processed [ expr $processed + 1 ]
  60.         # --------------------------------------------------
  61.         # Prompt the File selection dialog and handle errors
  62.         # --------------------------------------------------
  63.         set file_name "[FileSelect]"
  64.         if { $file_name == "" } {
  65.             puts "File name empty, can't comply"
  66.             #[ClientContext::global] setLevelPath $oldM4_levelpath
  67.             exit 1
  68.         }
  69.         if { [file exists $file_name] } {
  70.             if { [file type $file_name] != "file" } {
  71.                 puts "File '$file_name' not a file, can't comply"
  72.                 #[ClientContext::global] setLevelPath $oldM4_levelpath
  73.                 exit 1
  74.             }
  75.             if { ! [file writable $file_name] } {
  76.                 puts "File '$file_name' not writable (for you), can't comply"
  77.                 #[ClientContext::global] setLevelPath $oldM4_levelpath
  78.                 exit 1
  79.             }
  80.             # -------------------------------------------------------------
  81.             # in the future an extra question to the user if he/she is sure
  82.             # -------------------------------------------------------------
  83.         }
  84.  
  85.         # -------------------------------------------------------------
  86.         # store some essential data in the file and append exported tcl
  87.         # -------------------------------------------------------------
  88.         set f [open $file_name w]
  89.         puts $f "# $line"
  90.         puts $f "# export by '[get_user_name]' on [date]."
  91.         puts $f "# diagram = '$level/$diagram'."
  92.         puts $f "# $line"
  93.         puts $f ""
  94.         flush $f
  95.         close $f
  96.  
  97.         # -----------------------------------------------------------
  98.         # set the arguments and execute the exportTool procedure body
  99.         # -----------------------------------------------------------
  100.         set version "40[string range [versionInfo maintVersion] 0 1]"
  101.         set args "[list -a$file_name] -vi$version -vo$version -i -l"
  102.         eval exportTool { $args }
  103.  
  104.         # -----------------------------
  105.         # Feedback progress to the user
  106.         # -----------------------------
  107.         puts "exported."
  108.         flush stdout
  109.     }
  110. }
  111.  
  112.  
  113. # --------------------------------------------------------------
  114. # See if any boolean options were specified, set the appropriate
  115. # variables, and remove any options from argv.
  116. # --------------------------------------------------------------
  117.  
  118. proc exportMain {} {
  119.     global ucgargv
  120.     global et_dont_run
  121.  
  122.     # -------------------------------------------------------------------
  123.     # source the export source without executing the procedure exportTool
  124.     # -------------------------------------------------------------------
  125.     set src "[path_name concat [lindex [glob ~] 0] icase]"
  126.     set src "[path_name concat $src get_export_source.tcl]"
  127.     source "$src"
  128.  
  129.     # ----------------------- 
  130.     # setup the ClientContext 
  131.     # ----------------------- 
  132.     set clientContext [ClientContext::global]
  133.     set corporate [[$clientContext currentCorporate] name]
  134.     set project [[$clientContext currentProject] name]
  135.     set configuration [[[$clientContext currentConfig] config] name]
  136.     set version [[$clientContext currentConfig] versionNumber]
  137.     set phase [[[$clientContext currentPhase] phase] name]
  138.     set system [[[$clientContext currentSystem] system] name]
  139.  
  140.     #puts "corporate = $corporate"
  141.     #puts "project = $project"
  142.     #puts "configuration = $configuration"
  143.     #puts "version = $version"
  144.     #puts "phase = $phase"
  145.     #puts "system = $system"
  146.  
  147.     exportDiagrams "$ucgargv" "/$corporate/$project/$configuration:$version/$phase.$phase/$system.system"
  148.  
  149.     # -----------------------------
  150.     # Feedback progress to the user
  151.     # -----------------------------
  152.     puts "Export finished"
  153. }
  154.  
  155. # ugly source, should get rid of this call!!
  156.  
  157. global export_dont_run
  158. if [catch {set export_dont_run}] {
  159.     exportMain 
  160. }
  161.