[Pkg] The Trunk: Tools-cmm.409.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 28 03:01:43 UTC 2012


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!



More information about the Packages mailing list