drag&drop:allow dropping st-files from the windows explorer
authorClaus Gittinger <cg@exept.de>
Wed, 18 Oct 2006 13:11:29 +0200
changeset 7425 9e029102ef55
parent 7424 cb6c951e5728
child 7426 20b61b1d15ff
drag&drop:allow dropping st-files from the windows explorer
Tools_ClassCategoryList.st
--- a/Tools_ClassCategoryList.st	Wed Oct 18 13:11:26 2006 +0200
+++ b/Tools_ClassCategoryList.st	Wed Oct 18 13:11:29 2006 +0200
@@ -9,7 +9,6 @@
  other person.  No title to or ownership of the software is
  hereby transferred.
 "
-
 "{ Package: 'stx:libtool' }"
 
 "{ NameSpace: Tools }"
@@ -413,10 +412,13 @@
 !ClassCategoryList methodsFor:'drag & drop'!
 
 canDropContext:aDropContext
-    |cat droppedClasses|
+    |cat objects droppedClasses|
 
-    droppedClasses := aDropContext dropObjects collect:[:obj | obj theObject].
-    (droppedClasses conform:[:aClass | aClass isClass]) ifFalse:[^ false].
+    objects := aDropContext dropObjects collect:[:obj | obj theObject].
+    (self objectsAreClassFiles:objects) ifTrue:[^ true].
+
+    (objects conform:[:aClass | aClass isClass]) ifFalse:[^ false].
+    droppedClasses := objects.
     (droppedClasses contains:[:aClass | aClass isPrivate not]) ifFalse:[^ false].
 
     cat := self categoryAtTargetPointOf:aDropContext.
@@ -426,7 +428,7 @@
     (droppedClasses contains:[:aClass | aClass category ~= cat]) ifFalse:[^ false].
     ^ true.
 
-    "Modified: / 13-09-2006 / 11:42:22 / cg"
+    "Modified: / 17-10-2006 / 18:28:04 / cg"
 !
 
 categoryAtTargetPointOf:aDropContext
@@ -449,17 +451,22 @@
 !
 
 doDropContext:aDropContext
-    |cat droppedClasses|
+    |cat objects|
 
-    droppedClasses := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
-    (droppedClasses conform:[:something | something isClass]) ifFalse:[^ self].
-
-    cat := self categoryAtTargetPointOf:aDropContext.
-    cat notNil ifTrue:[
-        self masterApplication moveClasses:droppedClasses toCategory:cat.
+    objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+    (objects conform:[:something | something isClass]) ifTrue:[
+        cat := self categoryAtTargetPointOf:aDropContext.
+        cat notNil ifTrue:[
+            self masterApplication moveClasses:objects toCategory:cat.
+        ].
+        ^ self
+    ].
+    (objects conform:[:something | something isFilename]) ifTrue:[
+        self dropClassFiles:objects.
+        ^ self
     ].
 
-    "Modified: / 13-09-2006 / 11:42:37 / cg"
+    "Modified: / 17-10-2006 / 18:29:25 / cg"
 ! !
 
 !ClassCategoryList methodsFor:'generators'!
@@ -806,5 +813,5 @@
 !ClassCategoryList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.16 2006-09-13 09:47:48 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.17 2006-10-18 11:11:29 cg Exp $'
 ! !