home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / draginfoob.tcl < prev    next >
Encoding:
Text File  |  1997-11-21  |  4.0 KB  |  145 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)draginfoob.tcl    /main/titanic/6
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)draginfoob.tcl    /main/titanic/6   21 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 "infoobject.tcl"
  15.  
  16. Class DragInfoObj : {InfoObject} {
  17.     constructor
  18.     method destructor
  19.     method promoter
  20.     method contextList
  21.     method lvlPath
  22.     method linkSource
  23.     method shellLink
  24. }
  25.  
  26. global DragInfoObj::lastShellLink
  27. set DragInfoObj::lastShellLink ""
  28.  
  29.  
  30. constructor DragInfoObj {class this name browsUiObj} {
  31.     set this [InfoObject::constructor $class $this $name $browsUiObj]
  32.     # Start constructor user section
  33.  
  34.     $this promoter
  35.  
  36.     # End constructor user section
  37.     return $this
  38. }
  39.  
  40. method DragInfoObj::destructor {this} {
  41.     # Start destructor user section
  42.     global DragInfoObj::lastShellLink
  43.     if {${DragInfoObj::lastShellLink} != ""} {
  44.         unlink -nocomplain ${DragInfoObj::lastShellLink}
  45.         set DragInfoObj::lastShellLink ""
  46.     }
  47.     # End destructor user section
  48.     $this InfoObject::destructor
  49. }
  50.  
  51. method DragInfoObj::promoter {this} {
  52.     set cvSet "BROWSUIOBJ contextList"
  53.     if [[$this browsUiObj] isA Graph] {
  54.         if {![catch {set type [nt_get_type [$this lvlPath]]}]} {
  55.             set type [string toupper $type]
  56.             append cvSet " ${type}DRAGOBJECT lvlPath"
  57.             if $win95 {
  58.                 append cvSet " HDROP shellLink"
  59.             }
  60.         }
  61.     }
  62.     $this conversionSet $cvSet
  63. }
  64.  
  65. method DragInfoObj::contextList {this} {
  66.     set context ""
  67.     set uiObj [$this browsUiObj]
  68.     set proj [$uiObj getParent Project]
  69.     if {"$proj" != ""} {
  70.     lappend context [$proj getInfo Identity]
  71.     set confV [$uiObj getParent ConfigVersion]
  72.     if {"$confV" != ""} {
  73.         lappend context [$confV getInfo Identity]
  74.         set phaseV [$uiObj getParent PhaseVersion]
  75.         if {"$phaseV" != ""} {
  76.         lappend context [$phaseV getInfo Identity]
  77.         set sysV [$uiObj getParent SystemVersion]
  78.         if {"$sysV" != ""} {
  79.             lappend context [$sysV getInfo Identity]
  80.         }
  81.         }
  82.     }
  83.     }
  84.     lappend context [$uiObj getInfo Identity]
  85.     lappend context [$uiObj browserType]
  86.     lappend context [$uiObj uiClass]
  87.     return [list $context]
  88. }
  89.  
  90. method DragInfoObj::lvlPath {this} {
  91.     # this can go wrong in corporate groups,
  92.     # catch it
  93.     set uiObj [$this browsUiObj]
  94.     if [$uiObj isA FileVersion] {
  95.     set confV [$uiObj getParent ConfigVersion]
  96.     set phaseV [$uiObj getParent PhaseVersion]
  97.     set sysV [$uiObj getParent SystemVersion]
  98.     set file [$uiObj file]
  99.     set cc [ClientContext::global]
  100.     set fName [$file qualifiedName /].[$file type]
  101.     return [[$cc createPath $confV $phaseV $sysV] asString]/$fName
  102.     }
  103. }
  104.  
  105. method DragInfoObj::linkSource {this} {
  106.     # !! Implement this function !!
  107. }
  108.  
  109. method DragInfoObj::shellLink {this} {
  110.     global DragInfoObj::lastShellLink
  111.     if {${DragInfoObj::lastShellLink} != ""} {
  112.     unlink -nocomplain ${DragInfoObj::lastShellLink}
  113.     set DragInfoObj::lastShellLink ""
  114.     }
  115.     set uiObj [$this browsUiObj]
  116.     if [$uiObj isA FileVersion] {
  117.     set confV [$uiObj getParent ConfigVersion]
  118.     set phaseV [$uiObj getParent PhaseVersion]
  119.     set sysV [$uiObj getParent SystemVersion]
  120.     set file [$uiObj file]
  121.     set cc [ClientContext::global]
  122.     set fName [$file qualifiedName /].[$file type]
  123.     set lvl [[$cc createPath $confV $phaseV $sysV] asString]/$fName
  124.  
  125.  
  126.     if [catch {set shl [ShellLink new]} msg] {
  127.         # ignore 
  128.         # probably NT 3.51
  129.         wmtkerror $msg
  130.         return
  131.     }
  132.     $shl path [m4_path_name bin otk.exe]
  133.     $shl arguments "[m4_path_name tcl ude.tcl] -- $lvl"
  134.     set guiName \
  135.      "[$file qualifiedName " "] [ShortLongName::longName [$file type]].lnk"
  136.     set f $env(TMP)\\$guiName
  137.     $shl createIt $f
  138.     set DragInfoObj::lastShellLink [list $f]
  139.     return [list $f]
  140.     }
  141. }
  142.  
  143. # Do not delete this line -- regeneration end marker
  144.  
  145.