home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / custdefsar.tcl < prev    next >
Encoding:
Text File  |  1996-06-12  |  3.8 KB  |  153 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)custdefsar.tcl    /main/3
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)custdefsar.tcl    /main/3   12 Jun 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. require "custobjvie.tcl"
  13. require "config.tcl"
  14. # End user added include file section
  15.  
  16. require "custedarea.tcl"
  17.  
  18. Class CustDefsArea : {CustEdArea BrowsView} {
  19.     method destructor
  20.     constructor
  21.     method readUserObjects
  22.     method readLevelObjects
  23.     method readConfig
  24.     method deleteObjects
  25.     method writeObject
  26.     method getObjects
  27.     method clearArea
  28.     method dropEvent
  29. }
  30.  
  31. method CustDefsArea::destructor {this} {
  32.     # Start destructor user section
  33.     # End destructor user section
  34.     $this CustEdArea::destructor
  35. }
  36.  
  37. constructor CustDefsArea {class this name} {
  38.     set this [BrowsView::constructor $class $this $name]
  39.     set this [CustEdArea::constructor $class $this $name]
  40.  
  41.     global classCount
  42.     $this filter [CustObjViewFilter new CustObjViewFilter$classCount $this]
  43.     incr classCount
  44.  
  45.     return $this
  46. }
  47.  
  48. method CustDefsArea::readUserObjects {this} {
  49.     # not supported at user level
  50. }
  51.  
  52. method CustDefsArea::readLevelObjects {this} {
  53.     set levelIndex [expr [llength [$this _path]] - 1]
  54.     $this read [lindex [$this _path] $levelIndex] [$this _level]
  55. }
  56.  
  57. method CustDefsArea::readConfig {this obj name type} {
  58.     if [$obj isA Corporate] {
  59.         if {"[path_name file $name]" != "$name"} {
  60.             set custF [path_name concat [path_name concat \
  61.             [m4_var get M4_home] etc] $name $type ]
  62.         } elseif [catch {set custF [m4_path_name etc $name.$type]}] {
  63.             return ""
  64.         }
  65.         set lineList [readConfigurationFile $custF]
  66.     } else {
  67.         set custObj [$obj findCustomFileVersion $name $type]
  68.         if [$custObj isNil] {
  69.             return ""
  70.         }
  71.         set custF [args_file {}]
  72.         $custObj downLoad $custF
  73.         set lineList [readConfigurationFile $custF]
  74.         unlink $custF
  75.     }
  76.     return $lineList
  77. }
  78.  
  79. method CustDefsArea::deleteObjects {this objs} {
  80.     set index 0
  81.     $this CustEdArea::deleteObjects $objs
  82.     foreach obj [$this objectSet] {
  83.         $obj index $index
  84.         incr index
  85.     }
  86. }
  87.  
  88. method CustDefsArea::writeObject {this obj fid} {
  89.     $obj writeObject $fid
  90. }
  91.  
  92. method CustDefsArea::getObjects {this} {
  93.     return [$this objectSet]
  94. }
  95.  
  96. method CustDefsArea::clearArea {this} {
  97.     foreach obj [$this objectSet] {
  98.         $obj delete
  99.     }
  100.     .main selectionChanged
  101. }
  102.  
  103. method CustDefsArea::dropEvent {this droppedObject srcIsDst droppedAfterObject droppedForObject} {
  104.     if {$srcIsDst == 0} {
  105.         wmtkerror "Drag & drop between tools is not supported (yet)."
  106.         return
  107.     }
  108.     if {![$droppedObject editable]} {
  109.         wmtkerror "Object not moved, reason: object not editable."
  110.         return
  111.     }
  112.     if {$droppedForObject != ""} {
  113.         if {[$droppedForObject specLevel] != [$droppedObject specLevel]} {
  114.         wmtkerror "Object can not be moved to a higher level."
  115.         return
  116.         }
  117.     }
  118.     set newIndex 0
  119.     set oldIndex [$droppedObject index]
  120.     if {$droppedAfterObject != ""} {
  121.         set newIndex [$droppedAfterObject index]
  122.         if {$newIndex < $oldIndex} {
  123.             incr newIndex
  124.         }
  125.     }
  126.     foreach obj [$this objectSet] {
  127.         set objIndex [$obj index]
  128.         if {$objIndex >= $newIndex && $objIndex < $oldIndex} {
  129.             $obj index [expr $objIndex + 1]
  130.         } elseif {$objIndex > $oldIndex && $objIndex <= $newIndex} {
  131.             $obj index [expr $objIndex - 1]
  132.         }
  133.     }
  134.     $droppedObject index $newIndex
  135.     $this sort -command "CustDefsArea::compare"
  136.     $this isChanged 1
  137. }
  138.  
  139. proc CustDefsArea::compare {objA objB} {
  140.     set idxA [$objA index]
  141.     set idxB [$objB index]
  142.     if {$idxA > $idxB} {
  143.         return 1
  144.     }
  145.     if {$idxB > $idxA} {
  146.         return -1
  147.     }
  148.     return 0
  149. }
  150.  
  151. # Do not delete this line -- regeneration end marker
  152.  
  153.