home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / dropobject.tcl < prev    next >
Text File  |  1997-09-17  |  4KB  |  128 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)dropobject.tcl    /main/titanic/5
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)dropobject.tcl    /main/titanic/5   17 Sep 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. # Abstract class that provides general functionality for objects that
  16. # accept draggable objects.
  17.  
  18. Class DropObject : {Object} {
  19.     constructor
  20.     method destructor
  21.     method setDestinationSet
  22.     method dropCopyEvent
  23.     method dropCutEvent
  24.     method dropEvent
  25. }
  26.  
  27. constructor DropObject {class this name} {
  28.     set this [Object::constructor $class $this $name]
  29.     # Start constructor user section
  30.     # End constructor user section
  31.     return $this
  32. }
  33.  
  34. method DropObject::destructor {this} {
  35.     # Start destructor user section
  36.     # End destructor user section
  37. }
  38.  
  39. method DropObject::setDestinationSet {this} {
  40.     $this destinationSet \
  41.         "CUT_BROWSUIOBJ dropCutEvent BROWSUIOBJ dropCopyEvent"
  42. }
  43.  
  44. method DropObject::dropCopyEvent {this contextList srcIsDst droppedAfterObj droppedBeforeObj} {
  45.     $this dropEvent \
  46.     $contextList $srcIsDst $droppedAfterObj $droppedBeforeObj copy
  47. }
  48.  
  49. method DropObject::dropCutEvent {this contextList srcIsDst droppedAfterObj droppedBeforeObj} {
  50.     $this dropEvent \
  51.     $contextList $srcIsDst $droppedAfterObj $droppedBeforeObj cut
  52. }
  53.  
  54. method DropObject::dropEvent {this contextList srcIsDst droppedAfterObj droppedBeforeObj operation} {
  55.     if [.main undoCommandBusy EditPasteCmd] {
  56.     [.main undoCommand] operation $operation
  57.     }
  58.  
  59.     # getDropTarget returns the target object, either a treenode or a
  60.     # browsObject. The treeNode result parameter returns the the treenode
  61.     # or the parent treenode for a BrowsObject
  62.     set target \
  63.     [$this getDropTarget $droppedAfterObj $droppedBeforeObj treeNode]
  64.     set browsUiObj [$target browsUiObj]
  65.  
  66.     # Drop is not allowed upon frozen target
  67.     if {"[$browsUiObj getInfo Status]" == "frozen"} {
  68.     wmtkmessage "Can not drop into this '[$browsUiObj getInfo Type]' \
  69.              because it is frozen"
  70.     if [isCommand [.main undoCommand]] {
  71.         [.main undoCommand] delete
  72.     }
  73.     return
  74.     }
  75.  
  76.     set done 0
  77.     set fileContextList ""
  78.     foreach context $contextList {
  79.  
  80.     # determine right object type
  81.     set isFileVersion 0
  82.     if {[llength $context] == 7} {
  83.         set type [lindex $context 6]
  84.         if {$type != "GroupVersion"} {
  85.         set isFileVersion 1
  86.         }
  87.     }
  88.  
  89.     set uiClass [lindex $context [expr [llength $context] - 1]]
  90.     if {! [$browsUiObj allowsDrop $uiClass]} {
  91.         wmtkmessage "Can not import '$uiClass' \
  92.              into this '[$browsUiObj getInfo Type]'"
  93.         if [isCommand [.main undoCommand]] {
  94.         [.main undoCommand] delete
  95.         }
  96.         return
  97.     }
  98.  
  99.     if $isFileVersion {
  100.         lappend fileContextList $context
  101.     } else {
  102.         set done \
  103.         [expr $done || [$browsUiObj importObject $context $treeNode]]
  104.     }
  105.     }
  106.  
  107.     if {$fileContextList != ""} {
  108.     busy {
  109.         set done [$browsUiObj importObjects $fileContextList $treeNode]
  110.     }
  111.     }
  112.  
  113.     $this postDropUpdate $target $treeNode
  114.  
  115.     if [.main undoCommandBusy] {
  116.     [.main undoCommand] busy 0
  117.     }
  118.  
  119.     if {$done && $operation == "cut"} {
  120.     # reset clipboard when cut action is finished
  121.     [.main flatView] conversionSet ""
  122.     [.main flatView] setClipboardValue
  123.     }
  124. }
  125.  
  126. # Do not delete this line -- regeneration end marker
  127.  
  128.