home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / dragbrowsv.tcl < prev    next >
Encoding:
Text File  |  1997-11-21  |  3.8 KB  |  140 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)dragbrowsv.tcl    /main/titanic/7
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)dragbrowsv.tcl    /main/titanic/7   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 "dropobject.tcl"
  15.  
  16. Class DragBrowsView : {DropObject BrowsView} {
  17.     method destructor
  18.     constructor
  19.     method getDropTarget
  20.     method postDropUpdate
  21.     method contextList
  22.     method updateConversionSet
  23.     method shellLink
  24. }
  25.  
  26. global DragBrowsView::lastShellLink
  27. set DragBrowsView::lastShellLink ""
  28.  
  29.  
  30. method DragBrowsView::destructor {this} {
  31.     # Start destructor user section
  32.     global DragBrowsView::lastShellLink
  33.     if {${DragBrowsView::lastShellLink} != ""} {
  34.         unlink -nocomplain ${DragBrowsView::lastShellLink}
  35.         set DragBrowsView::lastShellLink ""
  36.     }
  37.     # End destructor user section
  38.     $this DropObject::destructor
  39. }
  40.  
  41. constructor DragBrowsView {class this name} {
  42.     set this [BrowsView::constructor $class $this $name]
  43.         $this setDestinationSet
  44.     return $this
  45. }
  46.  
  47. method DragBrowsView::getDropTarget {this droppedAfterObj droppedBeforeObj treeNode} {
  48.     upvar $treeNode node
  49.     set node [.main currentObj]
  50.     if { ![isCommand $node] } {
  51.     set node [lindex [[.main treeView] rootSet 0]]
  52.     }
  53.     # if droppedBeforeObj is empty the drop was somewhere in the view,
  54.     # not on a particular object.
  55.     if { ($droppedBeforeObj == "") || (![isCommand $droppedAfterObj]) } {
  56.     set target $node
  57.     } else {
  58.     set target $droppedAfterObj
  59.     }
  60.     return $target
  61. }
  62.  
  63. method DragBrowsView::postDropUpdate {this target node} {
  64.     if { $target == $node } {
  65.     return
  66.     }
  67.  
  68.     # check if target node is also in the tree view and unfolded
  69.     set treeNode [[$target browsUiObj] treeNode]
  70.     if { $treeNode == "" } {
  71.     return
  72.     }
  73.  
  74.     # if so update it
  75.     if {(! [$treeNode foldState]) && (! [$treeNode activeState])} {
  76.     $treeNode appendChildren
  77.     }
  78. }
  79.  
  80. method DragBrowsView::contextList {this} {
  81.     set contextList ""
  82.     foreach flatObj [$this selectedSet] {
  83.     if [$flatObj isA DragInfoObj] {
  84.         lappend contextList [lindex [$flatObj contextList] 0]
  85.     }
  86.     }
  87.     return $contextList
  88. }
  89.  
  90. method DragBrowsView::updateConversionSet {this} {
  91.     if [BrowserProcs::objectsReturn canBeDragged] {
  92.     set cvSet "BROWSUIOBJ contextList"
  93.     if $win95 {
  94.         append cvSet " HDROP shellLink"
  95.     }
  96.     $this conversionSet $cvSet
  97.     } else {
  98.     $this conversionSet ""
  99.     }
  100. }
  101.  
  102. method DragBrowsView::shellLink {this} {
  103.     global DragBrowsView::lastShellLink
  104.     if {${DragBrowsView::lastShellLink} != ""} {
  105.     unlink -nocomplain ${DragBrowsView::lastShellLink}
  106.     set DragBrowsView::lastShellLink ""
  107.     }
  108.     set files ""
  109.     foreach flatObj [$this selectedSet] {
  110.     if [$flatObj isA DragInfoObj] {
  111.         set uiObj [$flatObj browsUiObj]
  112.         set file [$uiObj file]
  113.         if ![$uiObj isA Graph] {
  114.         wmtkmessage "Can not create shortcut for object of type\
  115.             '[ShortLongName::longName [$file type]]'."
  116.         continue
  117.         }
  118.         if [catch {set shl [ShellLink new]} msg] {
  119.         # ignore 
  120.         # probably NT 3.51
  121.         wmtkerror $msg
  122.         return
  123.         }
  124.         $shl path [m4_path_name bin otk.exe]
  125.         set lvlPath [$flatObj lvlPath]
  126.         $shl arguments "[m4_path_name tcl ude.tcl] -- $lvlPath"
  127.         set guiName \
  128.      "[$file qualifiedName " "] [ShortLongName::longName [$file type]].lnk"
  129.         set f $env(TMP)\\$guiName
  130.         $shl createIt $f
  131.         lappend files $f
  132.     }
  133.     }
  134.     set DragBrowsView::lastShellLink $files
  135.     return $files
  136. }
  137.  
  138. # Do not delete this line -- regeneration end marker
  139.  
  140.