'From Squeak3.7beta of ''1 April 2004'' [latest update: #5948] on 13 June 2004 at 8:27 am'! "Change Set: BrowserDragFixes-nk Date: 13 June 2004 Author: Ned Konz Fixes the following problems in the Browser (described in ID 22424, 22276, 22260, 6085, 20158, 3498): * drag from the class list with no class selected results in dragging 'nil'. Things break when this is dropped on them. * drag from the class list to the class category list is broken. * drag from the method list with no method selected drags SomeClass->#Definition * drag an uncategorized method from the method list to another empty class in the same browser results in a syntax error * dragging was inconsistent: in class lists if you have one class selected and mouse down on another, the selected class is dragged, while in method lists you drag the item you started dragging on. This changes the policy as follows: * dragging requires selection * the dragged item is always the selection This allows a model to answer nil as the dragPassenger; if it does, then the drag will not be initiated. Also fixes the inability to drag from a MessageSet (ID 8265). "! !Browser methodsFor: 'drag and drop' stamp: 'nk 6/12/2004 17:43'! acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph "Here we are fetching informations from the dropped transferMorph and performing the correct action for this drop." | srcType success srcBrowser | success := false. srcType := transferMorph dragTransferType. srcBrowser := transferMorph source model. srcType == #messageList ifTrue: [ | srcClass srcSelector srcCategory | srcClass := transferMorph passenger key. srcSelector := transferMorph passenger value. srcCategory := srcBrowser selectedMessageCategoryName. srcCategory ifNil: [srcCategory := srcClass organization categoryOfElement: srcSelector]. success := self acceptMethod: srcSelector messageCategory: srcCategory class: srcClass atListMorph: dstListMorph internal: self == srcBrowser copy: transferMorph shouldCopy]. srcType == #classList ifTrue: [success := self changeCategoryForClass: transferMorph passenger srcSystemCategory: srcBrowser selectedSystemCategoryName atListMorph: dstListMorph internal: self == srcBrowser copy: transferMorph shouldCopy]. ^ success! ! !Browser methodsFor: 'drag and drop' stamp: 'nk 6/13/2004 06:32'! dragPassengerFor: item inMorph: dragSource | transferType smn | (dragSource isKindOf: PluggableListMorph) ifFalse: [^nil]. transferType _ self dragTransferTypeForMorph: dragSource. transferType == #classList ifTrue: [^self selectedClass]. transferType == #messageList ifFalse: [ ^nil ]. smn _ self selectedMessageName ifNil: [ ^nil ]. (MessageSet isPseudoSelector: smn) ifTrue: [ ^nil ]. ^ self selectedClassOrMetaClass -> smn. ! ! !Browser methodsFor: 'drag and drop' stamp: 'nk 6/13/2004 06:16'! dstMessageCategoryDstListMorph: dstListMorph | dropItem | ^dstListMorph getListSelector == #messageCategoryList ifTrue: [dropItem _ dstListMorph potentialDropItem. dropItem ifNotNil: [dropItem asSymbol]] ifFalse: [self selectedMessageCategoryName ifNil: [ Categorizer default ]]! ! !Browser methodsFor: 'message category functions' stamp: 'nk 6/13/2004 07:21'! buildMessageCategoryBrowserEditString: aString "Create and schedule a message category browser for the currently selected message category. The initial text view contains the characters in aString." "wod 6/24/1998: set newBrowser classListIndex so that it works whether the receiver is a standard or a Hierarchy Browser." | newBrowser | messageCategoryListIndex ~= 0 ifTrue: [newBrowser _ Browser new. newBrowser systemCategoryListIndex: systemCategoryListIndex. newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName). newBrowser metaClassIndicated: metaClassIndicated. newBrowser messageCategoryListIndex: messageCategoryListIndex. newBrowser messageListIndex: messageListIndex. self class openBrowserView: (newBrowser openMessageCatEditString: aString) label: 'Message Category Browser (' , newBrowser selectedClassOrMetaClassName , ')']! ! !Browser methodsFor: 'message category list' stamp: 'nk 6/13/2004 06:20'! selectMessageCategoryNamed: aSymbol "Given aSymbol, select the category with that name. Do nothing if aSymbol doesn't exist." self messageCategoryListIndex: (self messageCategoryList indexOf: aSymbol ifAbsent: [ 1])! ! !MessageSet methodsFor: 'drag and drop' stamp: 'nk 6/13/2004 07:32'! dragPassengerFor: item inMorph: dragSource | transferType | transferType _ self dragTransferTypeForMorph: dragSource. transferType == #messageList ifTrue: [^self selectedClassOrMetaClass->(item contents findTokens: ' ') second asSymbol]. transferType == #classList ifTrue: [^self selectedClass]. ^nil! ! !PluggableListMorph methodsFor: 'drag and drop' stamp: 'nk 6/13/2004 07:09'! startDrag: evt | ddm draggedItem draggedItemMorph passenger | evt hand hasSubmorphs ifTrue: [^ self]. [(self dragEnabled and: [model okToChange]) ifFalse: [^ self]. (draggedItem := self selection) ifNil: [^ self]. draggedItemMorph := StringMorph contents: draggedItem asStringOrText. passenger := self model dragPassengerFor: draggedItemMorph inMorph: self. passenger ifNil: [^ self]. ddm := TransferMorph withPassenger: passenger from: self. ddm dragTransferType: (self model dragTransferTypeForMorph: self). Preferences dragNDropWithAnimation ifTrue: [self model dragAnimationFor: draggedItemMorph transferMorph: ddm]. evt hand grabMorph: ddm] ensure: [Cursor normal show. evt hand releaseMouseFocus: self]! ! !SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'nk 6/12/2004 17:56'! startDrag: evt | ddm itemMorph passenger | self dragEnabled ifTrue: [itemMorph := scroller submorphs detect: [:any | any highlightedForMouseDown] ifNone: []]. (itemMorph isNil or: [evt hand hasSubmorphs]) ifTrue: [^ self]. itemMorph highlightForMouseDown: false. itemMorph ~= self selectedMorph ifTrue: [self setSelectedMorph: itemMorph]. passenger := self model dragPassengerFor: itemMorph inMorph: self. passenger ifNotNil: [ddm := TransferMorph withPassenger: passenger from: self. ddm dragTransferType: (self model dragTransferTypeForMorph: self). Preferences dragNDropWithAnimation ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm]. evt hand grabMorph: ddm]. evt hand releaseMouseFocus: self! !