[squeak-dev] The Trunk: Morphic-ar.197.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Oct 5 05:32:06 UTC 2009


Andreas Raab uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-ar.197.mcz

==================== Summary ====================

Name: Morphic-ar.197
Author: ar
Time: 4 October 2009, 10:30:26 am
UUID: 1143af40-9a31-7945-8d3f-6c70652a34e3
Ancestors: Morphic-ml.196

First pass on a FileList based on ToolBuilder. Slightly different layout; providing the directory view in full height and allowing editing both match pattern as well as directory via input field. Subclasses will be rewhacked later.

=============== Diff against Morphic-ml.196 ===============

Item was added:
+ ----- Method: FileList2>>optionalButtonRow (in category 'initialization') -----
+ optionalButtonRow
+ 	"Answer the button row associated with a file list"
+ 
+ 	| aRow |
+ 	aRow := AlignmentMorph newRow beSticky.
+ 	aRow color: Color transparent.
+ 	aRow clipSubmorphs: true.
+ 	aRow layoutInset: 5 at 1; cellInset: 6.
+ 	self universalButtonServices do:  "just the three sort-by items"
+ 			[:service |
+ 				aRow addMorphBack: (service buttonToTriggerIn: self).
+ 				(service selector  == #sortBySize)
+ 					ifTrue:
+ 						[aRow addTransparentSpacerOfSize: (4 at 0)]].
+ 	aRow setNameTo: 'buttons'.
+ 	aRow setProperty: #buttonRow toValue: true.  "Used for dynamic retrieval later on"
+ 	^ aRow!

Item was changed:
  ----- Method: FileList>>directory: (in category 'initialization') -----
  directory: dir
  	"Set the path of the volume to be displayed."
  
  	self okToChange ifFalse: [^ self].
  
  	self modelSleep.
  	directory := dir.
  	self modelWakeUp.
  
  	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>>buildDirectoryTreeWith: (in category 'toolbuilder') -----
+ buildDirectoryTreeWith: builder
+ 	| treeSpec |
+ 	treeSpec := builder pluggableTreeSpec new.
+ 	treeSpec 
+ 			model: self;
+ 			roots: #rootDirectoryList;
+ 			hasChildren: #hasMoreDirectories:;
+ 			getChildren: #subDirectoriesOf:;
+ 			getSelectedPath: #selectedPath; 
+ 			setSelected: #setDirectoryTo:;
+ 			label: #directoryNameOf:;
+ 			autoDeselect: false.
+ 	^treeSpec
+ !

Item was changed:
  ----- Method: FileList>>labelString (in category 'initialization') -----
  labelString
+ 	^'File List'!
- 	^ directory pathName contractTo: 50!

Item was added:
+ ----- Method: FileList>>directoryNameOf: (in category 'directory tree') -----
+ directoryNameOf: aDirectory
+ 	^aDirectory localName!

Item was added:
+ ----- Method: FileList>>executeService: (in category 'toolbuilder') -----
+ executeService: aService
+ 	aService performServiceFor: self.!

Item was added:
+ ----- Method: FileList class>>new (in category 'instance creation') -----
+ new
+ 	^self newOn: FileDirectory default!

Item was changed:
  ----- Method: FileList class>>open (in category 'instance creation') -----
  open
  	"Open a view of an instance of me on the default directory."
+ 	^ToolBuilder open: self!
- 	"FileList open"
- 	| dir aFileList topView volListView templateView fileListView fileContentsView underPane pHeight |
- 	Smalltalk isMorphic ifTrue: [^ self openAsMorph].
- 
- 	dir := FileDirectory default.
- 	aFileList := self new directory: dir.
- 	topView := StandardSystemView new.
- 	topView
- 		model: aFileList;
- 		label: dir pathName;
- 		minimumSize: 200 at 200.
- 	topView borderWidth: 1.
- 
- 	volListView := PluggableListView on: aFileList
- 		list: #volumeList
- 		selected: #volumeListIndex
- 		changeSelected: #volumeListIndex:
- 		menu: #volumeMenu:.
- 	volListView autoDeselect: false.
- 	volListView window: (0 at 0 extent: 80 at 45).
- 	topView addSubView: volListView.
- 
- 	templateView := PluggableTextView on: aFileList
- 		text: #pattern
- 		accept: #pattern:.
- 	templateView askBeforeDiscardingEdits: false.
- 	templateView window: (0 at 0 extent: 80 at 15).
- 	topView addSubView: templateView below: volListView.
- 
- 	aFileList wantsOptionalButtons
- 		ifTrue:
- 			[underPane := aFileList optionalButtonView.
- 			underPane isNil
- 				ifTrue: [pHeight := 60]
- 				ifFalse: [
- 					topView addSubView: underPane toRightOf: volListView.
- 					pHeight := 60 - aFileList optionalButtonHeight]]
- 		ifFalse:
- 			[underPane := nil.
- 			pHeight := 60].
- 
- 	fileListView := PluggableListView on: aFileList
- 		list: #fileList
- 		selected: #fileListIndex
- 		changeSelected: #fileListIndex:
- 		menu: #fileListMenu:.
- 	fileListView window: (0 at 0 extent: 120 at pHeight).
- 	underPane isNil
- 		ifTrue: [topView addSubView: fileListView toRightOf: volListView]
- 		ifFalse: [topView addSubView: fileListView below: underPane].
- 	fileListView controller terminateDuringSelect: true.  "Pane to left may change under scrollbar"
- 
- 	fileContentsView := PluggableTextView on: aFileList
- 		text: #contents accept: #put:
- 		readSelection: #contentsSelection menu: #fileContentsMenu:shifted:.
- 	fileContentsView window: (0 at 0 extent: 200 at 140).
- 	topView addSubView: fileContentsView below: templateView.
- 
- 	topView controller open!

Item was added:
+ ----- Method: FileList>>hasMoreDirectories: (in category 'directory tree') -----
+ hasMoreDirectories: aDirectory
+ 	(aDirectory isKindOf: FileDirectory) ifFalse:[^true]. "server directory; don't ask"
+ 	^directoryCache at: aDirectory ifAbsentPut:[
+ 		[aDirectory directoryNames notEmpty] on: Error do:[:ex| true].
+ 	].!

Item was added:
+ ----- Method: FileList>>buildContentPaneWith: (in category 'toolbuilder') -----
+ buildContentPaneWith: builder
+ 	| textSpec |
+ 	textSpec := builder pluggableTextSpec new.
+ 	textSpec 
+ 		model: self;
+ 		getText: #contents; 
+ 		setText: #put:; 
+ 		selection: #contentsSelection; 
+ 		menu: #fileContentsMenu:shifted:.
+ 	^textSpec
+ !

Item was added:
+ ----- Method: FileList class>>newOn: (in category 'instance creation') -----
+ newOn: aDirectory
+ 	^super new directory: aDirectory!

Item was added:
+ ----- Method: FileList>>buildWith: (in category 'toolbuilder') -----
+ buildWith: builder
+ 	"FileList open"
+ 	| windowSpec window |
+ 	windowSpec := 	self buildWindowWith: builder specs: {
+ 		(0 at 0 corner: 1 at 0.06) -> [self buildPatternInputWith: builder].
+ 		(0.25 at 0.06 corner: 1 at 0.15) -> [self buildButtonPaneWith: builder].
+ 		(0 at 0.06 corner: 0.25 at 1) -> [self buildDirectoryTreeWith: builder].
+ 		(0.25 at 0.15 corner: 1 at 0.5) -> [self buildFileListWith: builder].
+ 		(0.25 at 0.5 corner: 1 at 1) -> [self buildContentPaneWith: builder].
+ 	}.
+ 	window := builder build: windowSpec.
+ 	self changed: #selectedPath.
+ 	^window!

Item was added:
+ ----- Method: FileList>>selectedPath (in category 'directory tree') -----
+ selectedPath
+ 	| top here next |
+ 	top := FileDirectory root.
+ 	here := directory.
+ 	^(Array streamContents:[:s|
+ 		s nextPut: here.
+ 		[next := here containingDirectory.
+ 		top pathName = next pathName] whileFalse:[
+ 			s nextPut: next.
+ 			here := next.
+ 		]]) reversed.!

Item was added:
+ ----- Method: FileList>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	directoryCache := WeakIdentityKeyDictionary new.!

Item was added:
+ ----- Method: FileList>>pathAndPattern (in category 'volume list and pattern') -----
+ pathAndPattern
+ 	"Answers both path and pattern"
+ 	^directory fullName, directory slash, pattern!

Item was changed:
  StringHolder subclass: #FileList
+ 	instanceVariableNames: 'fileName directory volList volListIndex list listIndex pattern sortMode brevityState directoryCache'
- 	instanceVariableNames: 'fileName directory volList volListIndex list listIndex pattern sortMode brevityState'
  	classVariableNames: 'FileReaderRegistry RecentDirs'
  	poolDictionaries: ''
  	category: 'Morphic-FileList'!
  
  !FileList commentStamp: 'nk 11/26/2002 11:52' prior: 0!
  I am model that can be used to navigate the host file system. By omitting the volume list, file list, and template panes from the view, I can also be used as the model for an editor on an individual file.
  
  The FileList now provides a registration mechanism to which any tools the filelist uses ***MUST*** register.  This way it is possible to dynamically load or unload a new tool and have the FileList automatically updated.  This change supports a decomposition of Squeak and removes a problem with dead reference to classes after a major shrink.
  
  Tools should implement the following methods (look for implementors in the image):
  
  #fileReaderServicesForFile:suffix: (appropriate services for given file, takes a file name and a lowercased suffix)
  
  #services (all provided services, to be displayed in full list)
  
  These methods both return a collection of SimpleServiceEntry instances.  These contain a class, a menu label and a method selector having one argument.  They may also provide separate button labels and description.
  
  The argument to the specified method will be a string representing the full name of a file when one is selected or the file list itself when there is no selected file.
  
  Tools must register with the FileList calling the class method #registerFileReader: when they load. They also must call #unregisterFileReader: when they unload.
  
  There is a testSuite called FileListTest that presents some examples. 
  
  Stef (I do not like really this distinction passing always a file list could be better)
  
  
  Old Comments: 
  
  
  FileLists can now see FTP servers anywhere on the net.  In the volume list menu: 
  fill in server info...		Gives you a form to register a new ftp server you want to use.
  open server...		Choose a server to connect to.
  local disk			Go back to looking at your local volume.
  
  
  Still undone (you can contribute code):
  [ ] Using a Proxy server to get out through a firewall.  What is the convention for proxy servers with FTP?
  [ ] Fill in the date and size info in the list of remote files.  Allow sorting by it.  New smarts needed in (ServerDirectory fileNameFormattedFrom:sizePad:sortMode:).
  [ ] Currently the FileList has no way to delete a directory.  Since you can't select a directory without going into it, it would have to be deleting the current directory.  Which would usually be empty.!

Item was added:
+ ----- Method: FileList>>buildButtonPaneWith: (in category 'toolbuilder') -----
+ buildButtonPaneWith: builder
+ 	| panelSpec |
+ 	panelSpec := builder pluggablePanelSpec new.
+ 	panelSpec 
+ 		model: self;
+ 		children: #getButtonRow;
+ 		layout: #horizontal.
+ 	^panelSpec
+ !

Item was changed:
  ----- Method: FileList class>>prototypicalToolWindow (in category 'instance creation') -----
  prototypicalToolWindow
  	"Answer an example of myself seen in a tool window, for the benefit of parts-launching tools"
+ 	^ ToolBuilder build: self new!
- 
- 	^ self openAsMorph applyModelExtent!

Item was added:
+ ----- Method: FileList>>getButtonRow (in category 'toolbuilder') -----
+ getButtonRow
+ 	"Answer the dynamic button row to use for the currently selected item."
+ 	| builder svc |
+ 	builder := ToolBuilder default.
+ 	svc := self universalButtonServices.
+ 	self fileListIndex = 0 ifFalse:[svc := svc, self dynamicButtonServices].
+ 	^svc collect:[:service| service buildWith: builder in: self].!

Item was changed:
  ----- Method: FileList>>entriesMatching: (in category 'private') -----
  entriesMatching: patternString
  	"Answer a list of directory entries which match the patternString.
  	The patternString may consist of multiple patterns separated by ';'.
  	Each pattern can include a '*' or '#' as wildcards - see String>>match:"
  
  	| entries patterns |
+ 	entries := directory entries reject:[:e| e isDirectory].
- 	entries := directory entries.
  	patterns := patternString findTokens: ';'.
  	(patterns anySatisfy: [:each | each = '*'])
  		ifTrue: [^ entries].
+ 	^ entries select: [:entry | patterns anySatisfy: [:each | each match: entry first]]!
- 	^ entries select: [:entry | 
- 		entry isDirectory or: [patterns anySatisfy: [:each | each match: entry first]]]!

Item was added:
+ ----- Method: FileList>>buildPatternInputWith: (in category 'toolbuilder') -----
+ buildPatternInputWith: builder
+ 	| textSpec |
+ 	textSpec := builder pluggableInputFieldSpec new.
+ 	textSpec 
+ 		model: self;
+ 		getText: #pathAndPattern; 
+ 		setText: #pathAndPattern:.
+ 	^textSpec
+ !

Item was added:
+ ----- Method: FileList>>setDirectoryTo: (in category 'directory tree') -----
+ setDirectoryTo: dir
+ 	self directory: dir.
+ 	brevityState := #FileList.
+ 	self changed: #fileList.
+ 	self changed: #contents.
+ 	self changed: #pathAndPattern.!

Item was changed:
  ----- Method: FileList>>volumeListIndex: (in category 'volume list and pattern') -----
  volumeListIndex: index
  	"Select the volume name having the given index."
  
  	| delim path |
  	volListIndex := index.
  	index = 1 
  		ifTrue: [self directory: (FileDirectory on: '')]
  		ifFalse: [delim := directory pathNameDelimiter.
  				path := String streamContents: [:strm |
  					2 to: index do: [:i |
  						strm nextPutAll: (volList at: i) withBlanksTrimmed.
  						i < index ifTrue: [strm nextPut: delim]]].
  				self directory: (directory on: path)].
  	brevityState := #FileList.
  	self addPath: path.
  	self changed: #fileList.
  	self changed: #contents.
+ 	self updateButtonRow.!
- 	self updateButtonRow!

Item was added:
+ ----- Method: FileList>>pathAndPattern: (in category 'volume list and pattern') -----
+ pathAndPattern: stringOrText
+ 	"Answers both path and pattern"
+ 	| base pat aString |
+ 	aString := stringOrText asString.
+ 	base := aString copyUpToLast: directory pathNameDelimiter.
+ 	pat := aString copyAfterLast: directory pathNameDelimiter.
+ 	self changed: #pathAndPattern. "avoid asking if it's okToChange"
+ 	pattern := pat.
+ 	self directory: (FileDirectory on: base).
+ 	self changed: #pathAndPattern.
+ 	self changed: #selectedPath.!

Item was added:
+ ----- Method: FileList>>buildFileListWith: (in category 'toolbuilder') -----
+ buildFileListWith: builder
+ 	| listSpec |
+ 	listSpec := builder pluggableListSpec new.
+ 	listSpec 
+ 		model: self;
+ 		list: #fileList; 
+ 		getIndex: #fileListIndex; 
+ 		setIndex: #fileListIndex:; 
+ 		menu: #fileListMenu:; 
+ 		keyPress: nil.
+ 	^listSpec
+ !

Item was changed:
  ----- Method: TheWorldMenu>>openFileList (in category 'commands') -----
  openFileList
+ 	FileList open.!
- 	FileList2 prototypicalToolWindow openInWorld: myWorld!

Item was changed:
  ----- Method: FileList>>updateButtonRow (in category 'initialization') -----
  updateButtonRow
  	"Dynamically update the contents of the button row, if any."
+ 	self changed: #getButtonRow.!
- 
- 	| aWindow aRow |
- 	Smalltalk isMorphic ifFalse: [^self].
- 	aWindow := self dependents 
- 				detect: [:m | (m isSystemWindow) and: [m model == self]]
- 				ifNone: [^self].
- 	aRow := aWindow findDeepSubmorphThat: [:m | m hasProperty: #buttonRow]
- 				ifAbsent: [^self].
- 	aRow submorphs size - 4 timesRepeat: [aRow submorphs last delete].
- 	self dynamicButtonServices do: 
- 			[:service | 
- 			aRow addMorphBack: (service buttonToTriggerIn: self).
- 			service addDependent: self]!

Item was changed:
  ----- Method: FileList>>defaultContents (in category 'private') -----
  defaultContents
  	contents := list == nil
  		ifTrue: [String new]
  		ifFalse: [String streamContents:
+ 					[:s | s nextPutAll: 'NO FILE SELECTED' translated; cr]].
- 					[:s | s nextPutAll: 'NO FILE SELECTED' translated; cr.
- 					s nextPutAll: '  -- Folder Summary --' translated; cr.
- 					list do: [:item | s nextPutAll: item; cr]]].
  	brevityState := #FileList.
  	^ contents!

Item was added:
+ ----- Method: FileList>>subDirectoriesOf: (in category 'directory tree') -----
+ subDirectoriesOf: aDirectory
+ 	^aDirectory directoryNames collect:[:each| aDirectory directoryNamed: each].!

Item was added:
+ ----- Method: FileList>>getSelectedPath (in category 'directory tree') -----
+ getSelectedPath
+ 	self halt.!

Item was added:
+ ----- Method: FileList>>rootDirectoryList (in category 'directory tree') -----
+ rootDirectoryList
+ 	| dirList dir servers |
+ 	dir := FileDirectory on: ''.
+ 	dirList := dir directoryNames collect:[:each| dir directoryNamed: each]..
+ 	dirList isEmpty ifTrue:[dirList := Array with: FileDirectory default].
+ 	servers := ServerDirectory serverNames collect: [ :n | ServerDirectory serverNamed: n].
+ 	"This is so FileListPlus will work on ancient Squeak versions."
+ 	servers := servers select:[:each| each respondsTo: #localName].
+ 	^dirList, servers!

Item was removed:
- ----- Method: FileList>>optionalButtonView (in category 'initialization') -----
- optionalButtonView
- 	"Answer a view of optional buttons"
- 
- 	| aView bHeight windowWidth offset previousView aButtonView wid services sel allServices |
- 	aView := View new model: self.
- 	bHeight := self optionalButtonHeight.
- 	windowWidth := 120.
- 	aView window: (0 @ 0 extent: windowWidth @ bHeight).
- 	offset := 0.
- 	allServices := self universalButtonServices.
- 	services := allServices copyFrom: 1 to: (allServices size min: 5).
- 	previousView := nil.
- 	services
- 		do: [:service | sel := service selector.
- 		aButtonView := sel asString numArgs = 0
- 			ifTrue: [PluggableButtonView
- 					on: service provider
- 					getState: (service extraSelector == #none
- 							ifFalse: [service extraSelector])
- 					action: sel]
- 			ifFalse: [PluggableButtonView
- 					on: service provider
- 					getState: (service extraSelector == #none
- 							ifFalse: [service extraSelector])
- 					action: sel
- 					getArguments: #fullName
- 					from: self].
- 		service selector = services last selector
- 			ifTrue: [wid := windowWidth - offset]
- 			ifFalse: [aButtonView
- 					borderWidthLeft: 0
- 					right: 1
- 					top: 0
- 					bottom: 0.
- 				wid := windowWidth // services size - 2].
- 		aButtonView label: service buttonLabel asParagraph;
- 			window: (offset @ 0 extent: wid @ bHeight).
- 		offset := offset + wid.
- 		service selector = services first selector
- 			ifTrue: [aView addSubView: aButtonView]
- 			ifFalse: [aView addSubView: aButtonView toRightOf: previousView].
- 		previousView := aButtonView].
- 	^ aView!

Item was removed:
- ----- 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 removed:
- ----- Method: FileList>>optionalButtonRow (in category 'initialization') -----
- optionalButtonRow
- 	"Answer the button row associated with a file list"
- 
- 	| aRow |
- 	aRow := AlignmentMorph newRow beSticky.
- 	aRow color: Color transparent.
- 	aRow clipSubmorphs: true.
- 	aRow layoutInset: 5 at 1; cellInset: 6.
- 	self universalButtonServices do:  "just the three sort-by items"
- 			[:service |
- 				aRow addMorphBack: (service buttonToTriggerIn: self).
- 				(service selector  == #sortBySize)
- 					ifTrue:
- 						[aRow addTransparentSpacerOfSize: (4 at 0)]].
- 	aRow setNameTo: 'buttons'.
- 	aRow setProperty: #buttonRow toValue: true.  "Used for dynamic retrieval later on"
- 	^ aRow!

Item was removed:
- ----- Method: FileList>>isDirectoryList: (in category 'drag''n''drop') -----
- isDirectoryList: aMorph
- 	^aMorph getListSelector == #volumeList!

Item was removed:
- ----- Method: FileList>>wantsDroppedMorph:event:inMorph: (in category 'drag''n''drop') -----
- wantsDroppedMorph: aTransferMorph event: evt inMorph: dest
- 	| retval |
- 	retval := (aTransferMorph isKindOf: TransferMorph)
- 		and: [ aTransferMorph dragTransferType == #file ]
- 		and: [ self isDirectoryList: dest ].
- 	"retval ifFalse: [ Transcript nextPutAll: 'drop not wanted'; cr ]."
- 	^retval!

Item was removed:
- ----- Method: FileList class>>openAsMorph (in category 'instance creation') -----
- openAsMorph
- 	"Open a morphic view of a FileList on the default directory."
- 	| dir aFileList window upperFraction offset |
- 	dir := FileDirectory default.
- 	aFileList := self new directory: dir.
- 	window := (SystemWindow labelled: dir pathName)
- 				model: aFileList.
- 	upperFraction := 0.3.
- 	offset := 0.
- 	self
- 		addVolumesAndPatternPanesTo: window
- 		at: (0 @ 0 corner: 0.3 @ upperFraction)
- 		plus: offset
- 		forFileList: aFileList.
- 	self
- 		addButtonsAndFileListPanesTo: window
- 		at: (0.3 @ 0 corner: 1.0 @ upperFraction)
- 		plus: offset
- 		forFileList: aFileList.
- 	window
- 		addMorph: (PluggableTextMorph
- 				on: aFileList
- 				text: #contents
- 				accept: #put:
- 				readSelection: #contentsSelection
- 				menu: #fileContentsMenu:shifted:)
- 		frame: (0 @ 0.3 corner: 1 @ 1).
- 	^ window!

Item was removed:
- ----- Method: FileList class>>defaultButtonPaneHeight (in category 'instance creation') -----
- defaultButtonPaneHeight
- 	"Answer the user's preferred default height for new button panes."
- 
- 	^ Preferences
- 		parameterAt: #defaultButtonPaneHeight
- 		ifAbsentPut: [25]!

Item was removed:
- ----- Method: FileList>>openMorphFromFile (in category 'file list menu') -----
- openMorphFromFile
- 	"Reconstitute a Morph from the selected file, presumed to be represent a Morph saved
- 	via the SmartRefStream mechanism, and open it in an appropriate Morphic world"
- 
-  	| aFileStream morphOrList |
- 	Smalltalk verifyMorphicAvailability ifFalse: [^ self].
- 
- 	aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: self fullName) binary contentsOfEntireFile)) binary reset.
- 	morphOrList := aFileStream fileInObjectAndCode.
- 	(morphOrList isKindOf: SqueakPage) ifTrue: [morphOrList := morphOrList contentsMorph].
- 	Smalltalk isMorphic
- 		ifTrue: [ActiveWorld addMorphsAndModel: morphOrList]
- 		ifFalse:
- 			[morphOrList isMorph ifFalse: [^ self errorMustBeMorph].
- 			morphOrList openInWorld]!

Item was removed:
- ----- Method: FileList>>primitiveCopyFileNamed:to: (in category 'drag''n''drop') -----
- primitiveCopyFileNamed: srcName to: dstName 
- 	"Copied from VMMaker code.
- 	This really ought to be a facility in file system. The major annoyance 
- 	here is that file types and permissions are not handled by current 
- 	Squeak code.
- 	NOTE that this will clobber the destination file!!"
- 	| buffer src dst |
- 	<primitive: 'primitiveFileCopyNamedTo' module:'FileCopyPlugin'> "primitiveExternalCall" 
- 	"If the plugin doesn't do it, go the slow way and lose the filetype info"
- 	"This method may signal FileDoesNotExistException if either the source or 
- 	dest files cannnot be opened; possibly permissions or bad name problems"
- 	[[src := FileStream readOnlyFileNamed: srcName]
- 		on: FileDoesNotExistException
- 		do: [^ self error: ('could not open file ', srcName)].
- 	[dst := FileStream forceNewFileNamed: dstName]
- 		on: FileDoesNotExistException
- 		do: [^ self error: ('could not open file ', dstName)].
- 	buffer := String new: 50000.
- 	[src atEnd]
- 		whileFalse: [dst
- 				nextPutAll: (src nextInto: buffer)]]
- 		ensure: [src
- 				ifNotNil: [src close].
- 			dst
- 				ifNotNil: [dst close]]!

Item was removed:
- ----- Method: FileList class>>addButtonsAndFileListPanesTo:at:plus:forFileList: (in category 'instance creation') -----
- addButtonsAndFileListPanesTo: window at: upperFraction plus: offset forFileList: aFileList 
- 	| fileListMorph row buttonHeight fileListTop divider dividerDelta buttons |
- 	fileListMorph := PluggableListMorph
- 				on: aFileList
- 				list: #fileList
- 				selected: #fileListIndex
- 				changeSelected: #fileListIndex:
- 				menu: #fileListMenu:.
- 	fileListMorph enableDrag: true; enableDrop: false.
- 	aFileList wantsOptionalButtons
- 		ifTrue: [buttons := aFileList optionalButtonRow.
- 			divider := BorderedSubpaneDividerMorph forBottomEdge.
- 			dividerDelta := 0.
- 			buttons color: Color transparent.
- 					buttons
- 						submorphsDo: [:m | m borderWidth: 2;
- 								 borderColor: #raised].
- divider extent: 4 @ 4;
- 						 color: Color transparent;
- 						 borderColor: #raised;
- 						 borderWidth: 2.
- 					fileListMorph borderColor: Color transparent.
- 					dividerDelta := 3.
- 			row := AlignmentMorph newColumn hResizing: #spaceFill;
- 						 vResizing: #spaceFill;
- 						 layoutInset: 0;
- 						 borderWidth: 2;
- 						 layoutPolicy: ProportionalLayout new.
- 			buttonHeight := self defaultButtonPaneHeight.
- 			row
- 				addMorph: buttons
- 				fullFrame: (LayoutFrame
- 						fractions: (0 @ 0 corner: 1 @ 0)
- 						offsets: (0 @ 0 corner: 0 @ buttonHeight)).
- 			row
- 				addMorph: divider
- 				fullFrame: (LayoutFrame
- 						fractions: (0 @ 0 corner: 1 @ 0)
- 						offsets: (0 @ buttonHeight corner: 0 @ buttonHeight + dividerDelta)).
- 			row
- 				addMorph: fileListMorph
- 				fullFrame: (LayoutFrame
- 						fractions: (0 @ 0 corner: 1 @ 1)
- 						offsets: (0 @ buttonHeight + dividerDelta corner: 0 @ 0)).
- 			window
- 				addMorph: row
- 				fullFrame: (LayoutFrame
- 						fractions: upperFraction
- 						offsets: (0 @ offset corner: 0 @ 0)).
- 			row borderWidth: 2]
- 		ifFalse: [fileListTop := 0.
- 			window
- 				addMorph: fileListMorph
- 				frame: (0.3 @ fileListTop corner: 1 @ 0.3)].!

Item was removed:
- ----- Method: FileList>>dragTransferTypeForMorph: (in category 'drag''n''drop') -----
- dragTransferTypeForMorph: aMorph
- 	^#file!

Item was removed:
- ----- Method: FileList class>>addVolumesAndPatternPanesTo:at:plus:forFileList: (in category 'instance creation') -----
- addVolumesAndPatternPanesTo: window at: upperFraction plus: offset forFileList: aFileList 
- 	| row patternHeight volumeListMorph patternMorph divider dividerDelta |
- 	row := AlignmentMorph newColumn hResizing: #spaceFill;
- 				 vResizing: #spaceFill;
- 				 layoutInset: 0;
- 				 borderWidth: 0;
- 				 layoutPolicy: ProportionalLayout new.
- 	patternHeight := 25.
- 	volumeListMorph := (PluggableListMorph
- 				on: aFileList
- 				list: #volumeList
- 				selected: #volumeListIndex
- 				changeSelected: #volumeListIndex:
- 				menu: #volumeMenu:)
- 				autoDeselect: false.
- 	volumeListMorph enableDrag: false; enableDrop: true.
- 	patternMorph := PluggableTextMorph
- 				on: aFileList
- 				text: #pattern
- 				accept: #pattern:.
- 	patternMorph acceptOnCR: true.
- 	patternMorph hideScrollBarsIndefinitely.
- 	divider := BorderedSubpaneDividerMorph horizontal.
- 	dividerDelta := 0.
- 	divider extent: 4 @ 4;
- 			color: Color transparent;
- 			borderColor: #raised;
- 			borderWidth: 2.
- 		volumeListMorph borderColor: Color transparent.
- 		patternMorph borderColor: Color transparent.
- 		dividerDelta := 3.
- 	row
- 		addMorph: (volumeListMorph autoDeselect: false)
- 		fullFrame: (LayoutFrame
- 				fractions: (0 @ 0 corner: 1 @ 1)
- 				offsets: (0 @ 0 corner: 0 @ patternHeight negated - dividerDelta)).
- 	row
- 		addMorph: divider
- 		fullFrame: (LayoutFrame
- 				fractions: (0 @ 1 corner: 1 @ 1)
- 				offsets: (0 @ patternHeight negated - dividerDelta corner: 0 @ patternHeight negated)).
- 	row
- 		addMorph: patternMorph
- 		fullFrame: (LayoutFrame
- 				fractions: (0 @ 1 corner: 1 @ 1)
- 				offsets: (0 @ patternHeight negated corner: 0 @ 0)).
- 	window
- 		addMorph: row
- 		fullFrame: (LayoutFrame
- 				fractions: upperFraction
- 				offsets: (0 @ offset corner: 0 @ 0)).
- 	row borderWidth: 2!

Item was removed:
- ----- Method: FileList>>dropDestinationDirectory:event: (in category 'drag''n''drop') -----
- dropDestinationDirectory: dest event: evt 
- 	"Answer a FileDirectory representing the drop destination in the volume list morph dest"
- 	| index dir delim path |
- 	index := volList indexOf: (dest itemFromPoint: evt position) contents.
- 	index = 1
- 		ifTrue: [dir := FileDirectory on: '']
- 		ifFalse: [delim := directory pathNameDelimiter.
- 			path := String
- 						streamContents: [:str | 
- 							2
- 								to: index
- 								do: [:d | 
- 									str nextPutAll: (volList at: d) withBlanksTrimmed.
- 									d < index
- 										ifTrue: [str nextPut: delim]].
- 							nil].
- 			dir := directory on: path].
- 	^ dir!

Item was removed:
- ----- Method: FileList>>acceptDroppingMorph:event:inMorph: (in category 'drag''n''drop') -----
- acceptDroppingMorph: aTransferMorph event: evt inMorph: dest
- 	| oldName oldEntry destDirectory newName newEntry baseName response |
- 	destDirectory := self dropDestinationDirectory: dest event: evt.
- 	oldName := aTransferMorph passenger.
- 	baseName := FileDirectory localNameFor: oldName.
- 	newName := destDirectory 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 ]
- 		ifFalse: [ directory rename: oldName toBe: newName ].
- 
- 	self updateFileList; fileListIndex: 0.
- 
- 	aTransferMorph source model ~= self
- 		ifTrue: [ aTransferMorph source model updateFileList; fileListIndex: 0 ].
- 	"Transcript nextPutAll: 'copied'; cr."
- 	^true!




More information about the Squeak-dev mailing list