The Trunk: Tools-cmm.409.mcz

> 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!
>
>