home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / extldbobj.tcl < prev    next >
Text File  |  1996-07-09  |  3KB  |  116 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)extldbobj.tcl    /main/2
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)extldbobj.tcl    /main/2   9 Jul 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsdbobj.tcl"
  15.  
  16. Class ExtLDbObj : {BrowsDbObj ExternalLink} {
  17.     method destructor
  18.     constructor
  19.     method browserType
  20.     method changeLocation
  21.     method editFile
  22.     method hasChildren
  23.     method showFile
  24. }
  25.  
  26. method ExtLDbObj::destructor {this} {
  27.     # Start destructor user section
  28.     # End destructor user section
  29.     $this BrowsDbObj::destructor
  30. }
  31.  
  32. constructor ExtLDbObj {class this name} {
  33.     set this [ExternalLink::constructor $class $this $name]
  34.     set this [BrowsDbObj::constructor $class $this $name]
  35.     return $this
  36. }
  37.  
  38. selfPromoter ExternalLink {this} {
  39.     ExtLDbObj promote $this
  40. }
  41.  
  42. proc ExtLDbObj::associations {} {
  43.     return {accessRuleSet}
  44. }
  45.  
  46. method ExtLDbObj::browserType {this} {
  47.     return "[$this type]"
  48. }
  49.  
  50. method ExtLDbObj::changeLocation {this} {
  51.     ClassMaker::extend FileChooser ChangeLocationFileChooser dbObj
  52.     ChangeLocationFileChooser new $wmttoolObj.changeLocation \
  53.     -title "Change Location" \
  54.     -selectionPolicy BROWSE \
  55.     -filter "*" \
  56.     -directory "[path_name directory [$this path]]" \
  57.     -selectedSet "[list [$this path]]" \
  58.     -dbObj $this \
  59.     -cancelPressed {%this delete} \
  60.     -okPressed {
  61.         set script \
  62.         "[%this dbObj] path [list [lindex [%this selectedSet] 0]]"
  63.         $wmttoolObj startCommand tcl "$script" "" "" {1 0} 1
  64.         %this delete
  65.     }
  66.     $wmttoolObj.changeLocation delHelpButton
  67.     $wmttoolObj.changeLocation popUp
  68. }
  69.  
  70. proc ExtLDbObj::childTypes {assoc} {
  71.     if {[lsearch -exact "[ExtLDbObj::associations]" "$assoc"] == -1} {
  72.     return ""
  73.     }
  74.     return "[BrowserProcs::childTypes $assoc]"
  75. }
  76.  
  77. proc ExtLDbObj::controlledLists {} {
  78.     return ""
  79. }
  80.  
  81. method ExtLDbObj::editFile {this} {
  82.     if {! [file writable [$this path]]} {
  83.     $this showFile
  84.     return
  85.     }
  86.     set file [$this path]
  87.     $this edit
  88.     $wmttoolObj startM4Command editor "$file" "$this quit" "$file"
  89.     if {! [file exists $file]} {
  90.     wmtkwarning "File '$file' does not exist"
  91.     }
  92. }
  93.  
  94. method ExtLDbObj::hasChildren {this} {
  95.     return 1
  96. }
  97.  
  98. proc ExtLDbObj::infoProperties {} {
  99.     return [concat \
  100.     [BrowserProcs::infoProperties] \
  101.     {"Controlled Actions"} \
  102.     ]
  103. }
  104.  
  105. method ExtLDbObj::showFile {this} {
  106.     set file [$this path]
  107.     if {! [file exists $file]} {
  108.     wmtkerror "File '$file' does not exist"
  109.     return
  110.     }
  111.     $wmttoolObj startM4Command viewer "$file" "" "$file"
  112. }
  113.  
  114. # Do not delete this line -- regeneration end marker
  115.  
  116.