home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / modeldbobj.tcl < prev    next >
Encoding:
Text File  |  1997-11-28  |  3.3 KB  |  131 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)modeldbobj.tcl    /main/titanic/7
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)modeldbobj.tcl    /main/titanic/7   28 Nov 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsdbobj.tcl"
  15.  
  16. Class ModelDbObj : {BrowsDbObj Model} {
  17.     method destructor
  18.     constructor
  19.     method changeReservation
  20.     method createTime2String
  21.     method hasChildren
  22.     method open
  23.     method reserveTime2String
  24.     method currentUserNames
  25. }
  26.  
  27. method ModelDbObj::destructor {this} {
  28.     # Start destructor user section
  29.     # End destructor user section
  30.     $this BrowsDbObj::destructor
  31. }
  32.  
  33. constructor ModelDbObj {class this name} {
  34.     set this [Model::constructor $class $this $name]
  35.     set this [BrowsDbObj::constructor $class $this $name]
  36.     return $this
  37. }
  38.  
  39. selfPromoter Model {this} {
  40.     ModelDbObj promote $this
  41. }
  42.  
  43. proc ModelDbObj::associations {} {
  44.     return {}
  45. }
  46.  
  47. method ModelDbObj::changeReservation {this} {
  48.     # Cause a call to the server to make sure the value of the
  49.     # (cached!) attributes are upToDate.
  50.     #
  51.     [$this corporate] models
  52.     
  53.     if [$this reserved] {
  54.         set cls ModelUnreserveDialog
  55.     set dlg .main.unreserveModel
  56.     } else {
  57.         set cls ModelReserveDialog
  58.     set dlg .main.reserveModel
  59.     }
  60.  
  61.     if ![isCommand $dlg] {
  62.     require "[string tolower [string range $cls 0 9]].tcl"
  63.     $cls new $dlg \
  64.         -okPressed "busy {%this ok} ; .main updateView" \
  65.         -cancelPressed "%this cancel" \
  66.         -helpPressed ".main helpOnName changeReservation"
  67.     }
  68.  
  69.     $dlg model $this
  70.     $dlg popUp
  71. }
  72.  
  73. proc ModelDbObj::childTypes {assoc} {
  74.     if {[lsearch -exact "[ModelDbObj::associations]" "$assoc"] == -1} {
  75.     return ""
  76.     }
  77.     return "[BrowserProcs::childTypes $assoc]"
  78. }
  79.  
  80. proc ModelDbObj::controlledLists {} {
  81.     return {}
  82. }
  83.  
  84. method ModelDbObj::createTime2String {this} {
  85.     return [BrowserProcs::displayDate [$this createTime]]
  86. }
  87.  
  88. method ModelDbObj::hasChildren {this} {
  89.     return 0
  90. }
  91.  
  92. proc ModelDbObj::infoProperties {} {
  93.     return [concat \
  94.     [BrowserProcs::infoProperties] \
  95.     {Created "Created By" Reserved "Reserved By" "Reservation Comments"
  96.      "Current Users" "Controlled Actions"} \
  97.     ]
  98. }
  99.  
  100. method ModelDbObj::open {this {exclusively 0}} {
  101.     set command [m4_path_name bin grndwrks$EXE_EXT]
  102.     set args " "
  103.  
  104.     if $exclusively {
  105.     append args "/a exc "
  106.     } else {
  107.     append args "/a nonexc "
  108.     }
  109.     append args "/u [quoteIf [ORB::currentUser]] "
  110.     append args "/r [quoteIf [[.main corporateObj] name]] "
  111.     append args "/m [quoteIf [$this name]]"
  112.  
  113.     .main startCommand extern \
  114.     "$command $args" "" "Starting '$command'..." {0 0} 0
  115. }
  116.  
  117. method ModelDbObj::reserveTime2String {this} {
  118.     return [BrowserProcs::displayDate [$this reserveTime]]
  119. }
  120.  
  121. method ModelDbObj::currentUserNames {this} {
  122.     set names {}
  123.     foreach user [$this currentUsers] {
  124.         lappend names [$user name]
  125.     }
  126.     return $names
  127. }
  128.  
  129. # Do not delete this line -- regeneration end marker
  130.  
  131.