PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/exp2dir.tcl

Text File | 1996-08-12 | 7KB | 182 lines

#              ~/icase/export_to_directory.tcl
#
# Created: 15 februari 1996
# Updated: 15 april 1996
# Version: 1.2
# Purpose: To export a diagram to a directory (supplied via 'FileSelect')
# Notes on V1.1: Made compatible with new 'et.tcl' (OMT V4.0/01)
# Notes on V1.2: generalized the file selection procedure (platform independent)
#

#puts "Using ~/icase/export_to_directory.tcl"


# -----------------------------------------------------------
# retrieve my own small library of commonly usable procedures
# -----------------------------------------------------------
set home [lindex [glob ~] 0]
source "[path_name concat [path_name concat $home icase] small_library.tcl]"


proc usage {} {
    puts "Usage: otsh ~/icase/export_to_file.tcl -- [<diagram name> ...]"
    exit 1
}


# --------------------------------------------------------------------
# create unique names (suffix them with a sequence number if necessary
# --------------------------------------------------------------------
proc createUniqueName { directory_name diagram } {
    # -------------------------------------------------------------------------
    # State Transition Diagram names can be composed with slashes, replace them
    # -------------------------------------------------------------------------
    regsub -all "/" $diagram ":" diagram

    set number 0
    set file_name "$directory_name/$diagram"

    while { [file exists $file_name] } {
        set number [expr $number + 1]
        set file_name "$directory_name/$diagram.$number"
    }
    if { $number } {
        puts "file '$diagram' already exists, using name '$file_name'"
    }

    return $file_name
}


# ------------------------------------
# A procedure to process all arguments
# ------------------------------------

proc exportDiagrams { diagrams level } {
    set argv ""
    set processed 1
    set hasBeenSourced 0
    set to_process [llength $diagrams]
    set version "40[string range [versionInfo maintVersion] 0 1]"
    set line "--------------------------------------"
    set line "$line$line"

    # --------------------------------------------------
    # Prompt the File selection dialog and handle errors
    # --------------------------------------------------
    puts "Select a directory to which the tcl diagram files must be written..."
    set directory_name "[FileSelect]"
    if { $directory_name == "" } {
        puts "Directory name empty, can't comply"
        exit 1
    }
    if { [file exists $directory_name] } {
        if { ! [file isdirectory $directory_name] } {
            set message "File $directory_name not a directory (is a"
            set message "$message [file type $directory_name]), can't comply"
            puts "$message"
            exit 1
        }
        if { ! [file writable $directory_name] } {
            set message Directory '$directory_name' not writable (for you),"
            set message "$message can't comply"
            puts "$message
            exit 1
        }
    }

    foreach diagram $diagrams {
        set path  $level/$diagram
        set ok [[ClientContext::global] setLevelPath $path]

        # --------------
        # Error handling
        # --------------
        if { $ok } {
            puts " Can't determine client context: '$env(M4_levelpath)'"
            puts " Program stops, whithout export generation. "
            exit 1
        }

        # ---------------------------------------------------
        # create a unique file name according to diagram name
        # ---------------------------------------------------
        set file_name [createUniqueName $directory_name $diagram]

        # -----------------------------
        # Feedback progress to the user
        # -----------------------------
        puts -nonewline "Diagram '$diagram' ($processed of $to_process) ... "
        flush stdout
        set processed [ expr $processed + 1 ]

        # -------------------------------------------------------------
        # store some essential data in the file and append exported tcl
        # -------------------------------------------------------------
        set f [open $file_name w]
        puts $f "# $line"
        puts $f "# export by '[get_user_name]' on [date]."
        puts $f "# diagram = '$level/$diagram'."
        puts $f "# $line"
        puts $f ""
        flush $f
        close $f

        set args "[list -a$file_name] -vi$version -vo$version -e -l"
        eval exportTool { $args }

        # -----------------------------
        # Feedback progress to the user
        # -----------------------------
        puts "exported."
        flush stdout
    }
}


# --------------------------------------------------------------
# See if any boolean options were specified, set the appropriate
# variables, and remove any options from argv.
# --------------------------------------------------------------

proc exportMain {} {
    global ucgargv
    global et_dont_run

    # -------------------------------------------------------------------
    # source the export source without executing the procedure exportTool
    # -------------------------------------------------------------------
    set src "[path_name concat [lindex [glob ~] 0] icase]"
    set src "[path_name concat $src get_export_source.tcl]"
    source "$src"

    # -----------------------
    # setup the ClientContext
    # -----------------------
    set clientContext [ClientContext::global]
    set corporate [[$clientContext currentCorporate] name]
    set project [[$clientContext currentProject] name]
    set configuration [[[$clientContext currentConfig] config] name]
    set version [[$clientContext currentConfig] versionNumber]
    set phase [[[$clientContext currentPhase] phase] name]
    set system [[[$clientContext currentSystem] system] name]

    #puts "corporate = $corporate"
    #puts "project = $project"
    #puts "configuration = $configuration"
    #puts "version = $version"
    #puts "phase = $phase"
    #puts "system = $system"

    set level "/$corporate/$project/$configuration:$version/$phase.$phase/$system.system"
    exportDiagrams "$ucgargv" "$level"
}

# ------------------------------------------
# ugly source, should get rid of this call!!
# ------------------------------------------
global export_dont_run
if [catch {set export_dont_run}] {
    exportMain
}