Chris Muller uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-cmm.409.mcz
==================== Summary ====================
Name: Tools-cmm.409 Author: cmm Time: 27 May 2012, 10:01:04.714 pm UUID: a45e1538-f3ab-4ca2-954a-13cb6caeff7c Ancestors: Tools-cmm.408
- Recover FileList's drag-and-drop capabilities. - Recover HierarchyBrowser's drag-and-drop capabilities.
=============== Diff against Tools-cmm.408 ===============
Item was changed: ----- Method: Browser>>dragFromClassList: (in category 'drag and drop') ----- + dragFromClassList: index - dragFromClassList: index "Drag a class from the browser" | name envt | + (name := self classList at: index) ifNil: [ ^ nil ]. + (envt := self selectedEnvironment) ifNil: [ ^ nil ]. + ^ envt + at: name withBlanksTrimmed asSymbol + ifAbsent: [ ]! - (name := self classList at: index) ifNil: [^ nil]. - (envt := self selectedEnvironment) ifNil: [^ nil]. - ^ envt at: name ifAbsent:[nil]!
Item was changed: ----- Method: FileList class>>windowColorSpecification (in category 'window color') ----- windowColorSpecification "Answer a WindowColorSpec object that declares my preference" + ^ WindowColorSpec + classSymbol: self name + wording: 'File List' + brightColor: #lightGray + pastelColor: #lightGray + helpMessage: 'A tool for looking at files'! - - ^ WindowColorSpec classSymbol: self name wording: 'File List' brightColor: #lightMagenta pastelColor: #paleMagenta helpMessage: 'A tool for looking at files'!
Item was changed: ----- Method: FileList>>buildDirectoryTreeWith: (in category 'toolbuilder') ----- + buildDirectoryTreeWith: builder - buildDirectoryTreeWith: builder | treeSpec | treeSpec := builder pluggableTreeSpec new. + treeSpec + model: self ; + roots: #rootDirectoryList ; + hasChildren: #hasMoreDirectories: ; + getChildren: #subDirectoriesOf: ; + getSelectedPath: #selectedPath ; + setSelected: #setDirectoryTo: ; + label: #directoryNameOf: ; + menu: #volumeMenu: ; + autoDeselect: false. + Preferences browseWithDragNDrop ifTrue: + [ treeSpec + dragItem: #dragFromDirectoryList: ; + dropItem: #drop:ontoDirectory:shouldCopy: ]. + ^ treeSpec! - treeSpec - model: self; - roots: #rootDirectoryList; - hasChildren: #hasMoreDirectories:; - getChildren: #subDirectoriesOf:; - getSelectedPath: #selectedPath; - setSelected: #setDirectoryTo:; - label: #directoryNameOf:; - menu: #volumeMenu:; - autoDeselect: false. - ^treeSpec - !
Item was changed: ----- Method: FileList>>buildFileListWith: (in category 'toolbuilder') ----- + buildFileListWith: builder - buildFileListWith: builder | buttons listSpec top | top := builder pluggablePanelSpec new. top children: OrderedCollection new. - buttons := self buildButtonPaneWith: builder. + buttons frame: + (self + topConstantHeightFrame: self buttonHeight + fromLeft: 0 + width: 1). - buttons frame: (self topConstantHeightFrame: self buttonHeight fromLeft: 0 width: 1). top children add: buttons. - listSpec := builder pluggableListSpec new. + listSpec + model: self ; + list: #fileList ; + getIndex: #fileListIndex ; + setIndex: #fileListIndex: ; + menu: #fileListMenu: ; + keyPress: nil ; + frame: + (self + frameOffsetFromTop: self buttonHeight + 4 + fromLeft: 0 + width: 1 + bottomFraction: 1) ; + color: Color white. + Preferences browseWithDragNDrop ifTrue: [ listSpec dragItem: #dragFromFileList: ]. - listSpec - model: self; - list: #fileList; - getIndex: #fileListIndex; - setIndex: #fileListIndex:; - menu: #fileListMenu:; - keyPress: nil; - frame: (self frameOffsetFromTop: self buttonHeight + 4 fromLeft: 0 width: 1 bottomFraction: 1); - color: Color white. top children add: listSpec. + ^ top! - ^top. - !
Item was changed: ----- Method: FileList>>directory: (in category 'initialization') ----- + directory: aFileDirectory - directory: dir "Set the path of the volume to be displayed." + self okToChange ifFalse: [ ^ self ]. - - self okToChange ifFalse: [^ self]. - self modelSleep. + directory := aFileDirectory. - directory := dir. self modelWakeUp. + sortMode == nil ifTrue: [ sortMode := #date ]. + volList := (Array with: '[]') , directory pathParts withIndexCollect: + [ : each : i | (String + new: i - 1 + withAll: Character space) , each ]. - - sortMode == nil ifTrue: [sortMode := #date]. - volList := ((Array with: '[]'), directory pathParts) "Nesting suggestion from RvL" - withIndexCollect: [:each :i | ( String new: i-1 withAll: $ ), each]. volListIndex := volList size. self changed: #relabel. self changed: #volumeList. + self pattern: pattern! - self pattern: pattern.!
Item was added: + ----- Method: FileList>>dragFromDirectoryList: (in category 'file list') ----- + dragFromDirectoryList: anIndex + ^ self directory!
Item was added: + ----- Method: FileList>>dragFromFileList: (in category 'file list') ----- + dragFromFileList: anIndex + ^ self directory entryAt: (self fileNameFromFormattedItem: (self fileList at: self fileListIndex))!
Item was added: + ----- Method: FileList>>dragPassengerFor:inMorph: (in category 'drag''n''drop') ----- + dragPassengerFor: item inMorph: dragSource + ^self directory fullNameFor: ((self fileNameFromFormattedItem: item contents copy) + copyReplaceAll: self folderString with: ''). + !
Item was added: + ----- Method: FileList>>drop:ontoDirectory: (in category 'toolbuilder') ----- + drop: aDirectoryEntryFile ontoDirectory: aFileDirectory + | oldName oldEntry newName newEntry baseName response | + self halt. + oldName := aDirectoryEntryFile fullName. + baseName := FileDirectory localNameFor: oldName. + newName := aFileDirectory fullNameFor: baseName. + newName = oldName ifTrue: [ "Transcript nextPutAll: 'same as old name'; cr." + ^ true ]. + oldEntry := FileDirectory directoryEntryFor: oldName. + newEntry := FileDirectory directoryEntryFor: newName. + newEntry ifNotNil: + [ | msg | + msg := String streamContents: + [ : s | s + nextPutAll: 'destination file ' ; + nextPutAll: newName ; + nextPutAll: ' exists already,' ; + cr ; + nextPutAll: 'and is ' ; + nextPutAll: + (oldEntry modificationTime < newEntry modificationTime + ifTrue: [ 'newer' ] + ifFalse: [ 'not newer' ]) ; + nextPutAll: ' than source file ' ; + nextPutAll: oldName ; + nextPut: $. ; + cr ; + nextPutAll: 'Overwrite file ' ; + nextPutAll: newName ; + nextPut: $? ]. + response := self confirm: msg. + response ifFalse: [ ^ false ] ]. + " aTransferMorph shouldCopy + ifTrue: + [ self + primitiveCopyFileNamed: oldName + to: newName ] + " false ifFalse: + [ directory + rename: oldName + toBe: newName ]. + self + updateFileList ; + fileListIndex: 0. + ^ true!
Item was added: + ----- Method: FileList>>drop:ontoDirectory:shouldCopy: (in category 'toolbuilder') ----- + drop: aDirectoryEntryFile ontoDirectory: aFileDirectory shouldCopy: aBoolean + aDirectoryEntryFile containingDirectory = aFileDirectory ifTrue: [ ^ self ]. + aBoolean + ifTrue: [ aFileDirectory copyHere: aDirectoryEntryFile ] + ifFalse: + [ directory + rename: aDirectoryEntryFile fullName + toBe: (aFileDirectory fullNameFor: aDirectoryEntryFile name). + self setDirectoryTo: directory ]!
Item was changed: ----- Method: FileList2>>dropDestinationDirectory:event: (in category 'drag''n''drop') ----- dropDestinationDirectory: dest event: evt "Answer a FileDirectory representing the drop destination in the directory hierarchy morph dest" + self isThisEverCalled. ^ (dest itemFromPoint: evt position) withoutListWrapper!