home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / custcheckd.tcl < prev    next >
Encoding:
Text File  |  1997-07-02  |  9.8 KB  |  346 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)custcheckd.tcl    /main/titanic/4
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)custcheckd.tcl    /main/titanic/4   2 Jul 1997 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. require custcheckp.tcl
  13. require checkbrvie.tcl
  14. require config.tcl
  15. require custfileut.tcl
  16. # End user added include file section
  17.  
  18.  
  19. Class CustCheckDialog : {NoteBkDialog} {
  20.     constructor
  21.     method destructor
  22.     method createInterface
  23.     method read
  24.     method edit
  25.     method show
  26.     method save
  27.     method quit
  28.     method getGroup
  29.     method setGroup
  30.     method removeGroup
  31.     method getPhase
  32.     method setPhase
  33.     method removePhase
  34.     attribute lvlObj
  35.     attribute custObj
  36.     attribute readOnly
  37.     attribute number
  38.     attribute group
  39.     attribute phase
  40. }
  41.  
  42. constructor CustCheckDialog {class this name} {
  43.     set this [NoteBkDialog::constructor $class $this $name]
  44.     $this group [Dictionary new]
  45.     $this phase [Dictionary new]
  46.     # Start constructor user section
  47.     .main busy TRUE
  48.     global classCount
  49.     $this number $classCount
  50.  
  51.     # read phases file
  52.     getPhases
  53.  
  54.     $this modal 1
  55.     $this createInterface
  56.     $this config \
  57.         -cancelPressed { %this quit } \
  58.         -okPressed { %this save ; %this quit} \
  59.         -helpPressed {.main helpOnName checkConfigDialog } \
  60.         -applyNowPressed { %this save }
  61.     # End constructor user section
  62.     return $this
  63. }
  64.  
  65. method CustCheckDialog::destructor {this} {
  66.     # Start destructor user section
  67.     # End destructor user section
  68. }
  69.  
  70. method CustCheckDialog::createInterface {this} {
  71.  
  72.     set cc [ClientContext::global]
  73.     set currentPhase ""
  74.     if {![[$cc currentPhase] isNil]} {
  75.         set currentPhase [[[$cc currentPhase] phase] type]
  76.     }
  77.     set count 0
  78.     foreach phase ${BrowserProcs::phases} {
  79.         set phaseType [lindex $phase 1]
  80.         if {$currentPhase != "" && $currentPhase != $phaseType} continue
  81.         if [[$this phase] exists "$phaseType"] continue
  82.         set page [CustCheckPage new $this.phase$count \
  83.             -label "$phaseType" \
  84.         ]
  85.         $this setPhase "$phaseType" $page
  86.         incr count 1
  87.     }
  88. }
  89.  
  90. method CustCheckDialog::read {this levelObject} {
  91.  
  92.     $this lvlObj $levelObject
  93.  
  94.     if {"$levelObject" == "" || [$levelObject isA Corporate]} {
  95.         $this custObj ""
  96.     } else {
  97.         $this custObj [$levelObject findCustomFileVersion checkconfig checkconfig]
  98.     }
  99.  
  100.     set cc [ClientContext::global]
  101.  
  102.     set configList {}
  103.     set groupList {}
  104.     set mapList {}
  105.  
  106.     # read corporate
  107.     set lvl Corporate
  108.     if [$cc customFileExistsAt $lvl checkconfig checkconfig etc] {
  109.         set config [args_file {}]
  110.         $cc downLoadCustomFileAt $lvl checkconfig checkconfig etc $config
  111.         set configList [readConfigurationFile $config]
  112.         unlink $config
  113.     }
  114.     if [$cc customFileExistsAt $lvl checkgroups checkgroups etc] {
  115.         set groups [args_file {}]
  116.         $cc downLoadCustomFileAt $lvl checkgroups checkgroups etc $groups
  117.         set groupList [readConfigurationFile $groups]
  118.         unlink $groups
  119.     }
  120.     if [$cc customFileExistsAt $lvl checkmap checkmap etc] {
  121.         set map [args_file {}]
  122.         $cc downLoadCustomFileAt $lvl checkmap checkmap etc $map
  123.         set mapList [readConfigurationFile $map]
  124.         unlink $map
  125.     }
  126.  
  127.     # read module stuff
  128.     set modules [[.main moduleHdlr] moduleSpecSet]
  129.     foreach mod $modules {
  130.         set config [[.main moduleHdlr] getFiles etc checkconfig.checkconfig $mod]
  131.         foreach file $config {
  132.             set list [readConfigurationFile $file]
  133.             # add level stuff in config spec
  134.             foreach configLine $list {
  135.                 set configLvl  [list "$configLine module"]
  136.                 set configList [concat $configList "$configLvl"]
  137.             }
  138.         }
  139.         set groups [[.main moduleHdlr] getFiles etc checkgroups.checkgroups $mod]
  140.         foreach file $groups {
  141.             set list [readConfigurationFile $file]
  142.             set groupList [concat $groupList $list]
  143.         }
  144.         set map [[.main moduleHdlr] getFiles etc checkmap.checkmap $mod]
  145.         foreach file $map {
  146.             set list [readConfigurationFile $file]
  147.             set mapList [concat $mapList $list]
  148.         }
  149.     }
  150.  
  151.     # read level stuff
  152.     foreach lvl {Project Config Phase System} {
  153.         if [$cc customFileExistsAt $lvl checkconfig checkconfig etc] {
  154.             set config [args_file {}]
  155.             $cc downLoadCustomFileAt $lvl checkconfig checkconfig etc $config
  156.             set list [readConfigurationFile $config]
  157.             # add level stuff in config spec
  158.             foreach configLine $list {
  159.                 set configLvl  [list "$configLine $lvl"]
  160.                 set configList [concat $configList "$configLvl"]
  161.             }
  162.             unlink $config
  163.         }
  164.         if [$cc customFileExistsAt $lvl checkgroups checkgroups etc] {
  165.             set groups [args_file {}]
  166.             $cc downLoadCustomFileAt $lvl checkgroups checkgroups etc $groups
  167.             set list [readConfigurationFile $groups]
  168.             set groupList [concat $groupList $list]
  169.             unlink $groups
  170.         }
  171.         if [$cc customFileExistsAt $lvl checkmap checkmap etc] {
  172.             set map [args_file {}]
  173.             $cc downLoadCustomFileAt $lvl checkmap checkmap etc $map
  174.             set list [readConfigurationFile $map]
  175.             set mapList [concat $mapList $list]
  176.             unlink $map
  177.         }
  178.         if {$lvl == [$cc currentLevel]} {
  179.             break
  180.         }
  181.     }
  182.  
  183.     # user files ingored.
  184.  
  185.     global groupArray
  186.     foreach groupLine $groupList {
  187.         set groupArray([lindex $groupLine 0]) [lindex $groupLine 1]
  188.     }
  189.  
  190.     foreach mapLine $mapList {
  191.         set msgNr [lindex $mapLine 1]
  192.         set msgInfo [list $msgNr "[m4_msg get $msgNr]"]
  193.         if {[$this getGroup [lindex $mapLine 0]] != ""} {
  194.             set lst [$this getGroup [lindex $mapLine 0]]
  195.             lappend lst "$msgInfo"
  196.         } else {
  197.             set lst [list "$msgInfo"]
  198.         }
  199.         $this setGroup [lindex $mapLine 0] $lst
  200.     }
  201.  
  202.     foreach configLine $configList {
  203.         set phase [lindex $configLine 0]
  204.         set group [lindex $configLine 1]
  205.         set checkValue [lindex $configLine 2]
  206.         set configLevel [lindex $configLine 3]
  207.         set page [$this getPhase $phase]
  208.         if {$page == ""} continue
  209.         if {$group == ""} continue
  210.         set obj $page.DC.CBV.$group
  211.         if {![isCommand $obj]} {
  212.             CheckBrObject new $obj
  213.             $obj prevCheckValues ""
  214.         } else {
  215.             # save previous checkvalue, and configLevel
  216.             $obj prevCheckValues "\{[$obj checkValue] \"[$obj configLevel]\"\} [$obj prevCheckValues]"
  217.         }
  218.         $obj selected "$page.DC.CBV setMessages $group"
  219.         $obj group $group
  220.         $obj label $group
  221.         $obj checkValue $checkValue
  222.         $obj configLevel $configLevel
  223.         $obj updateView
  224.     }
  225.  
  226.     [$this phase] foreach key value {
  227.         $value.DC.CBV sortit
  228.     }
  229. }
  230.  
  231. method CustCheckDialog::edit {this levelObject} {
  232.  
  233.     $this read $levelObject
  234.     $this readOnly 0
  235.  
  236.     if {"[$this custObj]" != ""} {
  237.         if [catch {[$this custObj] edit} msg] {
  238.             wmtkerror $msg
  239.             $this readOnly 1
  240.         }
  241.     }
  242.  
  243.     if [$this readOnly] {
  244.         $this title "Show 'checkconfig'"
  245.     } else {
  246.         $this title "Edit 'checkconfig'"
  247.     }
  248.  
  249.     $this popUp
  250.     .main busy FALSE
  251. }
  252.  
  253. method CustCheckDialog::show {this levelObject} {
  254.  
  255.     $this read $levelObject
  256.     $this readOnly 1
  257.     $this title "Show 'checkconfig'"
  258.  
  259.     $this popUp
  260.     .main busy FALSE
  261. }
  262.  
  263. method CustCheckDialog::save {this} {
  264.  
  265.     if [$this readOnly] {
  266.         return
  267.     }
  268.  
  269.     set tmpFile [args_file {}]
  270.     set fid [open $tmpFile w]
  271.  
  272.     puts $fid "#-------------------------------------------------------------"
  273.     puts $fid "#                                                               "
  274.     puts $fid "# phase id   : The id of the phase. Valid id's are:           "
  275.     puts $fid "#              'Analysis', 'SystemDesign', 'ObjectDesign'     "
  276.     puts $fid "#              and 'Implementation'                           "
  277.     puts $fid "# group name : The name of the group of checks. With this name"
  278.     puts $fid "#              you can define in the configuration file       "
  279.     puts $fid "#              'checkmap' which errors/warnings belong to this"
  280.     puts $fid "#              group. The name of the group is userdefineable."
  281.     puts $fid "# value      : Valid values are: 'off', 'default', 'error'    "
  282.     puts $fid "#              and 'warning' With this field you can promote  "
  283.     puts $fid "#              warnings to errors and visa versa.             "
  284.     puts $fid "#              You cannot turn off fatals or normal messages! "
  285.     puts $fid "#                                                             "
  286.     puts $fid "#              The key in this table is the phase id combined "
  287.     puts $fid "#              with the group name                            "
  288.     puts $fid "#-------------------------------------------------------------"
  289.     puts $fid "# phase id      | group name                | value           "
  290.     puts $fid "#-------------------------------------------------------------"
  291.  
  292.     set formatString "%-15.15s | %-25.25s | %-10.10s"
  293.  
  294.     set currentLevel [[ClientContext::global] currentLevel]
  295.  
  296.     [$this phase] foreach key value {
  297.         foreach obj [$value.DC.CBV objectSet] {
  298.             if {$currentLevel == [$obj configLevel]} {
  299.                 puts $fid "[format $formatString $key \
  300.                     [$obj label] [$obj checkValue]]"
  301.             }
  302.         }
  303.     }
  304.     close $fid
  305.     require "custfileut.tcl"
  306.     CustFileUtilities::save $tmpFile [$this lvlObj] checkconfig checkconfig
  307.     unlink $tmpFile
  308.  
  309. }
  310.  
  311. method CustCheckDialog::quit {this} {
  312.  
  313.     if {"[$this custObj]" != "" && (! [$this readOnly])} {
  314.         [$this custObj] quit
  315.     }
  316.  
  317.     $this delete
  318. }
  319.  
  320. # Do not delete this line -- regeneration end marker
  321.  
  322. method CustCheckDialog::getGroup {this groupName} {
  323.     return [[$this group] set $groupName]
  324. }
  325.  
  326. method CustCheckDialog::setGroup {this groupName newGroup} {
  327.     [$this group] set $groupName $newGroup
  328. }
  329.  
  330. method CustCheckDialog::removeGroup {this groupName} {
  331.     [$this group] unset $groupName
  332. }
  333.  
  334. method CustCheckDialog::getPhase {this phaseType} {
  335.     return [[$this phase] set $phaseType]
  336. }
  337.  
  338. method CustCheckDialog::setPhase {this phaseType newPhase} {
  339.     [$this phase] set $phaseType $newPhase
  340. }
  341.  
  342. method CustCheckDialog::removePhase {this phaseType} {
  343.     [$this phase] unset $phaseType
  344. }
  345.  
  346.